Merge pull request #2404 from nojb/dialects

Add support for "dialects"

CHANGES.md

@@ -96,6 +96,9 @@
 - Add warning `66` to default set of warnings starting for dune projects with
   language verison >= `1.11` (@rgrinberg, @diml, fixes #2299)
 
+- Add (dialect ...) stanza
+  (@nojb, #2404)
+
 1.10.0 (04/06/2019)
 -------------------
 

doc/dialects.rst

@@ -0,0 +1,65 @@
+.. _dialects-main:
+
+********
+Dialects
+********
+
+A dialect is an alternative frontend to OCaml (such as ReasonML). It is
+described by a pair of file extensions, one corresponding to interfaces and one
+to implementations.
+
+The extensions are unique among all dialects of a given project, so that a given
+extension can be mapped back to the corresponding dialect.
+
+A dialect can use the standard OCaml syntax or it can specify an action to
+convert from a custom syntax to a binary OCaml abstract syntax tree.
+
+Similarly, a dialect can specify a custom formatter to implement the ``@fmt``
+alias, see :ref:`formatting-main`.
+
+When not using a custom syntax or formatting action, a dialect is nothing but a
+way to specify custom file extensions for OCaml code.
+
+Defining a dialect
+==================
+
+A dialect can be defined by adding the following to the ``dune-project`` file:
+
+.. code::
+
+    (dialect
+     (name <name>)
+     (implementation
+      (extension <string>)
+      <optional fields>)
+     (interface
+      (extension <string>)
+      <optional fields>))
+
+``<name>`` is the name of the dialect being defined. It must be unique in a
+given project.
+
+``(extension <string>)`` specifies the file extension used for this dialect, for
+interfaces and implementations. The extension string must not contain any dots,
+and be unique in a given project.
+
+``<optional fields>`` are:
+
+- ``(preprocess <action>)`` is the action to run to produce a valid OCaml
+  abstract syntax tree. It is expected to read the file given in the variable
+  named ``input-file`` and output a *binary* abstract syntax tree on its
+  standard output. See :ref:`preprocessing-actions` for more information.
+
+  If the field is not present, it is assumed that the corresponding source code
+  is already valid OCaml code and can be passed to the OCaml compiler as-is.
+
+
+- ``(format <action>)`` is the action to run to format source code for this
+  dialect. The action is expected to read the file given in the variable named
+  ``input-file`` and output the formatted source code on its standard
+  output. For more information. See :ref:`formatting-main` for more information.
+
+  If the field is not present, then if ``(preprocess <action>)`` is not present
+  (so that the dialect consists of valid OCaml code), then by default the
+  dialect will be formatted as any other OCaml code. Otherwise no special
+  formatting will be done.

doc/dune-files.rst

@@ -1307,6 +1307,8 @@ instance. When using such ppx rewriters, you must use ``staged_pps``
 instead of ``pps`` in order to force Dune to use the second pipeline,
 which is slower but necessary in this case.
 
+.. _preprocessing-actions:
+
 Preprocessing with actions
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 

doc/formatting.rst

@@ -9,6 +9,9 @@ Dune can be set up to run automatic formatters for source code.
 It can use ocamlformat_ to format OCaml source code (``*.ml`` and ``*.mli``
 files) and refmt_ to format Reason source code (``*.re`` and ``*.rei`` files).
 
+Furthermore it can be used to format code of any defined dialect (see
+:ref:`dialects-main`).
+
 .. _ocamlformat: https://github.com/ocaml-ppx/ocamlformat
 .. _refmt: https://github.com/facebook/reason/tree/master/src/refmt
 
@@ -19,7 +22,7 @@ This feature is enabled by adding the following to the ``dune-project`` file:
 
 .. code:: scheme
 
-    (using fmt 1.1)
+    (using fmt 1.2)
 
 Formatting a project
 ====================
@@ -53,21 +56,26 @@ As usual with promotion, it is possible to combine these two steps by running
 Only enabling it for certain languages
 ======================================
 
-By default, formatting will be enabled for all languages present in the project
-that dune knows about. This is not always desirable, for example if in a mixed
-Reason/OCaml project, one only wants to format the Reason files to avoid pulling
-``ocamlformat`` as a dependency.
+By default, formatting will be enabled for all languages and dialects present in
+the project that dune knows about. This is not always desirable, for example if
+in a mixed Reason/OCaml project, one only wants to format the Reason files to
+avoid pulling ``ocamlformat`` as a dependency.
 
 In these cases, it is possible to use the ``enabled_for`` argument to restrict
 the languages that are considered for formatting.
 
 .. code:: scheme
 
-    (using fmt 1.1 (enabled_for reason))
+    (using fmt 1.2 (enabled_for reason))
 
 Version history
 ===============
 
+1.2
+---
+
+* Format :ref:`dialects-main`.
+
 1.1
 ---
 

doc/index.rst

@@ -26,6 +26,7 @@ Welcome to dune's documentation!
    jsoo
    opam
    variants
+   dialects
    formatting
    coq
    faq

src/action.ml

@@ -3,52 +3,6 @@ open Import
 
 module Outputs = Action_ast.Outputs
 
-module Make_mapper
-    (Src : Action_intf.Ast)
-    (Dst : Action_intf.Ast)
-= struct
-  let map_one_step f (t : Src.t) ~dir ~f_program ~f_string ~f_path : Dst.t =
-    match t with
-    | Run (prog, args) ->
-      Run (f_program ~dir prog, List.map args ~f:(f_string ~dir))
-    | Chdir (fn, t) ->
-      Chdir (f_path ~dir fn, f t ~dir:fn ~f_program ~f_string ~f_path)
-    | Setenv (var, value, t) ->
-      Setenv (f_string ~dir var, f_string ~dir value, f t ~dir ~f_program ~f_string ~f_path)
-    | Redirect (outputs, fn, t) ->
-      Redirect (outputs, f_path ~dir fn, f t ~dir ~f_program ~f_string ~f_path)
-    | Ignore (outputs, t) ->
-      Ignore (outputs, f t ~dir ~f_program ~f_string ~f_path)
-    | Progn l -> Progn (List.map l ~f:(fun t -> f t ~dir ~f_program ~f_string ~f_path))
-    | Echo xs -> Echo (List.map xs ~f:(f_string ~dir))
-    | Cat x -> Cat (f_path ~dir x)
-    | Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y)
-    | Symlink (x, y) ->
-      Symlink (f_path ~dir x, f_path ~dir y)
-    | Copy_and_add_line_directive (x, y) ->
-      Copy_and_add_line_directive (f_path ~dir x, f_path ~dir y)
-    | System x -> System (f_string ~dir x)
-    | Bash x -> Bash (f_string ~dir x)
-    | Write_file (x, y) -> Write_file (f_path ~dir x, f_string ~dir y)
-    | Rename (x, y) -> Rename (f_path ~dir x, f_path ~dir y)
-    | Remove_tree x -> Remove_tree (f_path ~dir x)
-    | Mkdir x -> Mkdir (f_path ~dir x)
-    | Digest_files x -> Digest_files (List.map x ~f:(f_path ~dir))
-    | Diff ({ file1; file2 ; _ } as diff) ->
-      Diff { diff with
-             file1 = f_path ~dir file1
-           ; file2 = f_path ~dir file2
-           }
-    | Merge_files_into (sources, extras, target) ->
-      Merge_files_into
-        (List.map sources ~f:(f_path ~dir),
-         List.map extras ~f:(f_string ~dir),
-         f_path ~dir target)
-
-  let rec map t ~dir ~f_program ~f_string ~f_path =
-    map_one_step map t ~dir ~f_program ~f_string ~f_path
-end
-
 module Prog = struct
   module Not_found = struct
     type t =
@@ -66,6 +20,13 @@ module Prog = struct
       }
 
     let raise { context ; program ; hint ; loc } =
