Reason distillery

pkg/distillery/basic.ppx/Makefile

@@ -12,9 +12,9 @@ include Makefile.options
 ##			      Internals
 
 ## Required binaries
-ELIOMC            := eliomc -ppx
-ELIOMOPT          := eliomopt -ppx
-JS_OF_ELIOM       := js_of_eliom -ppx
+ELIOMC            := eliomc %%%REASON_FLAG%%% -ppx
+ELIOMOPT          := eliomopt %%%REASON_FLAG%%% -ppx
+JS_OF_ELIOM       := js_of_eliom %%%REASON_FLAG%%% -ppx
 ELIOMDEP          := eliomdep
 OCSIGENSERVER     := ocsigenserver
 OCSIGENSERVER.OPT := ocsigenserver.opt
@@ -103,7 +103,7 @@ run.opt:
 
 # Use `eliomdep -sort' only in OCaml>4
 ifeq ($(shell ocamlc -version|cut -c1),4)
-eliomdep=$(shell $(ELIOMDEP) $(1) -ppx -sort $(2) $(filter %.eliom %.ml,$(3))))
+eliomdep=$(shell $(ELIOMDEP) $(1) %%%REASON_FLAG%%% -ppx -sort $(2) $(filter %.eliom %.ml,$(3))))
 else
 eliomdep=$(3)
 endif
@@ -219,10 +219,10 @@ include .depend
 	cat $^ > $@
 
 $(DEPSDIR)/%.server: % | $(DEPSDIR)
-	$(ELIOMDEP) -server -ppx $(SERVER_INC) $< > $@
+	$(ELIOMDEP) -server %%%REASON_FLAG%%% -ppx $(SERVER_INC) $< > $@
 
 $(DEPSDIR)/%.client: % | $(DEPSDIR)
-	$(ELIOMDEP) -client -ppx $(CLIENT_INC) $< > $@
+	$(ELIOMDEP) -client %%%REASON_FLAG%%% -ppx $(CLIENT_INC) $< > $@
 
 $(DEPSDIR):
 	mkdir $@

src/ppx/ppx_eliom_utils.ml

@@ -37,14 +37,23 @@ let pat_args = function
   | [p] -> p
   | l -> Pat.tuple l
 
+let override_file_name = ref None
+
 (* We use a strong hash (MD5) of the file name.
    We only keep the first 36 bit, which should be well enough: with
    256 files, the likelihood of a collision is about one in two
    millions.
    These bits are encoded using an OCaml-compatible variant of Base
    64, as the hash is used to generate OCaml identifiers. *)
 let file_hash loc =
-  let s = Digest.string loc.Location.loc_start.pos_fname in
+  let file_name =
+    match !override_file_name with
+    | Some file_name ->
+      file_name
+    | None ->
+      loc.Location.loc_start.pos_fname
+  in
+  let s = Digest.string file_name in
   let e = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in
   let o = Bytes.create 6 in
   let g p = Char.code s.[p] in
@@ -287,10 +296,17 @@ module Context = struct
 end
 
 
-let match_args = function
+let rec match_args = function
   | [ ] -> ()
-  | [ "-type" ; type_file ] -> Mli.type_file := Some type_file
-  | [ "-notype" ] -> Mli.type_file := None
+  | "-orig-file-name" :: file_name :: args ->
+    override_file_name := Some file_name;
+    match_args args
+  | "-type" :: type_file :: args ->
+    Mli.type_file := Some type_file;
+    match_args args
+  | "-notype" :: args ->
+    Mli.type_file := None;
+    match_args args
   | args -> Location.raise_errorf ~loc:Location.(in_file !input_name)
            "Wrong arguments:@ %s" (String.concat " " args)
 

src/tools/distillery.ml

@@ -187,7 +187,16 @@ let expand_dest_path ~name ~dest_dir s =
   |> join_path
   |> Filename.concat dest_dir
 
