Source file dune.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
(**************************************************************************)
(*                                                                        *)
(*    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 EzCompat
open Types

(*
TODO: it's not clear how to correctly format dune files so that
they will not trigger a promotion with 'dune build @fmt'. The use
of sexplib0 does not immediately generate files in the correct format.
'dune' does not export a module for that in its library either.
We end up adding '(formatting (enabled_for ocaml reason))' to dune-project
to completely disable formatting of dune files.
*)

let package_dune_files package =
  let b = Buffer.create 1000 in
  let p_generators =
    match package.p_generators with
    | None -> StringSet.of_list [ "ocamllex" ; "ocamlyacc" ]
    | Some generators -> generators
  in
  ( match Sys.readdir package.dir with
    | exception _ -> ()
    | files ->
        Array.iter
          (fun file ->
             if Filename.check_suffix file ".mll" then begin

               if StringSet.mem "ocamllex" p_generators then begin

                 match StringMap.find "ocamllex-mode" package.p_fields with
                 | exception Not_found ->
                     Printf.bprintf b "(ocamllex %s)\n"
                       (Filename.chop_suffix file ".mll");
                 | mode ->
                     Printf.bprintf b "(ocamllex (modules %s)"
                       (Filename.chop_suffix file ".mll");
                     Printf.bprintf b "\n  (mode %s)" mode;
                     Printf.bprintf b ")\n";

               end

             end
             else if Filename.check_suffix file ".mly" then begin

               if StringSet.mem "ocamlyacc" p_generators then begin

                 match StringMap.find "ocamlyacc-mode" package.p_fields with
                 | exception Not_found ->
                     Printf.bprintf b "(ocamlyacc %s)\n"
                       (Filename.chop_suffix file ".mly");
                 | mode ->
                     Printf.bprintf b "(ocamlyacc (modules %s)"
                       (Filename.chop_suffix file ".mly");
                     Printf.bprintf b "\n  (mode %s)" mode;
                     Printf.bprintf b ")\n";

               end
               else if StringSet.mem "menhir" p_generators then begin

                 Printf.bprintf b "(menhir (modules %s)"
                   (Filename.chop_suffix file ".mly");
                 List.iter (fun ext ->
                     match StringMap.find ( "menhir-" ^ ext )
                             package.p_fields with
                     | exception Not_found -> ()
                     | s ->
                         Printf.bprintf b "\n  (%s %s)" ext s
                   ) [ "flags" ; "into" ; "infer" ];
                 Printf.bprintf b ")\n";

               end else
                 Printf.eprintf "no generator for %s\n%!" file

             end
          )
          files );
  begin
    match package.p_gen_version with
    | None -> ()
    | Some file ->
        Buffer.add_string b @@
        GenVersion.dune package file
  end;
  Buffer.contents b

let packages p =
  let b = Buffer.create 100000 in
  let add_package package =
    Printf.bprintf b {|
(package
 (name %s)
 (synopsis %S)
 (description %S)
|}
      package.name (Misc.p_synopsis package)
      (Misc.p_description package);

    let depend_of_dep (name, d) =
      match d.depversions with
      | [] -> Printf.bprintf b "   %s\n" name
      | _ ->
          Printf.bprintf b "   (%s " name;
          let rec iter versions =
            match versions with
            | [] -> ()
            | [ version ] -> (
                match version with
                | Version -> Printf.bprintf b "(= version)"
                | NoVersion -> ()
                | Semantic (major, minor, fix) ->
                    Printf.bprintf b "(and (>= %d.%d.%d) (< %d.0.0))" major minor fix
                      (major + 1)
                | Lt version -> Printf.bprintf b "( < %s )" version
                | Le version -> Printf.bprintf b "( <= %s )" version
                | Eq version -> Printf.bprintf b "( = %s )" version
                | Ge version -> Printf.bprintf b "( >= %s )" version
                | Gt version -> Printf.bprintf b "( > %s )" version )
            | version :: tail ->
                Printf.bprintf b "(and ";
                iter [ version ];
                iter tail;
                Printf.bprintf b ")"
          in
          iter d.depversions;
          Printf.bprintf b ")\n"
    in
    let depopts = ref [] in
    let maybe_print_dep (name, d) =
      if d.depopt then
        depopts := (name,d) :: !depopts
      else
        depend_of_dep (name, d)
    in
    Printf.bprintf b " (depends\n";
    Printf.bprintf b "   (ocaml (>= %s))\n" package.project.min_edition;
    List.iter maybe_print_dep (Misc.p_dependencies package);
    List.iter maybe_print_dep (Misc.p_tools package);
    Printf.bprintf b "  )";
    begin
      match !depopts with
      | [] -> ()
      | depopts ->
          Printf.bprintf b "\n (depopts\n";
          List.iter depend_of_dep depopts;
          Printf.bprintf b " )";
    end;
    begin
      match StringMap.find "dune-project-stanzas" package.p_fields with
      | exception _ -> ()
      | s ->
          Printf.bprintf b "\n %s" s
    end;
    Printf.bprintf b "\n )\n";
  in

  (* If menhir is used as a generator, prevents dune from modifying
     dune-project by adding this line ourselves. *)
  if StringSet.mem "menhir" p.generators then
    Buffer.add_string b "(using menhir 2.0)\n";

  List.iter add_package p.packages;
  Buffer.contents b