Start of support for languages and extensions
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
3cf2a0dab1
commit
250b940c32
|
@ -6,5 +6,3 @@
|
||||||
(libraries (stdune ocaml_config))
|
(libraries (stdune ocaml_config))
|
||||||
(flags (:standard -safe-string (:include flags/flags.sexp)))
|
(flags (:standard -safe-string (:include flags/flags.sexp)))
|
||||||
(preprocess no_preprocessing)))
|
(preprocess no_preprocessing)))
|
||||||
|
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(executable
|
(executable
|
||||||
((name mk)))
|
((name mk)))
|
||||||
|
|
||||||
|
|
2
src/dune
2
src/dune
|
@ -1,5 +1,3 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(library
|
(library
|
||||||
((name dune)
|
((name dune)
|
||||||
(libraries (unix
|
(libraries (unix
|
||||||
|
|
|
@ -1,12 +1,10 @@
|
||||||
open Import
|
open Import
|
||||||
open Sexp.Of_sexp
|
open Sexp.Of_sexp
|
||||||
|
|
||||||
module Lang = struct
|
module Kind = struct
|
||||||
type t =
|
type t =
|
||||||
|
| Dune
|
||||||
| Jbuilder
|
| Jbuilder
|
||||||
| Dune of Syntax.Version.t
|
|
||||||
|
|
||||||
let latest = Dune (0, 1)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Name : sig
|
module Name : sig
|
||||||
|
@ -114,23 +112,104 @@ end = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ lang : Lang.t
|
{ kind : Kind.t
|
||||||
; name : Name.t
|
; name : Name.t
|
||||||
; root : Path.t
|
; root : Path.t
|
||||||
; version : string option
|
; version : string option
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
|
; mutable stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
||||||
|
; mutable project_file : Path.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
let anonymous =
|
type project = t
|
||||||
{ lang = Lang.latest
|
|
||||||
; name = Name.anonymous_root
|
module Lang = struct
|
||||||
; packages = Package.Name.Map.empty
|
type t = Syntax.Version.t * (project -> Stanza.Parser.t list)
|
||||||
; root = Path.root
|
|
||||||
; version = None
|
let make ver f = (ver, f)
|
||||||
}
|
|
||||||
|
let langs = Hashtbl.create 32
|
||||||
|
|
||||||
|
let register name versions =
|
||||||
|
if Hashtbl.mem langs name then
|
||||||
|
Exn.code_error "Dune_project.Lang.register: already registered"
|
||||||
|
[ "name", Sexp.To_sexp.string name ];
|
||||||
|
Hashtbl.add langs name (Syntax.Versioned_parser.make versions)
|
||||||
|
|
||||||
|
let parse first_line =
|
||||||
|
let { Dune_lexer.
|
||||||
|
lang = (name_loc, name)
|
||||||
|
; version = (ver_loc, ver)
|
||||||
|
} = first_line
|
||||||
|
in
|
||||||
|
let ver = Syntax.Version.t (Atom (ver_loc, Sexp.Atom.of_string ver)) in
|
||||||
|
match Hashtbl.find langs name with
|
||||||
|
| None ->
|
||||||
|
Loc.fail name_loc "Unknown language %S.%s" name
|
||||||
|
(hint name (Hashtbl.keys langs))
|
||||||
|
| Some versions ->
|
||||||
|
Syntax.Versioned_parser.find_exn versions
|
||||||
|
~loc:ver_loc ~data_version:ver
|
||||||
|
|
||||||
|
let latest name =
|
||||||
|
let versions = Option.value_exn (Hashtbl.find langs name) in
|
||||||
|
Syntax.Versioned_parser.last versions
|
||||||
|
|
||||||
|
let version = fst
|
||||||
|
end
|
||||||
|
|
||||||
|
module Extension = struct
|
||||||
|
type maker =
|
||||||
|
T : ('a, Stanza.Parser.t list) Sexp.Of_sexp.Constructor_args_spec.t *
|
||||||
|
(project -> 'a)
|
||||||
|
-> maker
|
||||||
|
|
||||||
|
type t = Syntax.Version.t * maker
|
||||||
|
|
||||||
|
let make ver args_spec f = (ver, T (args_spec, f))
|
||||||
|
|
||||||
|
let extensions = Hashtbl.create 32
|
||||||
|
|
||||||
|
let register name versions =
|
||||||
|
if Hashtbl.mem extensions name then
|
||||||
|
Exn.code_error "Dune_project.Extension.register: already registered"
|
||||||
|
[ "name", Sexp.To_sexp.string name ];
|
||||||
|
Hashtbl.add extensions name (Syntax.Versioned_parser.make versions)
|
||||||
|
|
||||||
|
let parse project entries =
|
||||||
|
match String.Map.of_list entries with
|
||||||
|
| Error (name, _, (loc, _, _)) ->
|
||||||
|
Loc.fail loc "Exntesion %S specified for the second time." name
|
||||||
|
| Ok _ ->
|
||||||
|
List.concat_map entries ~f:(fun (name, (loc, (ver_loc, ver), args)) ->
|
||||||
|
match Hashtbl.find extensions name with
|
||||||
|
| None ->
|
||||||
|
Loc.fail loc "Unknown extension %S.%s" name
|
||||||
|
(hint name (Hashtbl.keys extensions))
|
||||||
|
| Some versions ->
|
||||||
|
let (T (spec, f)) =
|
||||||
|
Syntax.Versioned_parser.find_exn versions
|
||||||
|
~loc:ver_loc ~data_version:ver
|
||||||
|
in
|
||||||
|
Sexp.Of_sexp.Constructor_args_spec.parse spec args (f project))
|
||||||
|
end
|
||||||
|
|
||||||
let filename = "dune-project"
|
let filename = "dune-project"
|
||||||
|
|
||||||
|
let anonymous = lazy(
|
||||||
|
let t =
|
||||||
|
{ kind = Dune
|
||||||
|
; name = Name.anonymous_root
|
||||||
|
; packages = Package.Name.Map.empty
|
||||||
|
; root = Path.root
|
||||||
|
; version = None
|
||||||
|
; stanza_parser = (fun _ -> assert false)
|
||||||
|
; project_file = None
|
||||||
|
}
|
||||||
|
in
|
||||||
|
t.stanza_parser <- Sexp.Of_sexp.sum (snd (Lang.latest "dune") t);
|
||||||
|
t)
|
||||||
|
|
||||||
let default_name ~dir ~packages =
|
let default_name ~dir ~packages =
|
||||||
match Package.Name.Map.choose packages with
|
match Package.Name.Map.choose packages with
|
||||||
| None -> Option.value_exn (Name.anonymous dir)
|
| None -> Option.value_exn (Name.anonymous dir)
|
||||||
|
@ -153,43 +232,53 @@ let default_name ~dir ~packages =
|
||||||
let name ~dir ~packages =
|
let name ~dir ~packages =
|
||||||
field_o "name" Name.named_of_sexp >>= function
|
field_o "name" Name.named_of_sexp >>= function
|
||||||
| Some x -> return x
|
| Some x -> return x
|
||||||
| None -> return (default_name ~dir ~packages)
|
| None -> return (default_name ~dir ~packages)
|
||||||
|
|
||||||
let parse ~dir packages =
|
let parse ~dir ~lang_stanzas ~packages ~file =
|
||||||
record
|
record
|
||||||
(name ~dir ~packages >>= fun name ->
|
(name ~dir ~packages >>= fun name ->
|
||||||
field_o "version" string >>= fun version ->
|
field_o "version" string >>= fun version ->
|
||||||
return { lang = Dune (0, 1)
|
dup_field_multi "using"
|
||||||
; name
|
(located string
|
||||||
; root = dir
|
@> located Syntax.Version.t
|
||||||
; version
|
@> cstr_loc (rest raw))
|
||||||
; packages
|
(fun (loc, name) ver args_loc args ->
|
||||||
})
|
(name, (loc, ver, Sexp.Ast.List (args_loc, args))))
|
||||||
|
>>= fun extensions ->
|
||||||
|
let t =
|
||||||
|
{ kind = Dune
|
||||||
|
; name
|
||||||
|
; root = dir
|
||||||
|
; version
|
||||||
|
; packages
|
||||||
|
; stanza_parser = (fun _ -> assert false)
|
||||||
|
; project_file = Some file
|
||||||
|
}
|
||||||
|
in
|
||||||
|
let extenstions_stanzas = Extension.parse t extensions in
|
||||||
|
t.stanza_parser <- Sexp.Of_sexp.sum (lang_stanzas t @ extenstions_stanzas);
|
||||||
|
return t)
|
||||||
|
|
||||||
let load_dune_project ~dir packages =
|
let load_dune_project ~dir packages =
|
||||||
let fname = Path.relative dir filename in
|
let fname = Path.relative dir filename in
|
||||||
Io.with_lexbuf_from_file fname ~f:(fun lb ->
|
Io.with_lexbuf_from_file fname ~f:(fun lb ->
|
||||||
let { Dune_lexer. lang; version } = Dune_lexer.first_line lb in
|
let lang_stanzas = Lang.parse (Dune_lexer.first_line lb) in
|
||||||
(match lang with
|
|
||||||
| _, "dune" -> ()
|
|
||||||
| loc, s ->
|
|
||||||
Loc.fail loc "%s is not a supported langauge. \
|
|
||||||
Only the dune language is supported." s);
|
|
||||||
(match version with
|
|
||||||
| _, "1.0" -> ()
|
|
||||||
| loc, s ->
|
|
||||||
Loc.fail loc "Unsupported version of the dune language. \
|
|
||||||
The only supported version is 1.0." s);
|
|
||||||
let sexp = Sexp.Parser.parse lb ~mode:Many_as_one in
|
let sexp = Sexp.Parser.parse lb ~mode:Many_as_one in
|
||||||
parse ~dir packages sexp)
|
parse ~dir ~lang_stanzas ~packages ~file:fname sexp)
|
||||||
|
|
||||||
let make_jbuilder_project ~dir packages =
|
let make_jbuilder_project ~dir packages =
|
||||||
{ lang = Jbuilder
|
let t =
|
||||||
; name = default_name ~dir ~packages
|
{ kind = Jbuilder
|
||||||
; root = dir
|
; name = default_name ~dir ~packages
|
||||||
; version = None
|
; root = dir
|
||||||
; packages
|
; version = None
|
||||||
}
|
; packages
|
||||||
|
; stanza_parser = (fun _ -> assert false)
|
||||||
|
; project_file = None
|
||||||
|
}
|
||||||
|
in
|
||||||
|
t.stanza_parser <- Sexp.Of_sexp.sum (snd (Lang.latest "dune") t);
|
||||||
|
t
|
||||||
|
|
||||||
let load ~dir ~files =
|
let load ~dir ~files =
|
||||||
let packages =
|
let packages =
|
||||||
|
@ -217,3 +306,36 @@ let load ~dir ~files =
|
||||||
Some (make_jbuilder_project ~dir packages)
|
Some (make_jbuilder_project ~dir packages)
|
||||||
else
|
else
|
||||||
None
|
None
|
||||||
|
|
||||||
|
let notify_user s =
|
||||||
|
kerrf ~f:print_to_console "@{<warning>Info@}: %s\n" s
|
||||||
|
|
||||||
|
let project_file t =
|
||||||
|
match t.project_file with
|
||||||
|
| Some file -> file
|
||||||
|
| None ->
|
||||||
|
let file = Path.drop_optional_build_context (Path.relative t.root filename) in
|
||||||
|
let maj, min = fst (Lang.latest "dune") in
|
||||||
|
let s = sprintf "(lang dune %d.%d)" maj min in
|
||||||
|
notify_user
|
||||||
|
(sprintf "creating file %s with this contents: %s"
|
||||||
|
(Path.to_string_maybe_quoted file) s);
|
||||||
|
Io.write_file file (s ^ "\n") ~binary:false;
|
||||||
|
t.project_file <- Some file;
|
||||||
|
file
|
||||||
|
|
||||||
|
let ensure_project_file_exists t =
|
||||||
|
ignore (project_file t : Path.t)
|
||||||
|
|
||||||
|
let append_to_project_file t str =
|
||||||
|
let file = project_file t in
|
||||||
|
let prev = Io.read_file file ~binary:false in
|
||||||
|
notify_user
|
||||||
|
(sprintf "appending this line to %s: %s"
|
||||||
|
(Path.to_string_maybe_quoted file) str);
|
||||||
|
Io.with_file_out file ~binary:false ~f:(fun oc ->
|
||||||
|
List.iter [prev; str] ~f:(fun s ->
|
||||||
|
output_string oc s;
|
||||||
|
let len = String.length s in
|
||||||
|
if len > 0 && s.[len - 1] <> '\n' then output_char oc '\n'))
|
||||||
|
|
||||||
|
|
|
@ -2,10 +2,10 @@
|
||||||
|
|
||||||
open Import
|
open Import
|
||||||
|
|
||||||
module Lang : sig
|
module Kind : sig
|
||||||
type t =
|
type t =
|
||||||
|
| Dune
|
||||||
| Jbuilder
|
| Jbuilder
|
||||||
| Dune of Syntax.Version.t
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Name : sig
|
module Name : sig
|
||||||
|
@ -29,14 +29,68 @@ module Name : sig
|
||||||
val decode : string -> t
|
val decode : string -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(* CR-soon diml: make this abstract *)
|
||||||
type t =
|
type t =
|
||||||
{ lang : Lang.t
|
{ kind : Kind.t
|
||||||
; name : Name.t
|
; name : Name.t
|
||||||
; root : Path.t
|
; root : Path.t
|
||||||
; version : string option
|
; version : string option
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
|
; mutable 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
|
||||||
|
|
||||||
|
(** [make version stanzas_parser] defines one version of a
|
||||||
|
language. Users will select this language by writing:
|
||||||
|
|
||||||
|
{[ (lang <name> <version>) ]}
|
||||||
|
|
||||||
|
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 version : t -> Syntax.Version.t
|
||||||
|
|
||||||
|
(** Register all the supported versions of a language *)
|
||||||
|
val register : string -> t list -> unit
|
||||||
|
|
||||||
|
(** Latest version of the following language *)
|
||||||
|
val latest : string -> t
|
||||||
|
end with type project := t
|
||||||
|
|
||||||
|
module Extension : sig
|
||||||
|
type project = t
|
||||||
|
|
||||||
|
(** One version of an extension *)
|
||||||
|
type t
|
||||||
|
|
||||||
|
(** [make version args_spec f] defines one version of an
|
||||||
|
extension. Users will enable this extension by writing:
|
||||||
|
|
||||||
|
{[ (using <name> <version> <args>) ]}
|
||||||
|
|
||||||
|
in their [dune-project] file. [args_spec] is used to describe
|
||||||
|
what [<args>] might be.
|
||||||
|
*)
|
||||||
|
val make
|
||||||
|
: Syntax.Version.t
|
||||||
|
-> ('a, Stanza.Parser.t list) Sexp.Of_sexp.Constructor_args_spec.t
|
||||||
|
-> (project -> 'a)
|
||||||
|
-> t
|
||||||
|
|
||||||
|
(** Register all the supported versions of an extension *)
|
||||||
|
val register : string -> t list -> unit
|
||||||
|
end with type project := t
|
||||||
|
|
||||||
(** Load a project description from the following directory. [files]
|
(** Load a project description from the following directory. [files]
|
||||||
is the set of files in this directory. *)
|
is the set of files in this directory. *)
|
||||||
val load : dir:Path.t -> files:String.Set.t -> t option
|
val load : dir:Path.t -> files:String.Set.t -> t option
|
||||||
|
@ -46,4 +100,10 @@ val filename : string
|
||||||
|
|
||||||
(** Represent the scope at the root of the workspace when the root of
|
(** Represent the scope at the root of the workspace when the root of
|
||||||
the workspace contains no [dune-project] or [<package>.opam] files. *)
|
the workspace contains no [dune-project] or [<package>.opam] files. *)
|
||||||
val anonymous : t
|
val anonymous : t Lazy.t
|
||||||
|
|
||||||
|
(** Check that the dune-project file exists and create it otherwise. *)
|
||||||
|
val ensure_project_file_exists : t -> unit
|
||||||
|
|
||||||
|
(** Append the following text to the project file *)
|
||||||
|
val append_to_project_file : t -> string -> unit
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(library
|
(library
|
||||||
((name fiber)
|
((name fiber)
|
||||||
(libraries (stdune))
|
(libraries (stdune))
|
||||||
|
|
|
@ -108,7 +108,7 @@ module Dir = struct
|
||||||
{ files : String.Set.t
|
{ files : String.Set.t
|
||||||
; sub_dirs : t String.Map.t
|
; sub_dirs : t String.Map.t
|
||||||
; dune_file : Dune_file.t option
|
; dune_file : Dune_file.t option
|
||||||
; project : Dune_project.t option
|
; project : Dune_project.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let contents t = Lazy.force t.contents
|
let contents t = Lazy.force t.contents
|
||||||
|
@ -208,8 +208,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
in
|
in
|
||||||
let project =
|
let project =
|
||||||
match Dune_project.load ~dir:path ~files with
|
match Dune_project.load ~dir:path ~files with
|
||||||
| Some _ as x -> x
|
| Some x -> x
|
||||||
| None -> project
|
| None -> project
|
||||||
in
|
in
|
||||||
let dune_file, ignored_subdirs =
|
let dune_file, ignored_subdirs =
|
||||||
if ignored then
|
if ignored then
|
||||||
|
@ -219,6 +219,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
match List.filter ["dune"; "jbuild"] ~f:(String.Set.mem files) with
|
match List.filter ["dune"; "jbuild"] ~f:(String.Set.mem files) with
|
||||||
| [] -> (None, String.Set.empty)
|
| [] -> (None, String.Set.empty)
|
||||||
| [fn] ->
|
| [fn] ->
|
||||||
|
if fn = "dune" then
|
||||||
|
Dune_project.ensure_project_file_exists project;
|
||||||
let dune_file, ignored_subdirs =
|
let dune_file, ignored_subdirs =
|
||||||
Dune_file.load (Path.relative path fn)
|
Dune_file.load (Path.relative path fn)
|
||||||
~kind:(Dune_file.Kind.of_basename fn)
|
~kind:(Dune_file.Kind.of_basename fn)
|
||||||
|
@ -274,7 +276,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
(File.of_stats (Unix.stat (Path.to_string path)))
|
(File.of_stats (Unix.stat (Path.to_string path)))
|
||||||
path)
|
path)
|
||||||
~ignored:false
|
~ignored:false
|
||||||
~project:None
|
~project:(Lazy.force Dune_project.anonymous)
|
||||||
in
|
in
|
||||||
let dirs = Hashtbl.create 1024 in
|
let dirs = Hashtbl.create 1024 in
|
||||||
Hashtbl.add dirs Path.root root;
|
Hashtbl.add dirs Path.root root;
|
||||||
|
|
|
@ -58,7 +58,7 @@ module Dir : sig
|
||||||
val dune_file : t -> Dune_file.t option
|
val dune_file : t -> Dune_file.t option
|
||||||
|
|
||||||
(** Return the project this directory is part of *)
|
(** Return the project this directory is part of *)
|
||||||
val project : t -> Dune_project.t option
|
val project : t -> Dune_project.t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** A [t] value represent a view of the source tree. It is lazily
|
(** A [t] value represent a view of the source tree. It is lazily
|
||||||
|
|
|
@ -1278,38 +1278,52 @@ module Stanzas = struct
|
||||||
|
|
||||||
type Stanza.t += Include of Loc.t * string
|
type Stanza.t += Include of Loc.t * string
|
||||||
|
|
||||||
let t project : Stanza.t list Sexp.Of_sexp.t =
|
type constructors = Stanza.t list Sexp.Of_sexp.Constructor_spec.t list
|
||||||
sum
|
|
||||||
[ cstr "library" (Library.v1 project @> nil) (fun x -> [Library x])
|
let common project : constructors =
|
||||||
; cstr "executable" (Executables.v1_single project @> nil) execs
|
[ cstr "library" (Library.v1 project @> nil) (fun x -> [Library x])
|
||||||
; cstr "executables" (Executables.v1_multi project @> nil) execs
|
; cstr "executable" (Executables.v1_single project @> nil) execs
|
||||||
; cstr "rule" (cstr_loc (Rule.v1 @> nil)) (fun loc x -> [Rule { x with loc }])
|
; cstr "executables" (Executables.v1_multi project @> nil) execs
|
||||||
; cstr "ocamllex" (cstr_loc (Rule.ocamllex_v1 @> nil))
|
; cstr "rule" (cstr_loc (Rule.v1 @> nil)) (fun loc x -> [Rule { x with loc }])
|
||||||
(fun loc x -> rules (Rule.ocamllex_to_rule loc x))
|
; cstr "ocamllex" (cstr_loc (Rule.ocamllex_v1 @> nil))
|
||||||
; cstr "ocamlyacc" (cstr_loc (Rule.ocamlyacc_v1 @> nil))
|
(fun loc x -> rules (Rule.ocamllex_to_rule loc x))
|
||||||
(fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
|
; cstr "ocamlyacc" (cstr_loc (Rule.ocamlyacc_v1 @> nil))
|
||||||
; cstr "menhir" (cstr_loc (Menhir.v1 @> nil))
|
(fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
|
||||||
(fun loc x -> [Menhir { x with loc }])
|
; cstr "menhir" (cstr_loc (Menhir.v1 @> nil))
|
||||||
; cstr "install" (Install_conf.v1 project @> nil) (fun x -> [Install x])
|
(fun loc x -> [Menhir { x with loc }])
|
||||||
; cstr "alias" (Alias_conf.v1 project @> nil) (fun x -> [Alias x])
|
; cstr "install" (Install_conf.v1 project @> nil) (fun x -> [Install x])
|
||||||
; cstr "copy_files" (Copy_files.v1 @> nil)
|
; cstr "alias" (Alias_conf.v1 project @> nil) (fun x -> [Alias x])
|
||||||
(fun glob -> [Copy_files {add_line_directive = false; glob}])
|
; cstr "copy_files" (Copy_files.v1 @> nil)
|
||||||
; cstr "copy_files#" (Copy_files.v1 @> nil)
|
(fun glob -> [Copy_files {add_line_directive = false; glob}])
|
||||||
(fun glob -> [Copy_files {add_line_directive = true; glob}])
|
; cstr "copy_files#" (Copy_files.v1 @> nil)
|
||||||
; cstr "env" (cstr_loc (rest Env.rule))
|
(fun glob -> [Copy_files {add_line_directive = true; glob}])
|
||||||
(fun loc rules -> [Env { loc; rules }])
|
; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn ->
|
||||||
(* Just for validation and error messages *)
|
[Include (loc, fn)])
|
||||||
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
|
; cstr "documentation" (Documentation.v1 project @> nil)
|
||||||
; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn ->
|
(fun d -> [Documentation d])
|
||||||
[Include (loc, fn)])
|
]
|
||||||
; cstr "documentation" (Documentation.v1 project @> nil)
|
|
||||||
(fun d -> [Documentation d])
|
let dune project =
|
||||||
|
common project @
|
||||||
|
[ cstr "env" (cstr_loc (rest Env.rule))
|
||||||
|
(fun loc rules -> [Env { loc; rules }])
|
||||||
|
]
|
||||||
|
|
||||||
|
let jbuild project =
|
||||||
|
common project @
|
||||||
|
[ cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
|
||||||
|
]
|
||||||
|
|
||||||
|
let () =
|
||||||
|
let open Dune_project.Lang in
|
||||||
|
register "dune"
|
||||||
|
[ make (1, 0) dune
|
||||||
]
|
]
|
||||||
|
|
||||||
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
||||||
|
|
||||||
let rec parse t ~current_file ~include_stack sexps =
|
let rec parse stanza_parser ~current_file ~include_stack sexps =
|
||||||
List.concat_map sexps ~f:t
|
List.concat_map sexps ~f:stanza_parser
|
||||||
|> List.concat_map ~f:(function
|
|> List.concat_map ~f:(function
|
||||||
| Include (loc, fn) ->
|
| Include (loc, fn) ->
|
||||||
let include_stack = (loc, current_file) :: include_stack in
|
let include_stack = (loc, current_file) :: include_stack in
|
||||||
|
@ -1321,13 +1335,18 @@ module Stanzas = struct
|
||||||
if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then
|
if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then
|
||||||
raise (Include_loop (current_file, include_stack));
|
raise (Include_loop (current_file, include_stack));
|
||||||
let sexps = Io.Sexp.load current_file ~mode:Many in
|
let sexps = Io.Sexp.load current_file ~mode:Many in
|
||||||
parse t sexps ~current_file ~include_stack
|
parse stanza_parser sexps ~current_file ~include_stack
|
||||||
| stanza -> [stanza])
|
| stanza -> [stanza])
|
||||||
|
|
||||||
let parse ~file project sexps =
|
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
|
||||||
|
in
|
||||||
let stanzas =
|
let stanzas =
|
||||||
try
|
try
|
||||||
parse (t project) sexps ~include_stack:[] ~current_file:file
|
parse stanza_parser sexps ~include_stack:[] ~current_file:file
|
||||||
with
|
with
|
||||||
| Include_loop (_, []) -> assert false
|
| Include_loop (_, []) -> assert false
|
||||||
| Include_loop (file, last :: rest) ->
|
| Include_loop (file, last :: rest) ->
|
||||||
|
|
|
@ -376,6 +376,7 @@ module Stanzas : sig
|
||||||
|
|
||||||
val parse
|
val parse
|
||||||
: file:Path.t
|
: file:Path.t
|
||||||
|
-> kind:File_tree.Dune_file.Kind.t
|
||||||
-> Dune_project.t
|
-> Dune_project.t
|
||||||
-> Sexp.Ast.t list
|
-> Sexp.Ast.t list
|
||||||
-> t
|
-> t
|
||||||
|
|
|
@ -166,7 +166,7 @@ end
|
||||||
let stanzas =
|
let stanzas =
|
||||||
Io.Sexp.load generated_jbuild ~mode:Many
|
Io.Sexp.load generated_jbuild ~mode:Many
|
||||||
~lexer:(File_tree.Dune_file.Kind.lexer kind)
|
~lexer:(File_tree.Dune_file.Kind.lexer kind)
|
||||||
|> Stanzas.parse project ~file:generated_jbuild
|
|> Stanzas.parse project ~file:generated_jbuild ~kind
|
||||||
|> filter_stanzas ~ignore_promoted_rules
|
|> filter_stanzas ~ignore_promoted_rules
|
||||||
in
|
in
|
||||||
Fiber.return
|
Fiber.return
|
||||||
|
@ -192,7 +192,7 @@ let interpret ~dir ~project ~ignore_promoted_rules
|
||||||
match dune_file.contents with
|
match dune_file.contents with
|
||||||
| Plain p ->
|
| Plain p ->
|
||||||
let stanzas =
|
let stanzas =
|
||||||
Stanzas.parse project p.sexps ~file:p.path
|
Stanzas.parse project p.sexps ~file:p.path ~kind:dune_file.kind
|
||||||
|> filter_stanzas ~ignore_promoted_rules
|
|> filter_stanzas ~ignore_promoted_rules
|
||||||
in
|
in
|
||||||
let jbuild =
|
let jbuild =
|
||||||
|
@ -213,9 +213,11 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
let projects =
|
let projects =
|
||||||
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
|
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
|
||||||
~f:(fun dir acc ->
|
~f:(fun dir acc ->
|
||||||
match File_tree.Dir.project dir with
|
let p = File_tree.Dir.project dir in
|
||||||
| Some p when p.root = File_tree.Dir.path dir -> p :: acc
|
if p.root = File_tree.Dir.path dir then
|
||||||
| _ -> acc)
|
p :: acc
|
||||||
|
else
|
||||||
|
acc)
|
||||||
in
|
in
|
||||||
let packages =
|
let packages =
|
||||||
List.fold_left projects ~init:Package.Name.Map.empty
|
List.fold_left projects ~init:Package.Name.Map.empty
|
||||||
|
@ -236,13 +238,8 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
(p.root, p))
|
(p.root, p))
|
||||||
|> Path.Map.of_list_exn
|
|> Path.Map.of_list_exn
|
||||||
in
|
in
|
||||||
|
assert (Path.Map.mem projects Path.root);
|
||||||
|
|
||||||
let projects =
|
|
||||||
if Path.Map.mem projects Path.root then
|
|
||||||
projects
|
|
||||||
else
|
|
||||||
Path.Map.add projects Path.root Dune_project.anonymous
|
|
||||||
in
|
|
||||||
let rec walk dir jbuilds project =
|
let rec walk dir jbuilds project =
|
||||||
if File_tree.Dir.ignored dir then
|
if File_tree.Dir.ignored dir then
|
||||||
jbuilds
|
jbuilds
|
||||||
|
@ -263,7 +260,10 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
||||||
~f:(fun dir jbuilds -> walk dir jbuilds project)
|
~f:(fun dir jbuilds -> walk dir jbuilds project)
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
let jbuilds = walk (File_tree.root ftree) [] Dune_project.anonymous in
|
let jbuilds =
|
||||||
|
let project = Option.value_exn (Path.Map.find projects Path.root) in
|
||||||
|
walk (File_tree.root ftree) [] project
|
||||||
|
in
|
||||||
{ file_tree = ftree
|
{ file_tree = ftree
|
||||||
; jbuilds = { jbuilds; ignore_promoted_rules }
|
; jbuilds = { jbuilds; ignore_promoted_rules }
|
||||||
; packages
|
; packages
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(library
|
(library
|
||||||
((name ocaml_config)
|
((name ocaml_config)
|
||||||
(public_name dune.ocaml_config)
|
(public_name dune.ocaml_config)
|
||||||
|
|
|
@ -1 +1,7 @@
|
||||||
|
open Stdune
|
||||||
|
|
||||||
type t = ..
|
type t = ..
|
||||||
|
|
||||||
|
module Parser = struct
|
||||||
|
type nonrec t = t list Sexp.Of_sexp.Constructor_spec.t
|
||||||
|
end
|
||||||
|
|
|
@ -1,3 +1,13 @@
|
||||||
(** Stanza in dune/jbuild files *)
|
(** Stanza in dune/jbuild files *)
|
||||||
|
|
||||||
|
open Stdune
|
||||||
|
|
||||||
type t = ..
|
type t = ..
|
||||||
|
|
||||||
|
module Parser : sig
|
||||||
|
(** Type of stanza parser.
|
||||||
|
|
||||||
|
Each stanza in a configuration file might produce several values
|
||||||
|
of type [t], hence the [t list] here. *)
|
||||||
|
type nonrec t = t list Sexp.Of_sexp.Constructor_spec.t
|
||||||
|
end
|
||||||
|
|
|
@ -67,3 +67,5 @@ let foldi t ~init ~f = fold t ~init ~f:(fun ~key ~data acc -> f key data acc)
|
||||||
let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
|
let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
|
||||||
|
|
||||||
let iter t ~f = iter ~f t
|
let iter t ~f = iter ~f t
|
||||||
|
|
||||||
|
let keys t = foldi t ~init:[] ~f:(fun key _ acc -> key :: acc)
|
||||||
|
|
|
@ -25,3 +25,5 @@ val fold : ('a, 'b) t -> init:'c -> f:( 'b -> 'c -> 'c) -> 'c
|
||||||
val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c
|
val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c
|
||||||
|
|
||||||
val mem : ('a, _) t -> 'a -> bool
|
val mem : ('a, _) t -> 'a -> bool
|
||||||
|
|
||||||
|
val keys : ('a, _) t -> 'a list
|
||||||
|
|
|
@ -41,11 +41,12 @@ let read_all ic =
|
||||||
let len = in_channel_length ic in
|
let len = in_channel_length ic in
|
||||||
really_input_string ic len
|
really_input_string ic len
|
||||||
|
|
||||||
let read_file fn = with_file_in fn ~f:read_all
|
let read_file ?binary fn = with_file_in fn ~f:read_all ?binary
|
||||||
|
|
||||||
let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false
|
let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false
|
||||||
|
|
||||||
let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)
|
let write_file ?binary fn data =
|
||||||
|
with_file_out ?binary fn ~f:(fun oc -> output_string oc data)
|
||||||
|
|
||||||
let write_lines fn lines =
|
let write_lines fn lines =
|
||||||
with_file_out fn ~f:(fun oc ->
|
with_file_out fn ~f:(fun oc ->
|
||||||
|
|
|
@ -13,8 +13,8 @@ val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a
|
||||||
|
|
||||||
val lines_of_file : Path.t -> string list
|
val lines_of_file : Path.t -> string list
|
||||||
|
|
||||||
val read_file : Path.t -> string
|
val read_file : ?binary:bool -> Path.t -> string
|
||||||
val write_file : Path.t -> string -> unit
|
val write_file : ?binary:bool -> Path.t -> string -> unit
|
||||||
|
|
||||||
val compare_files : Path.t -> Path.t -> Ordering.t
|
val compare_files : Path.t -> Path.t -> Ordering.t
|
||||||
|
|
||||||
|
|
|
@ -363,6 +363,12 @@ module Of_sexp = struct
|
||||||
| Cons (conv, t), s :: l -> convert t sexp l (f (conv s))
|
| Cons (conv, t), s :: l -> convert t sexp l (f (conv s))
|
||||||
| Cons _, [] -> of_sexp_error sexp "not enough arguments"
|
| Cons _, [] -> of_sexp_error sexp "not enough arguments"
|
||||||
| Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
|
| Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
|
||||||
|
|
||||||
|
let parse t sexp f =
|
||||||
|
match sexp with
|
||||||
|
| Atom _ | Quoted_string _ ->
|
||||||
|
of_sexp_error sexp "List expected"
|
||||||
|
| List (_, l) -> convert t sexp l f
|
||||||
end
|
end
|
||||||
|
|
||||||
let nil = Constructor_args_spec.Nil
|
let nil = Constructor_args_spec.Nil
|
||||||
|
|
|
@ -124,6 +124,8 @@ module Of_sexp : sig
|
||||||
|
|
||||||
module Constructor_args_spec : sig
|
module Constructor_args_spec : sig
|
||||||
type ('a, 'b) t
|
type ('a, 'b) t
|
||||||
|
|
||||||
|
val parse : ('a, 'b) t -> Ast.t -> 'a -> 'b
|
||||||
end
|
end
|
||||||
|
|
||||||
val nil : ('a, 'a) Constructor_args_spec.t
|
val nil : ('a, 'a) Constructor_args_spec.t
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(library
|
(library
|
||||||
((name usexp)
|
((name usexp)
|
||||||
(synopsis "[Internal] S-expression library")
|
(synopsis "[Internal] S-expression library")
|
||||||
|
|
|
@ -1,3 +1 @@
|
||||||
(jbuild_version 1)
|
|
||||||
|
|
||||||
(library ((name xdg)))
|
(library ((name xdg)))
|
||||||
|
|
|
@ -90,6 +90,15 @@
|
||||||
test-cases/dune-ppx-driver-system
|
test-cases/dune-ppx-driver-system
|
||||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||||
|
|
||||||
|
(alias
|
||||||
|
((name dune-project-edition)
|
||||||
|
(deps
|
||||||
|
((package dune) (files_recursively_in test-cases/dune-project-edition)))
|
||||||
|
(action
|
||||||
|
(chdir
|
||||||
|
test-cases/dune-project-edition
|
||||||
|
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name env)
|
((name env)
|
||||||
(deps ((package dune) (files_recursively_in test-cases/env)))
|
(deps ((package dune) (files_recursively_in test-cases/env)))
|
||||||
|
@ -556,6 +565,7 @@
|
||||||
(alias custom-build-dir)
|
(alias custom-build-dir)
|
||||||
(alias depend-on-the-universe)
|
(alias depend-on-the-universe)
|
||||||
(alias dune-ppx-driver-system)
|
(alias dune-ppx-driver-system)
|
||||||
|
(alias dune-project-edition)
|
||||||
(alias env)
|
(alias env)
|
||||||
(alias exclude-missing-module)
|
(alias exclude-missing-module)
|
||||||
(alias exec-cmd)
|
(alias exec-cmd)
|
||||||
|
@ -621,6 +631,7 @@
|
||||||
(alias custom-build-dir)
|
(alias custom-build-dir)
|
||||||
(alias depend-on-the-universe)
|
(alias depend-on-the-universe)
|
||||||
(alias dune-ppx-driver-system)
|
(alias dune-ppx-driver-system)
|
||||||
|
(alias dune-project-edition)
|
||||||
(alias env)
|
(alias env)
|
||||||
(alias exclude-missing-module)
|
(alias exclude-missing-module)
|
||||||
(alias exec-cmd)
|
(alias exec-cmd)
|
||||||
|
|
|
@ -0,0 +1,9 @@
|
||||||
|
$ cat dune-project
|
||||||
|
cat: dune-project: No such file or directory
|
||||||
|
[1]
|
||||||
|
$ mkdir src
|
||||||
|
$ echo '(alias ((name runtest) (action (progn))))' > src/dune
|
||||||
|
$ dune build
|
||||||
|
Info: creating file dune-project with this contents: (lang dune 1.0)
|
||||||
|
$ cat dune-project
|
||||||
|
(lang dune 1.0)
|
Loading…
Reference in New Issue