+      let hint =
+        match program with
+        | "refmt" ->
+          Some (Option.value ~default:"try: opam install reason" hint)
+        | _ ->
+          hint
+      in
       Utils.program_not_found ?hint ~loc ~context program
   end
 
@@ -110,7 +71,7 @@ module For_shell = struct
       (Ast)
 end
 
-module Relativise = Make_mapper(Ast)(For_shell.Ast)
+module Relativise = Action_mapper.Make(Ast)(For_shell.Ast)
 
 let for_shell t =
   let rec loop t ~dir ~f_program ~f_string ~f_path =
@@ -155,7 +116,7 @@ module Unresolved = struct
   module rec Uast : Uast = Uast
   include Uast
 
-  include Make_mapper(Uast)(Ast)
+  include Action_mapper.Make(Uast)(Ast)
 
   let resolve t ~f =
     map t
@@ -190,7 +151,7 @@ let fold_one_step t ~init:acc ~f =
   | Diff _
   | Merge_files_into _ -> acc
 
-include Make_mapper(Ast)(Ast)
+include Action_mapper.Make(Ast)(Ast)
 
 let chdirs =
   let rec loop acc t =

src/action.mli

@@ -3,16 +3,6 @@ open! Import
 
 module Outputs : module type of struct include Action_intf.Outputs end
 
-module Make_mapper (Src : Action_intf.Ast) (Dst : Action_intf.Ast) : sig
-  val map
-    : Src.t
-    -> dir:Src.path
-    -> f_program:(dir:Src.path -> Src.program -> Dst.program)
-    -> f_string:(dir:Src.path -> Src.string -> Dst.string)
-    -> f_path:(dir:Src.path -> Src.path -> Dst.path)
-    -> Dst.t
-end
-
 (** result of the lookup of a program, the path to it or information about the
     failure and possibly a hint how to fix it *)
 module Prog : sig

src/action_dune_lang.ml

