Parse and interpret (jbuilder_version ...) stanzas

This commit is contained in:
Jeremie Dimino 2017-02-24 10:03:39 +00:00
parent f9c80160f1
commit e2a607af6e
7 changed files with 99 additions and 37 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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