-let create_project ?preds ~without_asking ~name ~env ~source_dir ~dest_dir () =
+let convert_file_to_reason path =
+  let extension = Filename.extension path in
+  if (extension = ".eliom" || extension = ".eliomi") then
+    Utils.run_command
+      ~on_error:(function
+        | 127 -> Printf.eprintf "Error: refmt is not installed - please install with `opam install reason`\n"
+        | d -> Printf.eprintf "Unknown error code %d while running refmt\n" d)
+      ("refmt --parse=ml --print=re --in-place " ^ path)
+
+let create_project ?preds ~without_asking ~use_refmt ~name ~env ~source_dir ~dest_dir () =
   let eliom_ignore_files =
     lines_of_file (Filename.concat source_dir eliomignore_filename)
   and eliom_verbatim_files =
@@ -213,7 +222,8 @@ let create_project ?preds ~without_asking ~name ~env ~source_dir ~dest_dir () =
        else
          let src_path = Filename.concat source_dir src_file
          and dst_path = expand_dest_path ~name ~dest_dir src_file in
-         copy_file ?preds ~env src_path dst_path
+         copy_file ?preds ~env src_path dst_path ;
+         if use_refmt then convert_file_to_reason dst_path
     )
     (Sys.readdir source_dir)
 
@@ -227,7 +237,8 @@ let env name =
   [
     "PROJECT_NAME", name;
     "MODULE_NAME", String.capitalize name;
-    "PROJECT_DB", db
+    "PROJECT_DB", db;
+    "REASON_FLAG", if !Utils.use_refmt then "-reason" else ""
   ]
 
 let get_templatedirs () =
@@ -312,6 +323,8 @@ let main () =
       " Display the template directories (set through $ELIOM_DISTILLERY_PATH)";
       "-y", Set without_asking,
       " Create the project directory without confirmation.";
+      "-reason", Set Utils.use_refmt,
+      " Create the project with reason syntax (defaults to OCaml)";
       "-name", String (fun s -> name := Some (check_name s)),
       "<name> Name of the project (a valid compilation unit name)";
       "-template", String select_template,
@@ -339,7 +352,7 @@ let main () =
         (fst template)
     else
       let env, source_dir = init_project template name in
-      create_project ~without_asking:(!without_asking) ~name ~env ~source_dir ~dest_dir ()
+      create_project ~without_asking:(!without_asking) ~use_refmt:(!Utils.use_refmt) ~name ~env ~source_dir ~dest_dir ()
   end
 
 let () = main ()

src/tools/eliomc.ml

@@ -190,11 +190,6 @@ let compile_obj file =
 
 (* Process eliom and eliomi files *)
 
-let run_command s =
-  let v = Sys.command s in
-  if v != 0 then
-    failwith (Printf.sprintf "Warning: command [%s] returned %d" s v)
-
 (* WARNING: if you change this, also change inferred_type_prefix in
    ppx/ppx_eliom_utils.ml and ocamlbuild/ocamlbuild_eliom.ml *)
 let inferred_type_prefix = "eliom_inferred_type_"
