Implement automatic edition of the dune-project file for extensions
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
bb1ea7c56c
commit
74c008ea62
|
@ -111,14 +111,21 @@ end = struct
|
||||||
| _ -> invalid s
|
| _ -> invalid s
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Project_file = struct
|
||||||
|
type t =
|
||||||
|
{ file : Path.t
|
||||||
|
; mutable exists : bool
|
||||||
|
}
|
||||||
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ kind : Kind.t
|
{ kind : Kind.t
|
||||||
; name : Name.t
|
; name : Name.t
|
||||||
; root : Path.Local.t
|
; root : Path.Local.t
|
||||||
; version : string option
|
; version : string option
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
||||||
; mutable project_file : Path.t option
|
; project_file : Project_file.t
|
||||||
}
|
}
|
||||||
|
|
||||||
module Lang = struct
|
module Lang = struct
|
||||||
|
@ -167,6 +174,46 @@ module Lang = struct
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Project_file_edit = struct
|
||||||
|
open Project_file
|
||||||
|
|
||||||
|
let notify_user s =
|
||||||
|
kerrf ~f:print_to_console "@{<warning>Info@}: %s\n" s
|
||||||
|
|
||||||
|
let ensure_exists t =
|
||||||
|
if not t.exists then begin
|
||||||
|
let ver = (Lang.get_exn "dune").version in
|
||||||
|
let s = sprintf "(lang dune %s)" (Syntax.Version.to_string ver) in
|
||||||
|
notify_user
|
||||||
|
(sprintf "creating file %s with this contents: %s"
|
||||||
|
(Path.to_string_maybe_quoted t.file) s);
|
||||||
|
Io.write_file t.file (s ^ "\n") ~binary:false;
|
||||||
|
t.exists <- true
|
||||||
|
end
|
||||||
|
|
||||||
|
let get t =
|
||||||
|
ensure_exists t;
|
||||||
|
t.file
|
||||||
|
|
||||||
|
let append t str =
|
||||||
|
let file = get 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'))
|
||||||
|
end
|
||||||
|
|
||||||
|
let ensure_project_file_exists t =
|
||||||
|
Project_file_edit.ensure_exists t.project_file
|
||||||
|
|
||||||
|
let append_to_project_file t str =
|
||||||
|
Project_file_edit.append t.project_file str
|
||||||
|
|
||||||
module Extension = struct
|
module Extension = struct
|
||||||
type t =
|
type t =
|
||||||
{ syntax : Syntax.t
|
{ syntax : Syntax.t
|
||||||
|
@ -201,6 +248,39 @@ module Extension = struct
|
||||||
; loc
|
; loc
|
||||||
; parse_args
|
; parse_args
|
||||||
}
|
}
|
||||||
|
|
||||||
|
(* Extensions that are not selected in the dune-project file are
|
||||||
|
automatically available at their latest version. When used, dune
|
||||||
|
will automatically edit the dune-project file. *)
|
||||||
|
let automatic ~project_file ~f =
|
||||||
|
Hashtbl.foldi extensions ~init:[] ~f:(fun name ext acc ->
|
||||||
|
if f name then
|
||||||
|
let version = Syntax.greatest_supported_version ext.syntax in
|
||||||
|
let parse_args p =
|
||||||
|
let open Sexp.Of_sexp in
|
||||||
|
let dune_project_edited = ref false in
|
||||||
|
parse p Univ_map.empty (List (Loc.none, []))
|
||||||
|
|> List.map ~f:(fun (name, p) ->
|
||||||
|
(name,
|
||||||
|
return () >>= fun () ->
|
||||||
|
if not !dune_project_edited then begin
|
||||||
|
dune_project_edited := true;
|
||||||
|
Project_file_edit.append project_file
|
||||||
|
(Sexp.to_string
|
||||||
|
(List [ Sexp.atom "using"
|
||||||
|
; Sexp.atom name
|
||||||
|
; Sexp.atom (Syntax.Version.to_string version)
|
||||||
|
]))
|
||||||
|
end;
|
||||||
|
p))
|
||||||
|
in
|
||||||
|
{ extension = ext
|
||||||
|
; version
|
||||||
|
; loc = Loc.none
|
||||||
|
; parse_args
|
||||||
|
} :: acc
|
||||||
|
else
|
||||||
|
acc)
|
||||||
end
|
end
|
||||||
|
|
||||||
let make_parsing_context ~(lang : Lang.instance) ~extensions =
|
let make_parsing_context ~(lang : Lang.instance) ~extensions =
|
||||||
|
@ -235,7 +315,7 @@ let anonymous = lazy (
|
||||||
; version = None
|
; version = None
|
||||||
; stanza_parser =
|
; stanza_parser =
|
||||||
Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas))
|
Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas))
|
||||||
; project_file = None
|
; project_file = { file = Path.relative Path.root filename; exists = false }
|
||||||
})
|
})
|
||||||
|
|
||||||
let default_name ~dir ~packages =
|
let default_name ~dir ~packages =
|
||||||
|
@ -282,7 +362,13 @@ let parse ~dir ~lang ~packages ~file =
|
||||||
with
|
with
|
||||||
| Error (name, _, loc) ->
|
| Error (name, _, loc) ->
|
||||||
Loc.fail loc "Extension %S specified for the second time." name
|
Loc.fail loc "Extension %S specified for the second time." name
|
||||||
| Ok _ ->
|
| Ok map ->
|
||||||
|
let project_file : Project_file.t = { file; exists = true } in
|
||||||
|
let extensions =
|
||||||
|
extensions @
|
||||||
|
Extension.automatic ~project_file
|
||||||
|
~f:(fun name -> not (String.Map.mem map name))
|
||||||
|
in
|
||||||
let parsing_context = make_parsing_context ~lang ~extensions in
|
let parsing_context = make_parsing_context ~lang ~extensions in
|
||||||
let stanzas =
|
let stanzas =
|
||||||
List.concat
|
List.concat
|
||||||
|
@ -298,7 +384,7 @@ let parse ~dir ~lang ~packages ~file =
|
||||||
; version
|
; version
|
||||||
; packages
|
; packages
|
||||||
; stanza_parser = Sexp.Of_sexp.(set_many parsing_context (sum stanzas))
|
; stanza_parser = Sexp.Of_sexp.(set_many parsing_context (sum stanzas))
|
||||||
; project_file = Some file
|
; project_file
|
||||||
})
|
})
|
||||||
|
|
||||||
let load_dune_project ~dir packages =
|
let load_dune_project ~dir packages =
|
||||||
|
@ -319,7 +405,7 @@ let make_jbuilder_project ~dir packages =
|
||||||
; packages
|
; packages
|
||||||
; stanza_parser =
|
; stanza_parser =
|
||||||
Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas))
|
Sexp.Of_sexp.(set_many parsing_context (sum lang.lang.stanzas))
|
||||||
; project_file = None
|
; project_file = { file = Path.relative dir filename; exists = false }
|
||||||
}
|
}
|
||||||
|
|
||||||
let load ~dir ~files =
|
let load ~dir ~files =
|
||||||
|
@ -348,35 +434,3 @@ 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.relative (Path.of_local t.root) filename in
|
|
||||||
let ver = (Lang.get_exn "dune").version in
|
|
||||||
let s = sprintf "(lang dune %s)" (Syntax.Version.to_string ver) 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'))
|
|
||||||
|
|
|
@ -29,15 +29,19 @@ module Name : sig
|
||||||
val decode : string -> t
|
val decode : string -> t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Project_file : sig
|
||||||
|
type t
|
||||||
|
end
|
||||||
|
|
||||||
(* CR-soon diml: make this abstract *)
|
(* CR-soon diml: make this abstract *)
|
||||||
type t = private
|
type t = private
|
||||||
{ kind : Kind.t
|
{ kind : Kind.t
|
||||||
; name : Name.t
|
; name : Name.t
|
||||||
; root : Path.Local.t
|
; root : Path.Local.t
|
||||||
; version : string option
|
; version : string option
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
; stanza_parser : Stanza.t list Sexp.Of_sexp.t
|
||||||
; mutable project_file : Path.t option
|
; project_file : Project_file.t
|
||||||
}
|
}
|
||||||
|
|
||||||
module Lang : sig
|
module Lang : sig
|
||||||
|
|
Loading…
Reference in New Issue