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 =
|
let syntax =
|
||||||
Syntax.create ~name:"dune"
|
Syntax.create ~name:"dune" ~desc:"the dune language"
|
||||||
[ (0, 0) (* Jbuild syntax *)
|
[ (0, 0) (* Jbuild syntax *)
|
||||||
; (1, 0)
|
; (1, 0)
|
||||||
]
|
]
|
||||||
|
@ -907,15 +907,11 @@ module Executables = struct
|
||||||
; buildable : Buildable.t
|
; buildable : Buildable.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let common names public_names ~syntax ~multi =
|
let common names public_names ~multi =
|
||||||
Buildable.t >>= fun buildable ->
|
Buildable.t >>= fun buildable ->
|
||||||
(match (syntax : File_tree.Dune_file.Kind.t) with
|
field "link_executables" ~default:true
|
||||||
| Dune ->
|
(Syntax.deleted_in syntax (1, 0) >>> bool)
|
||||||
return ()
|
>>= fun (_ : bool) ->
|
||||||
| Jbuild ->
|
|
||||||
field "link_executables" bool ~default:true >>= fun _ ->
|
|
||||||
return ())
|
|
||||||
>>= fun () ->
|
|
||||||
field "link_deps" (list Dep_conf.t) ~default:[] >>= fun link_deps ->
|
field "link_deps" (list Dep_conf.t) ~default:[] >>= fun link_deps ->
|
||||||
field_oslu "link_flags" >>= fun link_flags ->
|
field_oslu "link_flags" >>= fun link_flags ->
|
||||||
field "modes" Link_mode.Set.t ~default:Link_mode.Set.default
|
field "modes" Link_mode.Set.t ~default:Link_mode.Set.default
|
||||||
|
@ -987,7 +983,7 @@ module Executables = struct
|
||||||
| "-" -> None
|
| "-" -> None
|
||||||
| s -> Some s
|
| s -> Some s
|
||||||
|
|
||||||
let multi ~syntax =
|
let multi =
|
||||||
record
|
record
|
||||||
(field "names" (list (located string)) >>= fun names ->
|
(field "names" (list (located string)) >>= fun names ->
|
||||||
map_validate (field_o "public_names" (list public_name)) ~f:(function
|
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 \
|
Error "The list of public names must be of the same \
|
||||||
length as the list of names")
|
length as the list of names")
|
||||||
>>= fun public_names ->
|
>>= fun public_names ->
|
||||||
common ~syntax names public_names ~multi:true)
|
common names public_names ~multi:true)
|
||||||
|
|
||||||
let single ~syntax =
|
let single =
|
||||||
record
|
record
|
||||||
(field "name" (located string) >>= fun name ->
|
(field "name" (located string) >>= fun name ->
|
||||||
field_o "public_name" string >>= fun public_name ->
|
field_o "public_name" string >>= fun public_name ->
|
||||||
common ~syntax [name] [public_name] ~multi:false)
|
common [name] [public_name] ~multi:false)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Rule = struct
|
module Rule = struct
|
||||||
|
@ -1294,12 +1290,12 @@ module Stanzas = struct
|
||||||
|
|
||||||
type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
|
type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
|
||||||
|
|
||||||
let common ~syntax : constructors =
|
let stanzas : constructors =
|
||||||
[ "library",
|
[ "library",
|
||||||
(Library.t >>| fun x ->
|
(Library.t >>| fun x ->
|
||||||
[Library x])
|
[Library x])
|
||||||
; "executable" , Executables.single ~syntax >>| execs
|
; "executable" , Executables.single >>| execs
|
||||||
; "executables", Executables.multi ~syntax >>| execs
|
; "executables", Executables.multi >>| execs
|
||||||
; "rule",
|
; "rule",
|
||||||
(loc >>= fun loc ->
|
(loc >>= fun loc ->
|
||||||
Rule.t >>| fun x ->
|
Rule.t >>| fun x ->
|
||||||
|
@ -1335,23 +1331,21 @@ module Stanzas = struct
|
||||||
; "documentation",
|
; "documentation",
|
||||||
(Documentation.t >>| fun d ->
|
(Documentation.t >>| fun d ->
|
||||||
[Documentation d])
|
[Documentation d])
|
||||||
]
|
; "jbuild_version",
|
||||||
|
(Syntax.deleted_in syntax (1, 0) >>= fun () ->
|
||||||
let dune =
|
Jbuild_version.t >>| fun _ -> [])
|
||||||
common ~syntax:Dune @
|
; "env",
|
||||||
[ "env",
|
(Syntax.since syntax (1, 0) >>= fun () ->
|
||||||
(loc >>= fun loc ->
|
loc >>= fun loc ->
|
||||||
repeat Env.rule >>| fun rules ->
|
repeat Env.rule >>| fun rules ->
|
||||||
[Env { loc; rules }])
|
[Env { loc; rules }])
|
||||||
]
|
]
|
||||||
|
|
||||||
let jbuild =
|
let jbuild_parser =
|
||||||
common ~syntax:Jbuild @
|
Syntax.set syntax (0, 0) (sum stanzas)
|
||||||
[ "jbuild_version", (Jbuild_version.t >>| fun _ -> [])
|
|
||||||
]
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Dune_project.Lang.register syntax dune
|
Dune_project.Lang.register syntax stanzas
|
||||||
|
|
||||||
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
||||||
|
|
||||||
|
@ -1375,7 +1369,7 @@ module Stanzas = struct
|
||||||
let stanza_parser =
|
let stanza_parser =
|
||||||
Dune_project.set project
|
Dune_project.set project
|
||||||
(match (kind : File_tree.Dune_file.Kind.t) with
|
(match (kind : File_tree.Dune_file.Kind.t) with
|
||||||
| Jbuild -> sum jbuild
|
| Jbuild -> jbuild_parser
|
||||||
| Dune -> project.stanza_parser)
|
| Dune -> project.stanza_parser)
|
||||||
in
|
in
|
||||||
let stanzas =
|
let stanzas =
|
||||||
|
|
|
@ -51,12 +51,14 @@ end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ name : string
|
||||||
|
; desc : string
|
||||||
; key : Version.t Univ_map.Key.t
|
; key : Version.t Univ_map.Key.t
|
||||||
; supported_versions : Supported_versions.t
|
; supported_versions : Supported_versions.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let create ~name supported_versions =
|
let create ~name ~desc supported_versions =
|
||||||
{ name
|
{ name
|
||||||
|
; desc
|
||||||
; key = Univ_map.Key.create ()
|
; key = Univ_map.Key.create ()
|
||||||
; supported_versions = Supported_versions.make supported_versions
|
; supported_versions = Supported_versions.make supported_versions
|
||||||
}
|
}
|
||||||
|
@ -81,13 +83,55 @@ let greatest_supported_version t =
|
||||||
|
|
||||||
let key t = t.key
|
let key t = t.key
|
||||||
|
|
||||||
|
open Sexp.Of_sexp
|
||||||
|
|
||||||
let set t ver parser =
|
let set t ver parser =
|
||||||
Sexp.Of_sexp.set t.key ver parser
|
set t.key ver parser
|
||||||
|
|
||||||
let get_exn t =
|
let get_exn t =
|
||||||
let open Sexp.Of_sexp in
|
|
||||||
get t.key >>| function
|
get t.key >>| function
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None ->
|
| None ->
|
||||||
Exn.code_error "Syntax identifier is unset"
|
Exn.code_error "Syntax identifier is unset"
|
||||||
[ "name", Sexp.To_sexp.string t.name ]
|
[ "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
|
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
|
syntax. [supported_version] is the list of the last minor version
|
||||||
of each supported major version. *)
|
of each supported major version. [desc] is used to describe what
|
||||||
val create : name:string -> Version.t list -> t
|
this syntax represent in error messages. *)
|
||||||
|
val create : name:string -> desc:string -> Version.t list -> t
|
||||||
|
|
||||||
(** Return the name of the syntax. *)
|
(** Return the name of the syntax. *)
|
||||||
val name : t -> string
|
val name : t -> string
|
||||||
|
@ -33,6 +34,24 @@ val check_supported : t -> Loc.t * Version.t -> unit
|
||||||
|
|
||||||
val greatest_supported_version : t -> Version.t
|
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
|
val set
|
||||||
: t
|
: t
|
||||||
-> Version.t
|
-> Version.t
|
||||||
|
|
Loading…
Reference in New Issue