Add support for cinaps

CHANGES.md

@@ -29,6 +29,10 @@
 - Build `ppx.exe` as compiling host binary. (#2286, fixes #2252, @toots, review
   by @rgrinberg and @diml)
 
+- Add a `cinaps` extension and stanza for better integration with the
+  [cinaps tool](https://github.com/janestreet/cinaps) tool (#2269,
+  @diml)
+
 1.10.0 (04/06/2019)
 -------------------
 

doc/dune-files.rst

@@ -585,6 +585,13 @@ menhir
 A ``menhir`` stanza is available to support the menhir_ parser generator. See
 the :ref:`menhir-main` section for details.
 
+cinaps
+------
+
+A ``cianps`` stanza is available to support the ``cinaps`` tool.  See
+the `cinaps website <https://github.com/janestreet/cinaps>`_ for more
+details.
+
 .. _alias-stanza:
 
 alias

src/cinaps.boot.ml

@@ -0,0 +1,4 @@
+type t = unit
+type Stanza.t += T of t
+
+let gen_rules _sctx _t ~dir:_ ~scope:_ ~dir_kind:_ = ()

src/cinaps.ml

@@ -0,0 +1,144 @@
+open Import
+open! No_io
+open Build.O
+
+type t =
+  { loc : Loc.t
+  ; files : Predicate_lang.t
+  ; libraries : Dune_file.Lib_dep.t list
+  ; preprocess : Dune_file.Preprocess_map.t
+  ; preprocessor_deps : Dune_file.Dep_conf.t list
+  ; flags : Ocaml_flags.Spec.t
+  }
+
+type Stanza.t += T of t
+
+
+let syntax =
+  Syntax.create
+    ~name:"cinaps"
+    ~desc:"the cinaps extension"
+    [ 1, 0
+    ]
+
+let decode =
+  let open Stanza.Decoder in
+  fields
+    (let+ loc = loc
+     and+ files =
+       field "files" Predicate_lang.decode ~default:Predicate_lang.true_
+     and+ preprocess =
+       field "preprocess" Dune_file.Preprocess_map.decode
+         ~default:Dune_file.Preprocess_map.default
+     and+ preprocessor_deps =
+       field "preprocessor_deps" (list Dune_file.Dep_conf.decode) ~default:[]
+     and+ libraries = field "libraries" Dune_file.Lib_deps.decode ~default:[]
+     and+ flags = Ocaml_flags.Spec.decode
+     in
+     { loc
+     ; files
+     ; libraries
+     ; preprocess
+     ; preprocessor_deps
+     ; flags
+     })
+
+let () =
+  let open Stanza.Decoder in
+  Dune_project.Extension.register_simple
+    syntax
+    (return [ "cinaps", decode >>| fun x -> [T x]])
+
+let gen_rules sctx t ~dir ~scope ~dir_kind =
+  let loc = t.loc in
+  let name = "cinaps" in
+  let cinaps_dir = Path.Build.relative dir ".cinaps" in
+  let cinaps_ml = Path.Build.relative cinaps_dir "_cinaps.ml-gen" in
+  let cinaps_exe = Path.Build.relative cinaps_dir "cinaps.exe" in
+  let main_module_name = Module.Name.of_string "_cinaps" in
+
+  (* Files checked by cinaps *)
+  let cinapsed_files =
+    File_tree.files_of (Super_context.file_tree sctx)
+      (Path.Build.drop_build_context_exn dir)
+    |> Path.Source.Set.to_list
+    |> List.filter_map ~f:(fun p ->
+      if Predicate_lang.exec t.files (Path.Source.basename p)
+           ~standard:Predicate_lang.true_ then
+        Some (Path.Build.append_source (Super_context.build_dir sctx) p)
+      else
+        None)
+  in
+
+  (* Ask cinaps to produce a .ml file to build *)
+  Super_context.add_rule sctx ~loc:t.loc ~dir
+    (Command.run ~dir:(Path.build dir)
+       (Super_context.resolve_program sctx ~dir ~loc:(Some loc) "cinaps"
+          ~hint:"opam pin add --dev cinaps")
+       [ A "-staged"; Target cinaps_ml
+       ; Deps (List.map cinapsed_files ~f:Path.build)
+       ]);
+
+  let obj_dir = Obj_dir.make_exe ~dir:cinaps_dir ~name:"cinaps" in
+
+  let modules =
+    Module.Name.Map.singleton main_module_name
+      (Module.generated main_module_name ~src_dir:(Path.build cinaps_dir))
+  in
+
+  let expander = Super_context.expander sctx ~dir in
+  let preprocess =
+    Preprocessing.make sctx
+      ~dir
+      ~expander
+      ~dep_kind:Required
+      ~lint:Dune_file.Preprocess_map.no_preprocessing
+      ~preprocess:t.preprocess
+      ~preprocessor_deps:(Super_context.Deps.interpret sctx
+                            ~expander t.preprocessor_deps)
+      ~lib_name:None
+      ~scope
+      ~dir_kind
+  in
+  let modules = Preprocessing.pp_modules preprocess modules in
+
+  let compile_info =
+    Lib.DB.resolve_user_written_deps_for_exes
+      (Scope.libs scope)
+      [(t.loc, name)]
+      (Dune_file.Lib_dep.Direct
+         (loc, Lib_name.of_string_exn "cinaps.runtime" ~loc:None)
+       :: t.libraries)
+      ~pps:(Dune_file.Preprocess_map.pps t.preprocess)
+      ~variants:None
+  in
+
+  let cctx =
+    Compilation_context.create ()
+      ~super_context:sctx
+      ~expander
+      ~scope
+      ~obj_dir
+      ~modules
+      ~opaque:false
+      ~requires_compile:(Lib.Compile.direct_requires compile_info)
+      ~requires_link:(Lib.Compile.requires_link compile_info)
+      ~flags:(Ocaml_flags.of_list ["-w"; "-24"])
+      ~dynlink:false
+  in
+  Exe.build_and_link cctx
+    ~program:{ name; main_module_name; loc }
+    ~linkages:[Exe.Linkage.native_or_custom (Super_context.context sctx)];
+
+  Super_context.add_alias_action sctx ~dir ~loc:(Some loc) ~stamp:"cinaps"
+    (Alias.runtest ~dir)
+    (let module A = Action in
+     let cinaps_exe = Path.build cinaps_exe in
+     Build.path cinaps_exe >>^ fun () ->
+     A.chdir (Path.build dir)
+       (A.progn
+          (A.run (Ok cinaps_exe) ["-diff-cmd"; "-"] ::
+           List.map cinapsed_files ~f:(fun fn ->
+             let fn = Path.build fn in
+             A.diff ~optional:true
+               fn (Path.extend_basename fn ~suffix:".cinaps-corrected")))))

