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
|
| Ocamllex conf -> ocamllex_rules conf ~dir
|
||||||
| Ocamlyacc conf -> ocamlyacc_rules conf ~dir
|
| Ocamlyacc conf -> ocamlyacc_rules conf ~dir
|
||||||
| Alias alias -> alias_rules alias ~dir
|
| Alias alias -> alias_rules alias ~dir
|
||||||
| Provides _ | Install _ | Other -> ())
|
| Provides _ | Install _ -> ())
|
||||||
|
|
||||||
let () = List.iter P.stanzas ~f:rules
|
let () = List.iter P.stanzas ~f:rules
|
||||||
|
|
||||||
|
|
|
@ -8,10 +8,27 @@ type conf =
|
||||||
; packages : Path.t String_map.t
|
; packages : Path.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let load ~dir ~visible_packages =
|
let load ~dir ~visible_packages ~version =
|
||||||
let stanzas = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) Stanza.vjs in
|
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
|
let stanzas = Stanza.resolve_packages stanzas ~dir ~visible_packages in
|
||||||
(dir, stanzas)
|
(version, stanzas)
|
||||||
|
|
||||||
let load () =
|
let load () =
|
||||||
let ftree = File_tree.load Path.root in
|
let ftree = File_tree.load Path.root in
|
||||||
|
@ -38,7 +55,7 @@ let load () =
|
||||||
|> List.map ~f:(fun (pkg, path) -> (path, pkg))
|
|> List.map ~f:(fun (pkg, path) -> (path, pkg))
|
||||||
|> Path.Map.of_alist_multi
|
|> Path.Map.of_alist_multi
|
||||||
in
|
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 path = File_tree.Dir.path dir in
|
||||||
let files = File_tree.Dir.files dir in
|
let files = File_tree.Dir.files dir in
|
||||||
let sub_dirs = File_tree.Dir.sub_dirs 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 ->
|
List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg ->
|
||||||
String_map.add acc ~key:pkg ~data:path)
|
String_map.add acc ~key:pkg ~data:path)
|
||||||
in
|
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 =
|
let sub_dirs =
|
||||||
if String_set.mem "jbuild-ignore" files then
|
if String_set.mem "jbuild-ignore" files then
|
||||||
let ignore_set =
|
let ignore_set =
|
||||||
|
@ -63,20 +87,13 @@ let load () =
|
||||||
let children, stanzas =
|
let children, stanzas =
|
||||||
String_map.fold sub_dirs ~init:([], stanzas)
|
String_map.fold sub_dirs ~init:([], stanzas)
|
||||||
~f:(fun ~key:_ ~data:dir (children, 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))
|
(child :: children, stanzas))
|
||||||
in
|
in
|
||||||
let stanzas =
|
|
||||||
if String_set.mem "jbuild" files then
|
|
||||||
load ~dir:path ~visible_packages
|
|
||||||
:: stanzas
|
|
||||||
else
|
|
||||||
stanzas
|
|
||||||
in
|
|
||||||
(Alias.Node (path, children), stanzas)
|
(Alias.Node (path, children), stanzas)
|
||||||
in
|
in
|
||||||
let root = File_tree.root ftree 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
|
{ file_tree = ftree
|
||||||
; tree
|
; tree
|
||||||
; stanzas
|
; stanzas
|
||||||
|
|
|
@ -11,6 +11,20 @@ open Sexp.Of_sexp
|
||||||
type sexp = Sexp.t = Atom of string | List of sexp list
|
type sexp = Sexp.t = Atom of string | List of sexp list
|
||||||
let of_sexp_error = Sexp.of_sexp_error
|
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 =
|
let invalid_module_name sexp =
|
||||||
of_sexp_error "invalid module name" sexp
|
of_sexp_error "invalid module name" sexp
|
||||||
|
|
||||||
|
@ -749,36 +763,47 @@ module Stanza = struct
|
||||||
| Provides of Provides.t
|
| Provides of Provides.t
|
||||||
| Install of Install_conf.t
|
| Install of Install_conf.t
|
||||||
| Alias of Alias_conf.t
|
| Alias of Alias_conf.t
|
||||||
| Other
|
|
||||||
|
let cstr' name args f =
|
||||||
|
cstr name args (fun x -> Some (f x))
|
||||||
|
|
||||||
let v1 =
|
let v1 =
|
||||||
sum
|
sum
|
||||||
[ cstr "library" [Library.v1] (fun x -> Library x)
|
[ cstr' "library" [Library.v1] (fun x -> Library x)
|
||||||
; cstr "executables" [Executables.v1] (fun x -> Executables x)
|
; cstr' "executables" [Executables.v1] (fun x -> Executables x)
|
||||||
; cstr "rule" [Rule.v1] (fun x -> Rule x)
|
; cstr' "rule" [Rule.v1] (fun x -> Rule x)
|
||||||
; cstr "ocamllex" [Ocamllex.v1] (fun x -> Ocamllex x)
|
; cstr' "ocamllex" [Ocamllex.v1] (fun x -> Ocamllex x)
|
||||||
; cstr "ocamlyacc" [Ocamlyacc.v1] (fun x -> Ocamlyacc x)
|
; cstr' "ocamlyacc" [Ocamlyacc.v1] (fun x -> Ocamlyacc x)
|
||||||
; cstr "provides" [Provides.v1] (fun x -> Provides x)
|
; cstr' "provides" [Provides.v1] (fun x -> Provides x)
|
||||||
; cstr "install" [Install_conf.v1] (fun x -> Install x)
|
; cstr' "install" [Install_conf.v1] (fun x -> Install x)
|
||||||
; cstr "alias" [Alias_conf.v1] (fun x -> Alias 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 vjs =
|
||||||
|
let ign name = cstr name [fun _ -> ()] (fun () -> None) in
|
||||||
sum
|
sum
|
||||||
[ cstr "library" [Library.vjs] (fun x -> Library x)
|
[ cstr' "library" [Library.vjs] (fun x -> Library x)
|
||||||
; cstr "executables" [Executables.vjs] (fun x -> Executables x)
|
; cstr' "executables" [Executables.vjs] (fun x -> Executables x)
|
||||||
; cstr "rule" [Rule.vjs] (fun x -> Rule x)
|
; cstr' "rule" [Rule.vjs] (fun x -> Rule x)
|
||||||
; cstr "ocamllex" [Ocamllex.vjs] (fun x -> Ocamllex x)
|
; cstr' "ocamllex" [Ocamllex.vjs] (fun x -> Ocamllex x)
|
||||||
; cstr "ocamlyacc" [Ocamlyacc.vjs] (fun x -> Ocamlyacc x)
|
; cstr' "ocamlyacc" [Ocamlyacc.vjs] (fun x -> Ocamlyacc x)
|
||||||
; cstr "provides" [Provides.vjs] (fun x -> Provides x)
|
; cstr' "provides" [Provides.vjs] (fun x -> Provides x)
|
||||||
; cstr "install" [Install_conf.vjs] (fun x -> Install x)
|
; cstr' "install" [Install_conf.vjs] (fun x -> Install x)
|
||||||
; cstr "alias" [Alias_conf.vjs] (fun x -> Alias x)
|
; cstr' "alias" [Alias_conf.vjs] (fun x -> Alias x)
|
||||||
; cstr "enforce_style" [fun _ -> ()] (fun _ -> Other )
|
; ign "enforce_style"
|
||||||
; cstr "toplevel_expect_tests" [fun _ -> ()] (fun _ -> Other)
|
; ign "toplevel_expect_tests"
|
||||||
; cstr "unified_tests" [fun _ -> ()] (fun _ -> Other)
|
; ign "unified_tests"
|
||||||
; cstr "embed" [fun _ -> ()] (fun _ -> Other)
|
; 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 =
|
let lib_names ts =
|
||||||
List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, stanzas) ->
|
List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, stanzas) ->
|
||||||
List.fold_left stanzas ~init:acc ~f:(fun acc -> function
|
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 ->
|
| Atom s ->
|
||||||
let (Constructor_spec.T c) = find_cstr cstrs sexp s in
|
let (Constructor_spec.T c) = find_cstr cstrs sexp s in
|
||||||
Constructor_args_spec.convert c.args sexp args c.make
|
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
|
end
|
||||||
(*
|
(*
|
||||||
module Both = struct
|
module Both = struct
|
||||||
|
|
|
@ -68,4 +68,6 @@ module Of_sexp : sig
|
||||||
val sum
|
val sum
|
||||||
: 'a Constructor_spec.t list
|
: 'a Constructor_spec.t list
|
||||||
-> 'a t
|
-> 'a t
|
||||||
|
|
||||||
|
val enum : (string * 'a) list -> 'a t
|
||||||
end
|
end
|
||||||
|
|
|
@ -20,7 +20,7 @@ let many fn f =
|
||||||
|> List.split
|
|> List.split
|
||||||
in
|
in
|
||||||
try
|
try
|
||||||
List.map sexps ~f
|
f sexps
|
||||||
with Sexp.Of_sexp_error (msg, sub) ->
|
with Sexp.Of_sexp_error (msg, sub) ->
|
||||||
let loc =
|
let loc =
|
||||||
match Sexp.locate_in_list sexps ~sub ~locs with
|
match Sexp.locate_in_list sexps ~sub ~locs with
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
val single : string -> (Sexp.t -> 'a) -> 'a
|
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