matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Pass the project through the user context 

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-06-19 12:12:48 +01:00
parent 0c6edde131
commit 5d1d3a2eae
3 changed files with 96 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
src/dune_project.ml
View File

@ -112,19 +112,17 @@ end = struct
end
type t =
{ kind : Kind.t
; name : Name.t
; root : Path.Local.t
; version : string option
; packages : Package.t Package.Name.Map.t
; mutable stanza_parser : Stanza.t list Sexp.Of_sexp.t
; mutable project_file : Path.t option
{ kind : Kind.t
; name : Name.t
; root : Path.Local.t
; version : string option
; packages : Package.t Package.Name.Map.t
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
; mutable project_file : Path.t option
}
type project = t
module Lang = struct
type t = Syntax.Version.t * (project -> Stanza.Parser.t list)
type t = Syntax.Version.t * Stanza.Parser.t list
let make ver f = (ver, f)
@ -161,9 +159,7 @@ module Lang = struct
end
module Extension = struct
type maker = project -> Stanza.Parser.t list Sexp.Of_sexp.t
type t = Syntax.Version.t * maker
type t = Syntax.Version.t * Stanza.Parser.t list Sexp.Of_sexp.t
let make ver f = (ver, f)
@ -184,6 +180,15 @@ module Extension = struct
Syntax.Versioned_parser.find_exn versions ~loc:ver_loc ~data_version:ver
end
let key = Univ_map.Key.create ()
let set t = Sexp.Of_sexp.set key t
let get_exn () =
let open Sexp.Of_sexp in
get key >>| function
| Some t -> t
| None ->
Exn.code_error "Current project is unset" []
let filename = "dune-project"
let get_local_path p =
@ -191,23 +196,15 @@ let get_local_path p =
| External _ -> assert false
| Local p -> p
let fake_stanza_parser =
let open Sexp.Of_sexp in
return () >>| fun _ -> assert false
let anonymous = lazy(
let t =
{ kind = Dune
; name = Name.anonymous_root
; packages = Package.Name.Map.empty
; root = get_local_path Path.root
; version = None
; stanza_parser = fake_stanza_parser
; project_file = None
}
in
t.stanza_parser <- Sexp.Of_sexp.sum (snd (Lang.latest "dune") t);
t)
let anonymous = lazy (
{ kind = Dune
; name = Name.anonymous_root
; packages = Package.Name.Map.empty
; root = get_local_path Path.root
; version = None
; stanza_parser = Sexp.Of_sexp.sum (snd (Lang.latest "dune"))
; project_file = None
})
let default_name ~dir ~packages =
match Package.Name.Map.choose packages with
@ -237,21 +234,11 @@ let parse ~dir ~lang_stanzas ~packages ~file =
record
(name ~dir ~packages >>= fun name ->
field_o "version" string >>= fun version ->
let t =
{ kind = Dune
; name
; root = get_local_path dir
; version
; packages
; stanza_parser = fake_stanza_parser
; project_file = Some file
}
in
multi_field "using"
(loc >>= fun loc ->
located string >>= fun name ->
located Syntax.Version.t >>= fun ver ->
Extension.lookup name ver t >>= fun stanzas ->
Extension.lookup name ver >>= fun stanzas ->
return (snd name, (loc, stanzas)))
>>= fun extensions ->
let extensions_stanzas =
@ -261,8 +248,15 @@ let parse ~dir ~lang_stanzas ~packages ~file =
| Ok _ ->
List.concat_map extensions ~f:(fun (_, (_, x)) -> x)
in
t.stanza_parser <- Sexp.Of_sexp.sum (lang_stanzas t @ extensions_stanzas);
return t)
return
{ kind = Dune
; name
; root = get_local_path dir
; version
; packages
; stanza_parser = Sexp.Of_sexp.sum (lang_stanzas @ extensions_stanzas)
; project_file = Some file
})
let load_dune_project ~dir packages =
let fname = Path.relative dir filename in
@ -273,18 +267,14 @@ let load_dune_project ~dir packages =
Univ_map.empty sexp)
let make_jbuilder_project ~dir packages =
let t =
{ kind = Jbuilder
; name = default_name ~dir ~packages
; root = get_local_path dir
; version = None
; packages
; stanza_parser = fake_stanza_parser
; project_file = None
}
in
t.stanza_parser <- Sexp.Of_sexp.sum (snd (Lang.latest "dune") t);
t
{ kind = Jbuilder
; name = default_name ~dir ~packages
; root = get_local_path dir
; version = None
; packages
; stanza_parser = Sexp.Of_sexp.sum (snd (Lang.latest "dune"))
; project_file = None
}
let load ~dir ~files =
let packages =
@ -344,4 +334,3 @@ let append_to_project_file t str =
output_string oc s;
let len = String.length s in
if len > 0 && s.[len - 1] <> '\n' then output_char oc '\n'))

