Add dune init command

Towards completion of ocaml#159

Signed-off-by: Shon Feder <[email protected]>

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

src/dune_project.ml

@@ -170,14 +170,17 @@ module Project_file_edit = struct
   let notify_user s =
     kerrf ~f:print_to_console "@{<warning>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
 

src/dune_project.mli

@@ -95,6 +95,9 @@ val filename : string
     the workspace contains no [dune-project] or [<package>.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
 

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
+    "@{<ok>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
+      "@{<kwd>cd %s && dune build@} # to build the project\n"
+      path
+  | Project.Kind.Executable ->
+    Errors.kerrf ~f:print_to_console
+      "@{<kwd>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)

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