@@ -235,7 +230,8 @@ let compile_server_type_eliom file =
   let out = Unix.openfile obj [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666 in
   let on_error _ =
     Unix.close out;
-    Sys.remove obj
+    Sys.remove obj;
+    Utils.exit_no_refmt ()
   in
   create_process ~out ~on_error !compiler (
     [ "-i" ]
@@ -303,14 +299,17 @@ let compile_eliom ~impl_intf file =
       | `Server | `ServerOpt -> obj_ext ()
     in
     output_prefix file ^ ext
+  and ppopts = get_ppopts ~impl_intf file in
+  let on_error _ =
+    Sys.remove obj;
+    Utils.exit_no_refmt ()
   in
-  let ppopts = get_ppopts ~impl_intf file in
   (* if !do_dump then begin *)
   (*   let camlp4, ppopt = get_pp_dump pkg ("-printer" :: "o" :: ppopts @ [file]) in *)
   (*   create_process camlp4 ppopt; *)
   (*   exit 0 *)
   (* end; *)
-  create_process !compiler (
+  create_process ~on_error !compiler (
     [ "-c" ; "-o"  ; obj ]
     @ preprocess_opt ppopts
     @ [ "-intf-suffix"; ".eliomi" ]
@@ -322,6 +321,7 @@ let compile_eliom ~impl_intf file =
   args := !args @ [obj]
 
 let process_eliom ~impl_intf file =
+  if !Utils.use_refmt then Utils.orig_file_name := Some file;
   match !mode with
   | `Infer when impl_intf = `Impl ->
     compile_server_type_eliom file
@@ -423,6 +423,9 @@ let process_option () =
       if !i+1 >= Array.length Sys.argv then usage ();
       process_eliom ~impl_intf:`Impl Sys.argv.(!i+1);
       i := !i+2
+    | "-reason" ->
+      use_refmt := true;
+      incr i
     | arg when Filename.check_suffix arg ".mli" ->
       process_ocaml ~impl_intf:`Intf arg;
       incr i

src/tools/eliomdep.ml

@@ -275,6 +275,9 @@ let process_option () =
       else
         compile_eliom ~impl_intf:`Impl arg;
       i := !i+2
+    | "-reason" ->
+      use_refmt := true;
+      incr i
     | arg when Filename.check_suffix arg ".mli" ->
       if not (do_sort ()) then
         compile_intf arg;

src/tools/eliomdoc.ml

@@ -179,6 +179,9 @@ let process_option () =
       let arg = Sys.argv.(!i+1) in
       compile_eliom ~impl_intf:`Impl arg;
       i := !i+2
+    | "-reason" ->
+      use_refmt := true;
+      incr i
     | arg when Filename.check_suffix arg ".mli" ->
       compile_intf arg;
       incr i

src/tools/utils.ml

@@ -71,6 +71,10 @@ let default_server_types_ext =
 let build_dir : string ref = ref ""
 let type_dir : string ref = ref default_type_dir
 
+let use_refmt = ref false
+
+let orig_file_name = ref None
+
 let get_kind k =
   match k with
   | Some k -> k
@@ -362,6 +366,12 @@ let get_ppopts ~impl_intf file =
     type_opt impl_intf file @ !ppopt
 
 let preprocess_opt ?(ocaml = false) ?kind opts =
+  let refmt () =
+    if !use_refmt then
+      [ "-pp"; "refmt --parse=re --print=ml" ]
+    else
+      []
+  in
   match !pp_mode with
   | `Camlp4 ->
     let pkg = match ocaml, simplify_kind ?kind () with
@@ -372,17 +382,31 @@ let preprocess_opt ?(ocaml = false) ?kind opts =
     in
     [ "-pp"; get_pp pkg ^ " " ^ String.concat " " opts ]
   | `Ppx when ocaml ->
-    []
+    refmt ()
   | `Ppx ->
     let pkg = match simplify_kind ?kind () with
       | `Client -> "eliom.ppx.client"
       | `Server -> "eliom.ppx.server"
       | `Types  -> "eliom.ppx.type"
+    and opts =
+      match !orig_file_name, !use_refmt with
+      | Some orig_file_name, true ->
+        "-orig-file-name" :: orig_file_name :: opts
+      | _, _ ->
+        opts
     in
-    [ "-ppx"; get_ppx pkg ^ " " ^ String.concat " " opts ]
+    refmt () @ [ "-ppx"; get_ppx pkg ^ " " ^ String.concat " " opts ]
 
 (** Process *)
 
+let run_command ?on_error s =
+  let v = Sys.command s in
+  if v != 0 then
+    match on_error with
+      | Some f -> f v
+      | None -> Printf.eprintf "Error: command [%s] returned [%d]" s v;
+    exit 255
+
 let rec wait ?(on_error=fun _ -> ()) pid =
   let e = snd (Unix.waitpid [] pid) in
   match e with
@@ -414,6 +438,13 @@ let create_filter name args f =
   let ch = Unix.in_channel_of_descr in_ in
   try f ch with _ -> close_in ch; wait pid
 
+let exit_no_refmt () =
+  if !use_refmt then (
+    Printf.eprintf
+      "Compiler failed. Have you installed reason and its refmt binary?\n%!";
+    exit 1
+  )
+
 let help_filter skip msg ch =
   for _i = 1 to skip do ignore (input_line ch) done;
   prerr_endline msg;