package drom_lib

  1. Overview
  2. Docs

Source file commandNew.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2020 OCamlPro & Origin Labs                               *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open Types
open Ezcmd.V2
open EZCMD.TYPES
open EzCompat
open Ez_file.V1
open EzFile.OP

let cmd_name = "new"


let print_dir name dir =
  let open EzPrintTree in
  let rec iter name dir =
    let files = Sys.readdir dir in
    Array.sort compare files;
    let files = Array.to_list files in
    Branch (name,
            List.map (fun file ->
                let dir = dir // file in
                if Sys.is_directory dir then
                  iter (file ^ "/") dir
                else
                  let file =
                    match file with
                    | ".drom" -> ".drom             (drom state, do not edit)"
                    | "drom.toml" -> "drom.toml    <────────── project config EDIT !"
                    | "package.toml" -> "package.toml    <────────── package config EDIT !"
                    | _ -> file
                  in
                  Branch (file, [])
              )
              (List.filter (function
                   | ".git"
                   | "_drom"
                   | "_build"
                     -> false
                   | _ -> true
                 ) files ))
  in
  let tree = iter name dir in
  print_tree "" tree

let rec find_project_package name packages =
  match packages with
  | [] -> Error.raise "Cannot find main package %S" name
  | package :: packages ->
      if package.name = name then package else
        find_project_package name packages

let create_project ~config ~name ~skeleton ~dir ~inplace ~args =
  let skeleton_name = match skeleton with
    | None -> "program"
    | Some skeleton -> skeleton
  in
  let license =
    match config.config_license with
    | None -> License.key_LGPL2
    | Some license -> license
  in
  let dir =
    match dir with
    | None -> "src" // name
    | Some dir -> dir
  in
  Printf.eprintf
    "Creating project %S with skeleton %S, license %S\n"
    name skeleton_name license;
  Printf.eprintf
    "  and sources in %s:\n%!" dir;
  let skeleton = Skeleton.lookup_project ( Some skeleton_name ) in

  let package, packages =
    let package = Project.create_package ~kind:Virtual ~name ~dir in
    (package, [ package ])
  in
  let author = Project.find_author config in
  let copyright =
    match config.config_copyright with
    | Some copyright -> Some copyright
    | None -> Some author
  in
  let gendep =
    { depversions = []; depname = None;
      deptest = true; depdoc = false ; depopt = false } in
  let p =
    { Project.dummy_project with
      package;
      packages;
      skeleton = Some skeleton_name;
      authors = [ author ];
      synopsis = Globals.default_synopsis ~name;
      description = Globals.default_description ~name;
      tools =
        [ ( "ocamlformat", gendep ) ;
          ( "ppx_expect", { gendep with deptest = true } ) ;
          ( "ppx_inline_test", { gendep with deptest = true } ) ;
          ( "odoc", { gendep with depdoc = true } ) ;
        ];
      github_organization = config.config_github_organization;
      homepage = None;
      doc_api = None;
      doc_gen = None;
      bug_reports = None;
      license;
      dev_repo = None;
      copyright;
      skip = [];
      archive = None;
      sphinx_target = None;
      odoc_target = None;
      ci_systems = Misc.default_ci_systems;
      profiles = StringMap.empty;
      skip_dirs = [];
      fields = StringMap.empty
    }
  in
  package.project <- p;

  if not inplace then (
    if Sys.file_exists name then
      Error.raise "A directory %s already exists" name;
    Printf.eprintf "Creating directory %s\n%!" name;
    EzFile.make_dir ~p:true name;
    Unix.chdir name
  );

  (* first, resolve project skeleton *)
  let rec iter_skeleton list =
    match list with
    | [] -> (p, None)
    | content :: super ->
        let p,_ = iter_skeleton super in
        let content = Subst.project () p content in
        Project.of_string ~msg:"toml template" ~default:p content, Some content
  in
  let p, p_content = iter_skeleton skeleton.skeleton_toml in

  (* second, resolve package skeletons *)

  let rec iter_skeleton package list =
    match list with
    | [] -> package
    | content :: super ->
        let package = iter_skeleton package super in
        let flags = Skeleton.default_flags "package.toml" in
        let content = Skeleton.subst_package_file flags content package in
        match EzToml.from_string content with
        | `Ok table ->
            Project.package_of_toml ~default:p table
        | `Error (s, loc) ->
            Error.raise "Could not parse:\n<<<\n%s>>>\n %s at %s"
              content s
              (EzToml.string_of_location loc)

  in
  let packages = List.map (fun package ->
      let skeleton = Misc.package_skeleton package in
      Printf.eprintf "Using skeleton %S for package %S\n%!"
        skeleton package.name;
      let skeleton = Skeleton.lookup_package skeleton in
      iter_skeleton package skeleton.skeleton_toml) p.packages in

  (* create new project with correct packages *)
  let project = {
    p with
    package = find_project_package p.package.name packages;
    packages }
  in
  List.iter (fun p -> p.project <- project) packages;

  (* third, extract project again, but with knowledge of packages *)
  let p = match p_content with
    | None -> project
    | Some content ->
        Project.of_string ~msg:"toml template" ~default:project content
  in

  Update.update_files ~twice:true ~create:true ~git:true ~args p;
  print_dir (name ^ "/") "."