36
src/dune_project.mli
View File

@ -31,18 +31,16 @@ end
(* CR-soon diml: make this abstract *)
type t = private
{ kind : Kind.t
; name : Name.t
; root : Path.Local.t
; version : string option
; packages : Package.t Package.Name.Map.t
; mutable stanza_parser : Stanza.t list Sexp.Of_sexp.t
; mutable project_file : Path.t option
{ kind : Kind.t
; name : Name.t
; root : Path.Local.t
; version : string option
; packages : Package.t Package.Name.Map.t
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
; mutable project_file : Path.t option
}
module Lang : sig
type project = t
(** One version of a language *)
type t
@ -53,10 +51,7 @@ module Lang : sig
as the first line of their [dune-project] file. [stanza_parsers]
defines what stanzas the user can write in [dune] files. *)
val make
: Syntax.Version.t
-> (project -> Stanza.Parser.t list)
-> t
val make : Syntax.Version.t -> Stanza.Parser.t list -> t
val version : t -> Syntax.Version.t
@ -65,11 +60,9 @@ module Lang : sig
(** Latest version of the following language *)
val latest : string -> t
end with type project := t
end
module Extension : sig
type project = t
(** One version of an extension *)
type t
@ -80,14 +73,11 @@ module Extension : sig
in their [dune-project] file. [parser] is used to describe
what [<args>] might be. *)
val make
: Syntax.Version.t
-> (project -> Stanza.Parser.t list Sexp.Of_sexp.t)
-> t
val make : Syntax.Version.t -> Stanza.Parser.t list Sexp.Of_sexp.t -> t
(** Register all the supported versions of an extension *)
val register : string -> t list -> unit
end with type project := t
end
(** Load a project description from the following directory. [files]
is the set of files in this directory. *)
@ -105,3 +95,7 @@ val ensure_project_file_exists : t -> unit
(** Append the following text to the project file *)
val append_to_project_file : t -> string -> unit
(** Set the project we are currently parsing dune files for *)
val set : t -> ('a, 'k) Sexp.Of_sexp.parser -> ('a, 'k) Sexp.Of_sexp.parser
val get_exn : unit -> (t, 'k) Sexp.Of_sexp.parser

67
src/jbuild.ml
View File

@ -154,13 +154,15 @@ module Pkg = struct
(hint name_s (Package.Name.Map.keys project.packages
|> List.map ~f:Package.Name.to_string)))
let t p =
let t =
Dune_project.get_exn () >>= fun p ->
located Package.Name.t >>| fun (loc, name) ->
match resolve p name with
| Ok x -> x
| Error e -> Loc.fail loc "%s" e
let field p =
let field =
Dune_project.get_exn () >>= fun p ->
map_validate (field_o "package" string) ~f:(function
| None -> default p
| Some name -> resolve p (Package.Name.of_string name))
@ -550,7 +552,8 @@ module Public_lib = struct
; sub_dir : string option
}
let public_name_field project =
let public_name_field =
Dune_project.get_exn () >>= fun project ->
map_validate (field_o "public_name" string) ~f:(function
| None -> Ok None
| Some s ->
@ -701,11 +704,11 @@ module Library = struct
; sub_systems : Sub_system_info.t Sub_system_name.Map.t
}
let v1 project =
let v1 =
record
(Buildable.v1 >>= fun buildable ->
field "name" library_name >>= fun name ->
Public_lib.public_name_field project >>= fun public ->
Public_lib.public_name_field >>= fun public ->
field_o "synopsis" string >>= fun synopsis ->
field "install_c_headers" (list string) ~default:[] >>= fun install_c_headers ->
field "ppx_runtime_libraries" (list (located string)) ~default:[] >>= fun ppx_runtime_libraries ->
@ -723,6 +726,7 @@ module Library = struct
field "self_build_stubs_archive" (option string) ~default:None >>= fun self_build_stubs_archive ->
field_b "no_dynlink" >>= fun no_dynlink ->
Sub_system_info.record_parser () >>= fun sub_systems ->
Dune_project.get_exn () >>= fun project ->
return
{ name
; public
@ -782,11 +786,11 @@ module Install_conf = struct
; package : Package.t
}
let v1 project =
let v1 =
record
(field "section" Install.Section.t >>= fun section ->
field "files" (list file) >>= fun files ->
Pkg.field project >>= fun package ->
Pkg.field >>= fun package ->
return
{ section
; files
@ -902,7 +906,7 @@ module Executables = struct
; buildable : Buildable.t
}
let common project names public_names ~syntax ~multi =
let common names public_names ~syntax ~multi =
Buildable.v1 >>= fun buildable ->
(match (syntax : File_tree.Dune_file.Kind.t) with
| Dune ->
@ -974,7 +978,7 @@ module Executables = struct
(if multi then "s" else "");
return (t, None))
| files ->
Pkg.field project >>= fun package ->
Pkg.field >>= fun package ->
return (t, Some { Install_conf. section = Bin; files; package })
let public_name =
@ -982,7 +986,7 @@ module Executables = struct
| "-" -> None
| s -> Some s
let multi ~syntax project =
let multi ~syntax =
record
(field "names" (list (located string)) >>= fun names ->
map_validate (field_o "public_names" (list public_name)) ~f:(function
@ -994,13 +998,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 project names public_names ~multi:true)
common ~syntax names public_names ~multi:true)
let single ~syntax project =
let single ~syntax =
record
(field "name" (located string) >>= fun name ->
field_o "public_name" string >>= fun public_name ->
common ~syntax project [name] [public_name] ~multi:false)
common ~syntax [name] [public_name] ~multi:false)
end
module Rule = struct
@ -1181,11 +1185,11 @@ module Alias_conf = struct
else
s)
let v1 project =
let v1 =
record
(field "name" alias_name >>= fun name ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field_o "package" (Pkg.t project) >>= fun package ->
field_o "package" Pkg.t >>= fun package ->
field_o "action" (located Action.Unexpanded.t) >>= fun action ->
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
return
@ -1211,9 +1215,9 @@ module Documentation = struct
; mld_files: Ordered_set_lang.t
}
let v1 project =
let v1 =
record
(Pkg.field project >>= fun package ->
(Pkg.field >>= fun package ->
field "mld_files" Ordered_set_lang.t ~default:Ordered_set_lang.standard
>>= fun mld_files ->
return
@ -1289,12 +1293,12 @@ module Stanzas = struct
type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
let common project ~syntax : constructors =
let common ~syntax : constructors =
[ "library",
(Library.v1 project >>| fun x ->
(Library.v1 >>| fun x ->
[Library x])
; "executable" , Executables.single project ~syntax >>| execs
; "executables", Executables.multi project ~syntax >>| execs
; "executable" , Executables.single ~syntax >>| execs
; "executables", Executables.multi ~syntax >>| execs
; "rule",
(loc >>= fun loc ->
Rule.v1 >>| fun x ->
@ -1312,10 +1316,10 @@ module Stanzas = struct
Menhir.v1 >>| fun x ->
[Menhir { x with loc }])
; "install",
(Install_conf.v1 project >>| fun x ->
(Install_conf.v1 >>| fun x ->
[Install x])
; "alias",
(Alias_conf.v1 project >>| fun x ->
(Alias_conf.v1 >>| fun x ->
[Alias x])
; "copy_files",
(Copy_files.v1 >>| fun glob ->
@ -1328,20 +1332,20 @@ module Stanzas = struct
relative_file >>| fun fn ->
[Include (loc, fn)])
; "documentation",
(Documentation.v1 project >>| fun d ->
(Documentation.v1 >>| fun d ->
[Documentation d])
]
let dune project =
common project ~syntax:Dune @
let dune =
common ~syntax:Dune @
[ "env",
(loc >>= fun loc ->
repeat Env.rule >>| fun rules ->
[Env { loc; rules }])
]
let jbuild project =
common project ~syntax:Jbuild @
let jbuild =
common ~syntax:Jbuild @
[ "jbuild_version", (Jbuild_version.t >>| fun _ -> [])
]
@ -1371,9 +1375,10 @@ module Stanzas = struct
let parse ~file ~kind (project : Dune_project.t) sexps =
let stanza_parser =
match (kind : File_tree.Dune_file.Kind.t) with
| Jbuild -> sum (jbuild project)
| Dune -> project.stanza_parser
Dune_project.set project
(match (kind : File_tree.Dune_file.Kind.t) with
| Jbuild -> sum jbuild
| Dune -> project.stanza_parser)
in
let stanzas =
try