From 66304ff33c9149598e6b112ccab97101052fbe74 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Thu, 11 Oct 2018 08:00:09 -0400 Subject: [PATCH] Add `dune init` command Towards completion of #159 Signed-off-by: Shon Feder --- bin/main.ml | 39 +++++++++ src/dune_project.ml | 13 ++- src/dune_project.mli | 3 + src/init.ml | 196 +++++++++++++++++++++++++++++++++++++++++++ src/init.mli | 15 ++++ 5 files changed, 262 insertions(+), 4 deletions(-) create mode 100644 src/init.ml create mode 100644 src/init.mli diff --git a/bin/main.ml b/bin/main.ml index f969c5833a98..f176bd36907e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -809,6 +809,44 @@ let utop = in (term, Term.info "utop" ~doc ~man ) +module Init = struct + open Init + let lib = + let doc = "The project is intended to be a library" in + (Project.Kind.Library, Arg.info ["lib"; "library"] ~doc) + + let bin = + let doc = "The project is intended to be an executable" in + (Project.Kind.Executable, Arg.info ["bin"; "binary"] ~doc) + + let init = + let doc = "Initialize a new dune project" in + let man = + [ `S "DESCRIPTION" + ; `P {|$(b,dune init NAME [PATH] [{--lib,--bin}] ) initialize a new dune + project named $(b,NAME) from the default template.|} + ; `P {|If the optional $(b,PATH) is provided, the project will be created + there. Otherwise, it is created in a directory $(b,NAME) relative + to the current working directory.|} + ; `P {|The flags $(b,--lib) and $(b,--bin) specify whether the created + project should be set up as a library or as an executable program + (respectively). The defaults behavior is to create libraries.|} + ] in + let term = + let%map common = Common.term + and name = + Arg.(required & pos 0 (some string) None & Arg.info [] ~docv:"NAME") + and kind = + Arg.(last & vflag_all [Project.Kind.Library] [lib; bin]) + and path = + Arg.(value & pos 1 (some string) None & Arg.info [] ~docv:"PATH" ) + in + Common.set_dirs common; + make_project name kind path + in + (term, Term.info "init" ~doc ~man) +end + let promote = let doc = "Promote files from the last run" in let man = @@ -1057,6 +1095,7 @@ let all = ; subst ; rules ; utop + ; Init.init ; promote ; printenv ; Help.help diff --git a/src/dune_project.ml b/src/dune_project.ml index 0c1d68dbee29..4daca88dd481 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -170,14 +170,17 @@ module Project_file_edit = struct let notify_user s = kerrf ~f:print_to_console "@{Info@}: %s\n" s + let lang_stanza () = + let ver = (Lang.get_exn "dune").version in + sprintf "(lang dune %s)" (Syntax.Version.to_string ver) + 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 + let content = lang_stanza () 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; + (Path.to_string_maybe_quoted t.file) content); + Io.write_file t.file (content ^ "\n") ~binary:false; t.exists <- true end @@ -198,6 +201,8 @@ module Project_file_edit = struct if len > 0 && s.[len - 1] <> '\n' then output_char oc '\n')) end +let lang_stanza = Project_file_edit.lang_stanza + let ensure_project_file_exists t = Project_file_edit.ensure_exists t.project_file diff --git a/src/dune_project.mli b/src/dune_project.mli index 69bd95e94cc3..9620c57f8bf6 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -95,6 +95,9 @@ val filename : string the workspace contains no [dune-project] or [.opam] files. *) val anonymous : t Lazy.t +(** Generate an appropriate project [lang] stanza *) +val lang_stanza : unit -> string + (** Check that the dune-project file exists and create it otherwise. *) val ensure_project_file_exists : t -> unit diff --git a/src/init.ml b/src/init.ml new file mode 100644 index 000000000000..ca4f279b2843 --- /dev/null +++ b/src/init.ml @@ -0,0 +1,196 @@ +open! Stdune +open! Import + +module Project = struct + module Kind = struct + type t = + | Library + | Executable + + let to_string = function + | Library -> "library" + | Executable -> "executable" + end +end + +module File = struct + type t = + { path: Path.t + ; name: string + ; content: string } + + let make path name content = + {path; name; content} + + let full_path {path; name; _} = + Path.(append path (of_string name)) + + let create file = + let path = full_path file in + Io.write_file ~binary:false path file.content +end + +module type InitContext = sig + val kind : Project.Kind.t + val pname : string + val dir : Path.t +end + +module type ProjectDir = sig + val dir : Path.t + val files : File.t list +end + +module Proj (C : InitContext) : ProjectDir = struct + let dir = C.dir + let make_file = File.make C.dir + + let dune_project = + let lang_stanza = Dune_project.lang_stanza () in + let name = Dune_project.filename in + let content = Printf.sprintf "\ +%s +(name %s) +(version 0.1) +" lang_stanza C.pname + in + make_file name content + + let package_opam = + let name = Printf.sprintf "%s.opam" C.pname in + make_file name "" + + let files = [dune_project; package_opam] +end + +module Lib (C : InitContext) : ProjectDir = struct + let dir = Path.(append C.dir (of_string "src")) + let make_file = File.make dir + + let lib_dune = + let name = "dune" in + let content = Printf.sprintf "\ +;; Uncomment stanzas to include their functionality +(library + (name %s) + (public_name %s) + ;; (inline_tests) + ;; (libraries core) + ;; (preprocess (pps ppx_inline_test)) +) +" C.pname C.pname + in + make_file name content + + let lib_ml = + let name = "lib.ml" in + let content = {|let hello name = Printf.sprintf "Hello, %s" name +|} in + make_file name content + + let files = [lib_dune; lib_ml] +end + +module Bin (C : InitContext) : ProjectDir = struct + let dir = Path.(append C.dir (of_string "bin")) + let make_file = File.make dir + + let bin_dune = + let name = "dune" in + let content = Printf.sprintf "\ +(executable + (public_name %s) + (name main) + (libraries %s)) +" C.pname C.pname + in + make_file name content + + let bin_ml = + let lib_module_name = String.capitalize_ascii C.pname in + let name = "main.ml" in + let content = + Printf.sprintf + {|let () = print_endline (%s.Lib.hello "project %s") +|} + lib_module_name C.pname + in + make_file name content + + let files = [bin_dune; bin_ml] +end + +let make_project_dir_exn (module D : ProjectDir) = + if Path.exists D.dir then + Exn.fatalf "A project directory cannot be created: \ + A directory named %s already exists" + (Path.to_string D.dir); + + try Path.mkdir_p D.dir with + | Unix.(Unix_error (EACCES, _, _)) -> + Exn.fatalf "A project directory cannot be created: \ + Lacking permissions needed to create directory %s" + (Path.to_string D.dir) + +let make_project_dir_files (module D : ProjectDir) = + List.iter ~f:File.create D.files + +let validate_project_name name = + match Lib_name.Local.of_string name with + | Ok _ -> () + | _ -> Exn.fatalf "A project named '%s' cannot be created because it is an %s" + name Lib_name.Local.invalid_message + +let make_context pname kind path = + let module C = struct + let kind = kind + let pname = pname + let dir = + match path with + | None -> Path.of_filename_relative_to_initial_cwd pname + | Some path -> + if Filename.is_relative path + then Path.of_filename_relative_to_initial_cwd path + else Path.of_string path + end + in + (module C : InitContext) + +let make_project_dirs (module C : InitContext) = + (* dirs that are always included in a project *) + let project_dirs : (module ProjectDir) list = + [ + (module Proj (C)); (* The project dir should always be first *) + (module Lib (C)); + ] + in + let project_dirs = match C.kind with + | Project.Kind.Library -> project_dirs + | Project.Kind.Executable -> project_dirs @ [(module Bin (C))] + in + List.iter ~f:make_project_dir_exn project_dirs; + List.iter ~f:make_project_dir_files project_dirs + +let print_completion (module C : InitContext) = + Errors.kerrf ~f:print_to_console + "@{Success@}: %s %s project initialized\n" + C.pname (Project.Kind.to_string C.kind) + +let print_hints (module C : InitContext) = + let path = Path.to_string C.dir in + match C.kind with + | Project.Kind.Library -> + Errors.kerrf ~f:print_to_console + "@{cd %s && dune build@} # to build the project\n" + path + | Project.Kind.Executable -> + Errors.kerrf ~f:print_to_console + "@{cd %s && dune exec %s@} # to build and run the project\n" + path C.pname + +let make_project pname kind path = + validate_project_name pname; + let (module C) = make_context pname kind path in + make_project_dirs (module C); + print_completion (module C); + print_hints (module C) diff --git a/src/init.mli b/src/init.mli new file mode 100644 index 000000000000..a6e64d5d006f --- /dev/null +++ b/src/init.mli @@ -0,0 +1,15 @@ +open! Stdune + +(** Supported kinds of projects for initialization *) +module Project : sig + module Kind : sig + type t = + | Library + | Executable + end +end + +(** [make_project pname kind path] will make a project of the given [kind] + with the supplied [pname], at the optional [path] (defaulting to the + current working directory if the [path] is [None]). *) +val make_project : string -> Project.Kind.t -> string option -> unit