Add support for declaring when syntactic elements are deleted/removed/renamed
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
3c15e3d041
commit
7c5624b448
|
@ -6,7 +6,7 @@ open Sexp.Of_sexp
|
|||
*)
|
||||
|
||||
let syntax =
|
||||
Syntax.create ~name:"dune"
|
||||
Syntax.create ~name:"dune" ~desc:"the dune language"
|
||||
[ (0, 0) (* Jbuild syntax *)
|
||||
; (1, 0)
|
||||
]
|
||||
|
@ -907,15 +907,11 @@ module Executables = struct
|
|||
; buildable : Buildable.t
|
||||
}
|
||||
|
||||
let common names public_names ~syntax ~multi =
|
||||
let common names public_names ~multi =
|
||||
Buildable.t >>= fun buildable ->
|
||||
(match (syntax : File_tree.Dune_file.Kind.t) with
|
||||
| Dune ->
|
||||
return ()
|
||||
| Jbuild ->
|
||||
field "link_executables" bool ~default:true >>= fun _ ->
|
||||
return ())
|
||||
>>= fun () ->
|
||||
field "link_executables" ~default:true
|
||||
(Syntax.deleted_in syntax (1, 0) >>> bool)
|
||||
>>= fun (_ : bool) ->
|
||||
field "link_deps" (list Dep_conf.t) ~default:[] >>= fun link_deps ->
|
||||
field_oslu "link_flags" >>= fun link_flags ->
|
||||
field "modes" Link_mode.Set.t ~default:Link_mode.Set.default
|
||||
|
@ -987,7 +983,7 @@ module Executables = struct
|
|||
| "-" -> None
|
||||
| s -> Some s
|
||||
|
||||
let multi ~syntax =
|
||||
let multi =
|
||||
record
|
||||
(field "names" (list (located string)) >>= fun names ->
|
||||
map_validate (field_o "public_names" (list public_name)) ~f:(function
|
||||
|
@ -999,13 +995,13 @@ module Executables = struct
|
|||
Error "The list of public names must be of the same \
|
||||
length as the list of names")
|
||||
>>= fun public_names ->
|
||||
common ~syntax names public_names ~multi:true)
|
||||
common names public_names ~multi:true)
|
||||
|
||||
let single ~syntax =
|
||||
let single =
|
||||
record
|
||||
(field "name" (located string) >>= fun name ->
|
||||
field_o "public_name" string >>= fun public_name ->
|
||||
common ~syntax [name] [public_name] ~multi:false)
|
||||
common [name] [public_name] ~multi:false)
|
||||
end
|
||||
|
||||
module Rule = struct
|
||||
|
@ -1294,12 +1290,12 @@ module Stanzas = struct
|
|||
|
||||
type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
|
||||
|
||||
let common ~syntax : constructors =
|
||||
let stanzas : constructors =
|
||||
[ "library",
|
||||
(Library.t >>| fun x ->
|
||||
[Library x])
|
||||
; "executable" , Executables.single ~syntax >>| execs
|
||||
; "executables", Executables.multi ~syntax >>| execs
|
||||
; "executable" , Executables.single >>| execs
|
||||
; "executables", Executables.multi >>| execs
|
||||
; "rule",
|
||||
(loc >>= fun loc ->
|
||||
Rule.t >>| fun x ->
|
||||
|
@ -1335,23 +1331,21 @@ module Stanzas = struct
|
|||
; "documentation",
|
||||
(Documentation.t >>| fun d ->
|
||||
[Documentation d])
|
||||
]
|
||||
|
||||
let dune =
|
||||
common ~syntax:Dune @
|
||||
[ "env",
|
||||
(loc >>= fun loc ->
|
||||
; "jbuild_version",
|
||||
(Syntax.deleted_in syntax (1, 0) >>= fun () ->
|
||||
Jbuild_version.t >>| fun _ -> [])
|
||||
; "env",
|
||||
(Syntax.since syntax (1, 0) >>= fun () ->
|
||||
loc >>= fun loc ->
|
||||
repeat Env.rule >>| fun rules ->
|
||||
[Env { loc; rules }])
|
||||
]
|
||||
|
||||
let jbuild =
|
||||
common ~syntax:Jbuild @
|
||||
[ "jbuild_version", (Jbuild_version.t >>| fun _ -> [])
|
||||
]
|
||||
let jbuild_parser =
|
||||
Syntax.set syntax (0, 0) (sum stanzas)
|
||||
|
||||
let () =
|
||||
Dune_project.Lang.register syntax dune
|
||||
Dune_project.Lang.register syntax stanzas
|
||||
|
||||
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
||||
|
||||
|
@ -1375,7 +1369,7 @@ module Stanzas = struct
|
|||
let stanza_parser =
|
||||
Dune_project.set project
|
||||
(match (kind : File_tree.Dune_file.Kind.t) with
|
||||
| Jbuild -> sum jbuild
|
||||
| Jbuild -> jbuild_parser
|
||||
| Dune -> project.stanza_parser)
|
||||
in
|
||||
let stanzas =
|
||||
|
|
|
@ -51,12 +51,14 @@ end
|
|||
|
||||
type t =
|
||||
{ name : string
|
||||
; desc : string
|
||||
; key : Version.t Univ_map.Key.t
|
||||
; supported_versions : Supported_versions.t
|
||||
}
|
||||
|
||||
let create ~name supported_versions =
|
||||
let create ~name ~desc supported_versions =
|
||||
{ name
|
||||
; desc
|
||||
; key = Univ_map.Key.create ()
|
||||
; supported_versions = Supported_versions.make supported_versions
|
||||
}
|
||||
|
@ -81,13 +83,55 @@ let greatest_supported_version t =
|
|||
|
||||
let key t = t.key
|
||||
|
||||
open Sexp.Of_sexp
|
||||
|
||||
let set t ver parser =
|
||||
Sexp.Of_sexp.set t.key ver parser
|
||||
set t.key ver parser
|
||||
|
||||
let get_exn t =
|
||||
let open Sexp.Of_sexp in
|
||||
get t.key >>| function
|
||||
| Some x -> x
|
||||
| None ->
|
||||
Exn.code_error "Syntax identifier is unset"
|
||||
[ "name", Sexp.To_sexp.string t.name ]
|
||||
|
||||
let desc () =
|
||||
kind >>| fun kind ->
|
||||
match kind with
|
||||
| Values (loc, None) -> (loc, "This syntax")
|
||||
| Fields (loc, None) -> (loc, "This field")
|
||||
| Values (loc, Some s) -> (loc, sprintf "'%s'" s)
|
||||
| Fields (loc, Some s) -> (loc, sprintf "Field '%s'" s)
|
||||
|
||||
let deleted_in t ver =
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver < ver then
|
||||
return ()
|
||||
else begin
|
||||
desc () >>= fun (loc, what) ->
|
||||
Loc.fail loc
|
||||
"%s was deleted in version %s of %s" what
|
||||
(Version.to_string ver) t.desc
|
||||
end
|
||||
|
||||
let renamed_in t ver ~to_ =
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver < ver then
|
||||
return ()
|
||||
else begin
|
||||
desc () >>= fun (loc, what) ->
|
||||
Loc.fail loc
|
||||
"%s was renamed to '%s' in %s of %s" what to_
|
||||
(Version.to_string ver) t.desc
|
||||
end
|
||||
|
||||
let since t ver =
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver >= ver then
|
||||
return ()
|
||||
else begin
|
||||
desc () >>= fun (loc, what) ->
|
||||
Loc.fail loc
|
||||
"%s is only available since version %s of %s" what
|
||||
(Version.to_string ver) t.desc
|
||||
end
|
||||
|
|
|
@ -20,10 +20,11 @@ end
|
|||
|
||||
type t
|
||||
|
||||
(** [create ~name supported_versions] defines a new
|
||||
(** [create ~name ~desc supported_versions] defines a new
|
||||
syntax. [supported_version] is the list of the last minor version
|
||||
of each supported major version. *)
|
||||
val create : name:string -> Version.t list -> t
|
||||
of each supported major version. [desc] is used to describe what
|
||||
this syntax represent in error messages. *)
|
||||
val create : name:string -> desc:string -> Version.t list -> t
|
||||
|
||||
(** Return the name of the syntax. *)
|
||||
val name : t -> string
|
||||
|
@ -33,6 +34,24 @@ val check_supported : t -> Loc.t * Version.t -> unit
|
|||
|
||||
val greatest_supported_version : t -> Version.t
|
||||
|
||||
(** {1 S-expression parsing} *)
|
||||
|
||||
(** {2 High-level functions} *)
|
||||
|
||||
(** Indicate the field/constructor being parsed was deleted in the
|
||||
given version *)
|
||||
val deleted_in : t -> Version.t -> (unit, _) Sexp.Of_sexp.parser
|
||||
|
||||
(** Indicate the field/constructor being parsed was renamed in the
|
||||
given version *)
|
||||
val renamed_in : t -> Version.t -> to_:string -> (unit, _) Sexp.Of_sexp.parser
|
||||
|
||||
(** Indicate the field/constructor being parsed was introduced in the
|
||||
given version *)
|
||||
val since : t -> Version.t -> (unit, _) Sexp.Of_sexp.parser
|
||||
|
||||
(** {2 Low-level functions} *)
|
||||
|
||||
val set
|
||||
: t
|
||||
-> Version.t
|
||||
|
|
Loading…
Reference in New Issue