Parse and interpret (jbuilder_version ...) stanzas
This commit is contained in:
parent
f9c80160f1
commit
e2a607af6e
|
@ -1410,7 +1410,7 @@ module Gen(P : Params) = struct
|
|||
| Ocamllex conf -> ocamllex_rules conf ~dir
|
||||
| Ocamlyacc conf -> ocamlyacc_rules conf ~dir
|
||||
| Alias alias -> alias_rules alias ~dir
|
||||
| Provides _ | Install _ | Other -> ())
|
||||
| Provides _ | Install _ -> ())
|
||||
|
||||
let () = List.iter P.stanzas ~f:rules
|
||||
|
||||
|
|
|
@ -8,10 +8,27 @@ type conf =
|
|||
; packages : Path.t String_map.t
|
||||
}
|
||||
|
||||
let load ~dir ~visible_packages =
|
||||
let stanzas = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) Stanza.vjs in
|
||||
let load ~dir ~visible_packages ~version =
|
||||
let version, stanzas =
|
||||
Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string)
|
||||
(fun sexps ->
|
||||
let versions, stanzas =
|
||||
List.partition_map sexps ~f:(function
|
||||
| List [Atom ("jbuilder_version" | "Jbuilder_version"); ver] as sexp ->
|
||||
Inl (Jbuilder_version.t ver, sexp)
|
||||
| sexp -> Inr sexp)
|
||||
in
|
||||
let version =
|
||||
match versions with
|
||||
| [] -> version
|
||||
| [(v, _)] -> v
|
||||
| _ :: (_, sexp) :: _ ->
|
||||
of_sexp_error "jbuilder_version specified too many times" sexp
|
||||
in
|
||||
(version, List.filter_map sexps ~f:(Stanza.select version)))
|
||||
in
|
||||
let stanzas = Stanza.resolve_packages stanzas ~dir ~visible_packages in
|
||||
(dir, stanzas)
|
||||
(version, stanzas)
|
||||
|
||||
let load () =
|
||||
let ftree = File_tree.load Path.root in
|
||||
|
@ -38,7 +55,7 @@ let load () =
|
|||
|> List.map ~f:(fun (pkg, path) -> (path, pkg))
|
||||
|> Path.Map.of_alist_multi
|
||||
in
|
||||
let rec walk dir stanzas visible_packages =
|
||||
let rec walk dir stanzas visible_packages version =
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||
|
@ -49,6 +66,13 @@ let load () =
|
|||
List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg ->
|
||||
String_map.add acc ~key:pkg ~data:path)
|
||||
in
|
||||
let version, stanzas =
|
||||
if String_set.mem "jbuild" files then
|
||||
let version, stanzas_here = load ~dir:path ~visible_packages ~version in
|
||||
(version, (path, stanzas_here) :: stanzas)
|
||||
else
|
||||
(version, stanzas)
|
||||
in
|
||||
let sub_dirs =
|
||||
if String_set.mem "jbuild-ignore" files then
|
||||
let ignore_set =
|
||||
|
@ -63,20 +87,13 @@ let load () =
|
|||
let children, stanzas =
|
||||
String_map.fold sub_dirs ~init:([], stanzas)
|
||||
~f:(fun ~key:_ ~data:dir (children, stanzas) ->
|
||||
let child, stanzas = walk dir stanzas visible_packages in
|
||||
let child, stanzas = walk dir stanzas visible_packages version in
|
||||
(child :: children, stanzas))
|
||||
in
|
||||
let stanzas =
|
||||
if String_set.mem "jbuild" files then
|
||||
load ~dir:path ~visible_packages
|
||||
:: stanzas
|
||||
else
|
||||
stanzas
|
||||
in
|
||||
(Alias.Node (path, children), stanzas)
|
||||
in
|
||||
let root = File_tree.root ftree in
|
||||
let tree, stanzas = walk root [] String_map.empty in
|
||||
let tree, stanzas = walk root [] String_map.empty Jbuilder_version.latest_stable in
|
||||
{ file_tree = ftree
|
||||
; tree
|
||||
; stanzas
|
||||
|
|
|
@ -11,6 +11,20 @@ open Sexp.Of_sexp
|
|||
type sexp = Sexp.t = Atom of string | List of sexp list
|
||||
let of_sexp_error = Sexp.of_sexp_error
|
||||
|
||||
module Jbuilder_version = struct
|
||||
type t =
|
||||
| V1
|
||||
| Vjs
|
||||
|
||||
let t =
|
||||
enum
|
||||
[ "1", V1
|
||||
; "jane_street", Vjs
|
||||
]
|
||||
|
||||
let latest_stable = V1
|
||||
end
|
||||
|
||||
let invalid_module_name sexp =
|
||||
of_sexp_error "invalid module name" sexp
|
||||
|
||||
|
@ -749,36 +763,47 @@ module Stanza = struct
|
|||
| Provides of Provides.t
|
||||
| Install of Install_conf.t
|
||||
| Alias of Alias_conf.t
|
||||
| Other
|
||||
|
||||
let cstr' name args f =
|
||||
cstr name args (fun x -> Some (f x))
|
||||
|
||||
let v1 =
|
||||
sum
|
||||
[ cstr "library" [Library.v1] (fun x -> Library x)
|
||||
; cstr "executables" [Executables.v1] (fun x -> Executables x)
|
||||
; cstr "rule" [Rule.v1] (fun x -> Rule x)
|
||||
; cstr "ocamllex" [Ocamllex.v1] (fun x -> Ocamllex x)
|
||||
; cstr "ocamlyacc" [Ocamlyacc.v1] (fun x -> Ocamlyacc x)
|
||||
; cstr "provides" [Provides.v1] (fun x -> Provides x)
|
||||
; cstr "install" [Install_conf.v1] (fun x -> Install x)
|
||||
; cstr "alias" [Alias_conf.v1] (fun x -> Alias x)
|
||||
[ cstr' "library" [Library.v1] (fun x -> Library x)
|
||||
; cstr' "executables" [Executables.v1] (fun x -> Executables x)
|
||||
; cstr' "rule" [Rule.v1] (fun x -> Rule x)
|
||||
; cstr' "ocamllex" [Ocamllex.v1] (fun x -> Ocamllex x)
|
||||
; cstr' "ocamlyacc" [Ocamlyacc.v1] (fun x -> Ocamlyacc x)
|
||||
; cstr' "provides" [Provides.v1] (fun x -> Provides x)
|
||||
; cstr' "install" [Install_conf.v1] (fun x -> Install x)
|
||||
; cstr' "alias" [Alias_conf.v1] (fun x -> Alias x)
|
||||
(* Just for validation and error messages *)
|
||||
; cstr "jbuilder_version" [Jbuilder_version.t] (fun _ -> None)
|
||||
]
|
||||
|
||||
let vjs =
|
||||
let ign name = cstr name [fun _ -> ()] (fun () -> None) in
|
||||
sum
|
||||
[ cstr "library" [Library.vjs] (fun x -> Library x)
|
||||
; cstr "executables" [Executables.vjs] (fun x -> Executables x)
|
||||
; cstr "rule" [Rule.vjs] (fun x -> Rule x)
|
||||
; cstr "ocamllex" [Ocamllex.vjs] (fun x -> Ocamllex x)
|
||||
; cstr "ocamlyacc" [Ocamlyacc.vjs] (fun x -> Ocamlyacc x)
|
||||
; cstr "provides" [Provides.vjs] (fun x -> Provides x)
|
||||
; cstr "install" [Install_conf.vjs] (fun x -> Install x)
|
||||
; cstr "alias" [Alias_conf.vjs] (fun x -> Alias x)
|
||||
; cstr "enforce_style" [fun _ -> ()] (fun _ -> Other )
|
||||
; cstr "toplevel_expect_tests" [fun _ -> ()] (fun _ -> Other)
|
||||
; cstr "unified_tests" [fun _ -> ()] (fun _ -> Other)
|
||||
; cstr "embed" [fun _ -> ()] (fun _ -> Other)
|
||||
[ cstr' "library" [Library.vjs] (fun x -> Library x)
|
||||
; cstr' "executables" [Executables.vjs] (fun x -> Executables x)
|
||||
; cstr' "rule" [Rule.vjs] (fun x -> Rule x)
|
||||
; cstr' "ocamllex" [Ocamllex.vjs] (fun x -> Ocamllex x)
|
||||
; cstr' "ocamlyacc" [Ocamlyacc.vjs] (fun x -> Ocamlyacc x)
|
||||
; cstr' "provides" [Provides.vjs] (fun x -> Provides x)
|
||||
; cstr' "install" [Install_conf.vjs] (fun x -> Install x)
|
||||
; cstr' "alias" [Alias_conf.vjs] (fun x -> Alias x)
|
||||
; ign "enforce_style"
|
||||
; ign "toplevel_expect_tests"
|
||||
; ign "unified_tests"
|
||||
; ign "embed"
|
||||
(* Just for validation and error messages *)
|
||||
; cstr "jbuilder_version" [Jbuilder_version.t] (fun _ -> None)
|
||||
]
|
||||
|
||||
let select : Jbuilder_version.t -> Sexp.t -> t option = function
|
||||
| V1 -> v1
|
||||
| Vjs -> vjs
|
||||
|
||||
let lib_names ts =
|
||||
List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, stanzas) ->
|
||||
List.fold_left stanzas ~init:acc ~f:(fun acc -> function
|
||||
|
|
18
src/sexp.ml
18
src/sexp.ml
|
@ -328,6 +328,24 @@ module Of_sexp = struct
|
|||
| Atom s ->
|
||||
let (Constructor_spec.T c) = find_cstr cstrs sexp s in
|
||||
Constructor_args_spec.convert c.args sexp args c.make
|
||||
|
||||
let enum cstrs sexp =
|
||||
match sexp with
|
||||
| List _ -> of_sexp_error "Atom expected" sexp
|
||||
| Atom s ->
|
||||
match
|
||||
List.find cstrs ~f:(fun (name, _) ->
|
||||
equal_cstr_name name s)
|
||||
with
|
||||
| Some (_, value) -> value
|
||||
| None ->
|
||||
of_sexp_error
|
||||
(sprintf "Unknown value %s%s" s
|
||||
(hint
|
||||
(String.uncapitalize_ascii s)
|
||||
(List.map cstrs ~f:(fun (name, _) ->
|
||||
String.uncapitalize_ascii name)))
|
||||
) sexp
|
||||
end
|
||||
(*
|
||||
module Both = struct
|
||||
|
|
|
@ -68,4 +68,6 @@ module Of_sexp : sig
|
|||
val sum
|
||||
: 'a Constructor_spec.t list
|
||||
-> 'a t
|
||||
|
||||
val enum : (string * 'a) list -> 'a t
|
||||
end
|
||||
|
|
|
@ -20,7 +20,7 @@ let many fn f =
|
|||
|> List.split
|
||||
in
|
||||
try
|
||||
List.map sexps ~f
|
||||
f sexps
|
||||
with Sexp.Of_sexp_error (msg, sub) ->
|
||||
let loc =
|
||||
match Sexp.locate_in_list sexps ~sub ~locs with
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
open! Import
|
||||
|
||||
val single : string -> (Sexp.t -> 'a) -> 'a
|
||||
val many : string -> (Sexp.t -> 'a) -> 'a list
|
||||
val many : string -> (Sexp.t list -> 'a) -> 'a
|
||||
|
|
Loading…
Reference in New Issue