src/cinaps.mli

@@ -0,0 +1,24 @@
+(** Cinaps integration *)
+
+(** Cinaps is a small tool that allows to auto-generate part of ml or
+    other source files and keep them in sync:
+
+    https://github.com/janestreet/cinaps
+
+    This module implements the [cinaps] stanza that integrate cinaps
+    nicely with dune.
+*)
+
+open Stdune
+
+type t
+type Stanza.t += T of t
+
+(** Generate the rules to handle this cinaps stanza *)
+val gen_rules
+  :  Super_context.t
+  -> t
+  -> dir:Path.Build.t
+  -> scope:Scope.t
+  -> dir_kind:Dune_lang.File_syntax.t
+  -> unit

src/dune_file.mli

@@ -45,6 +45,8 @@ module Per_module : Per_item.S with type key = Module.Name.t
 module Preprocess_map : sig
   type t = Preprocess.t Per_module.t
 
+  val decode : t Dune_lang.Decoder.t
+
   val no_preprocessing : t
   val default : t
 
@@ -97,6 +99,7 @@ module Lib_deps : sig
   type t = Lib_dep.t list
   val of_pps : Lib_name.t list -> t
   val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t
+  val decode : t Dune_lang.Decoder.t
 end
 
 module Dep_conf : sig

src/gen_rules.ml

@@ -143,6 +143,9 @@ module Gen(P : sig val sctx : Super_context.t end) = struct
         |> Path.Set.of_list
         |> Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir);
         For_stanza.empty_none
+      | Cinaps.T cinaps ->
+        Cinaps.gen_rules sctx cinaps ~dir ~scope ~dir_kind;
+        For_stanza.empty_none
       | _ ->
         For_stanza.empty_none
     in

test/blackbox-tests/dune.inc

@@ -62,6 +62,14 @@
    test-cases/check-alias
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name cinaps)
+ (deps (package dune) (source_tree test-cases/cinaps))
+ (action
+  (chdir
+   test-cases/cinaps
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name configurator)
  (deps (package dune) (source_tree test-cases/configurator))
@@ -1543,6 +1551,7 @@
   (alias byte-code-only)
   (alias c-stubs)
   (alias check-alias)
+  (alias cinaps)
   (alias configurator)
   (alias configurator-gh1166)
   (alias contents-depends-on-glob)
@@ -1731,6 +1740,7 @@
   (alias byte-code-only)
   (alias c-stubs)
   (alias check-alias)
+  (alias cinaps)
   (alias configurator)
   (alias configurator-gh1166)
   (alias contents-depends-on-glob)

test/blackbox-tests/test-cases/cinaps/run.t

@@ -0,0 +1,29 @@
+Test of cinaps integration
+
+  $ cat > dune-project <<EOF
+  > (lang dune 1.11)
+  > (using cinaps 1.0)
+  > EOF
+
+  $ cat > dune <<EOF
+  > (cinaps (files *.ml))
+  > EOF
+
+  $ cat > test.ml <<"EOF"
+  > (*$ print_endline "\nhello" *)
+  > (*$*)
+  > let x = 1
+  > "EOF"
+  sh: line 4: warning: here-document at line 0 delimited by end-of-file (wanted `EOF')
+
+  $ dune runtest --auto-promote
+  File "test.ml", line 1, characters 0-0:
+  Files _build/default/test.ml and _build/default/test.ml.cinaps-corrected differ.
+  Promoting _build/default/test.ml.cinaps-corrected to test.ml.
+  [1]
+  $ cat test.ml
+  (*$ print_endline "\nhello" *)
+  hello
+  (*$*)
+  let x = 1
+  "EOF"