(* lookup for "drom.toml" and update it *)
let action ~skeleton ~name ~inplace ~dir ~args =
  match name with
  | None ->
      Printf.eprintf {|You must specify the name of the project to create:

drom new PROJECT --skeleton SKELETON

Available skeletons are: %s
|} (Skeleton.project_skeletons ()
    |> List.map (fun s -> s.skeleton_name)
    |> String.concat " ");
      exit 2

  | Some name -> (
    let config = Config.config () in
    let project = Project.find () in
    match project with
    | None -> create_project ~config ~name ~skeleton ~dir ~inplace ~args
    | Some (p, _) ->
      Error.raise
        "Cannot create a project within another project %S. Maybe you want to \
         use 'drom package PACKAGE --new' instead?"
        p.package.name )

let cmd =
  let project_name = ref None in
  let inplace = ref false in
  let skeleton = ref None in
  let dir = ref None in
  let args, specs = Update.update_args () in
  args.arg_upgrade <- true;
  EZCMD.sub cmd_name
    ~args:
      (
        specs
        @ [ ( [ "dir" ],
              Arg.String (fun s -> dir := Some s),
              EZCMD.info ~docv:"DIRECTORY"
                "Dir where package sources are stored (src by default)"
            );
            ( [ "library" ],
              Arg.Unit (fun () -> skeleton := Some "library"),
              EZCMD.info "Project contains only a library" );
            ( [ "program" ],
              Arg.Unit (fun () -> skeleton := Some "program"),
              EZCMD.info "Project contains only a program" );
            ( [ "virtual" ],
              Arg.Unit (fun () -> skeleton := Some "virtual"),
              EZCMD.info "Package is virtual, i.e. no code" );
            ( [ "skeleton" ],
              Arg.String (fun s -> skeleton := Some s),
              EZCMD.info
                ~docv:"SKELETON"
                "Create project using a predefined skeleton or one specified in \
                 ~/.config/drom/skeletons/" );
            ( [ "inplace" ],
              Arg.Set inplace,
              EZCMD.info "Create project in the the current directory" );
            ( [],
              Arg.Anon (0, fun name -> project_name := Some name),
              EZCMD.info ~docv:"PROJECT" "Name of the project" )
          ])
    ~doc:"Create a new project"
    (fun () ->
       action ~name:!project_name ~skeleton:!skeleton ~dir:!dir
         ~inplace:!inplace ~args)
    ~man: [
      `S "DESCRIPTION";
      `Blocks [
        `P "This command creates a new project, with name $(b,PROJECT) in a directory $(b,PROJECT) (unless the $(b,--inplace) argument was provided).";

      ];
      `S "EXAMPLE";
      `P "The following command creates a project containing library $(b,my_lib) in $(b,src/my_lib):";
      `Pre {|
drom new my_lib --skeleton library
|};
      `P "The following command creates a project containing a library $(b,hello_lib) in $(b,src/hello_lib) and a program $(b,hello) in $(b,src/hello) calling the library:";
      `Pre {|
drom new hello --skeleton program
|}
    ]
OCaml

Innovation. Community. Security.