@@ -11,7 +11,7 @@ module type Uast = Action_intf.Ast
 module rec Uast : Uast = Uast
 include Action_ast.Make(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
 
-module Mapper = Action.Make_mapper(Uast)(Uast)
+module Mapper = Action_mapper.Make(Uast)(Uast)
 
 let upgrade_to_dune =
   let id ~dir:_ p = p in
@@ -43,3 +43,6 @@ let decode =
              "if you meant for this to be executed with bash, write \
               (bash \"...\") instead"
          ])
+
+let to_dyn a =
+  Dune_lang.to_dyn (encode a)

src/action_dune_lang.mli

@@ -18,3 +18,5 @@ include Action_intf.Helpers
   type path = String_with_vars.t
 
 val compare_no_locs : t -> t -> Ordering.t
+
+val to_dyn : t -> Dyn.t

src/action_mapper.ml

@@ -0,0 +1,47 @@
+open! Stdune
+
+module Make
+    (Src : Action_intf.Ast)
+    (Dst : Action_intf.Ast)
+= struct
+  let map_one_step f (t : Src.t) ~dir ~f_program ~f_string ~f_path : Dst.t =
+    match t with
+    | Run (prog, args) ->
+      Run (f_program ~dir prog, List.map args ~f:(f_string ~dir))
+    | Chdir (fn, t) ->
+      Chdir (f_path ~dir fn, f t ~dir:fn ~f_program ~f_string ~f_path)
+    | Setenv (var, value, t) ->
+      Setenv (f_string ~dir var, f_string ~dir value, f t ~dir ~f_program ~f_string ~f_path)
+    | Redirect (outputs, fn, t) ->
+      Redirect (outputs, f_path ~dir fn, f t ~dir ~f_program ~f_string ~f_path)
+    | Ignore (outputs, t) ->
+      Ignore (outputs, f t ~dir ~f_program ~f_string ~f_path)
+    | Progn l -> Progn (List.map l ~f:(fun t -> f t ~dir ~f_program ~f_string ~f_path))
+    | Echo xs -> Echo (List.map xs ~f:(f_string ~dir))
+    | Cat x -> Cat (f_path ~dir x)
+    | Copy (x, y) -> Copy (f_path ~dir x, f_path ~dir y)
+    | Symlink (x, y) ->
+      Symlink (f_path ~dir x, f_path ~dir y)
+    | Copy_and_add_line_directive (x, y) ->
+      Copy_and_add_line_directive (f_path ~dir x, f_path ~dir y)
+    | System x -> System (f_string ~dir x)
+    | Bash x -> Bash (f_string ~dir x)
+    | Write_file (x, y) -> Write_file (f_path ~dir x, f_string ~dir y)
+    | Rename (x, y) -> Rename (f_path ~dir x, f_path ~dir y)
+    | Remove_tree x -> Remove_tree (f_path ~dir x)
+    | Mkdir x -> Mkdir (f_path ~dir x)
+    | Digest_files x -> Digest_files (List.map x ~f:(f_path ~dir))
+    | Diff ({ file1; file2 ; _ } as diff) ->
+      Diff { diff with
+             file1 = f_path ~dir file1
+           ; file2 = f_path ~dir file2
+           }
+    | Merge_files_into (sources, extras, target) ->
+      Merge_files_into
+        (List.map sources ~f:(f_path ~dir),
+         List.map extras ~f:(f_string ~dir),
+         f_path ~dir target)
+
+  let rec map t ~dir ~f_program ~f_string ~f_path =
+    map_one_step map t ~dir ~f_program ~f_string ~f_path
+end

src/action_unexpanded.ml

@@ -5,7 +5,7 @@ include Action_dune_lang
 
 module Unresolved = Action.Unresolved
 
-module Mapper = Action.Make_mapper(Action_dune_lang)(Action_dune_lang)
+module Mapper = Action_mapper.Make(Action_dune_lang)(Action_dune_lang)
 
 let ignore_loc k ~loc:_ = k
 
@@ -415,4 +415,3 @@ module Infer = struct
   let unexpanded_targets t =
     (Unexp.infer t).targets
 end
-

src/command.ml

@@ -123,3 +123,11 @@ let of_result_map res ~f =
   match res with
   | Ok    x -> f x
   | Error e -> fail e
+
+module Ml_kind = struct
+  let flag t =
+    Ml_kind.choose ~impl:(Args.A "-impl") ~intf:(A "-intf") t
+
+  let ppx_driver_flag t =
+    Ml_kind.choose ~impl:(Args.A "--impl") ~intf:(A "--intf") t
+end

src/command.mli

@@ -68,3 +68,8 @@ val quote_args : string -> string list -> _ Args.t
 val of_result : 'a Args.t Or_exn.t -> 'a Args.t
 val of_result_map : 'a Or_exn.t -> f:('a -> 'b Args.t) -> 'b Args.t
 val fail : exn -> 'a Args.t
+
+module Ml_kind : sig
+  val flag : Ml_kind.t -> _ Args.t
+  val ppx_driver_flag : Ml_kind.t -> _ Args.t
+end