From 428c0b53683ef5bc4751adce5bef59a04c6bba41 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 21 Feb 2017 09:52:26 -0500
Subject: [PATCH] Implement (alias ...) stanzas (#7)

---
 src/build.ml             |  2 ++
 src/build.mli            |  2 ++
 src/gen_rules.ml         | 33 +++++++++++++++++++++++++++++++
 src/jbuild_types.ml      | 42 +++++++++++++++++++++++++++++++++++++++-
 src/string_with_vars.ml  | 15 ++++++++++++++
 src/string_with_vars.mli |  4 ++++
 6 files changed, 97 insertions(+), 1 deletion(-)

diff --git a/src/build.ml b/src/build.ml
index 85baefb8..331ae4bd 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -184,3 +184,5 @@ let copy ~src ~dst =
   path src >>>
   create_file ~target:dst (fun () ->
     copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst))
+
+let touch path = return "" >>> echo path
diff --git a/src/build.mli b/src/build.mli
index 1309ccd1..14676af5 100644
--- a/src/build.mli
+++ b/src/build.mli
@@ -85,6 +85,8 @@ val echo : Path.t -> (string, unit) t
 
 val copy : src:Path.t -> dst:Path.t -> (unit, unit) t
 
+val touch : Path.t -> (unit, unit) t
+
 type lib_dep_kind =
   | Optional
   | Required
diff --git a/src/gen_rules.ml b/src/gen_rules.ml
index cf1773cf..56c00c60 100644
--- a/src/gen_rules.ml
+++ b/src/gen_rules.ml
@@ -1225,6 +1225,38 @@ module Gen(P : Params) = struct
          ~dir
          ~targets)
 
+  let alias_rules (alias_conf : Alias_conf.t) ~dir =
+    let digest =
+      let deps =
+        Sexp.To_sexp.list Dep_conf_interpret.sexp_of_t alias_conf.deps in
+      let action =
+        match alias_conf.action with
+        | None -> Atom "none"
+        | Some a -> List [Atom "some" ; User_action.Unexpanded.sexp_of_t a] in
+      Sexp.List [deps ; action]
+      |> Sexp.to_string
+      |> Digest.string
+      |> Digest.to_hex in
+    let alias = Alias.make alias_conf.name ~dir in
+    let digest_path =
+      Path.relative dir (Path.basename (Alias.file alias) ^ "-" ^ digest) in
+    let dummy = Build.touch digest_path in
+    Alias._add_deps alias [digest_path];
+    let deps =
+      let deps = Dep_conf_interpret.dep_of_list ~dir alias_conf.deps in
+      match alias_conf.action with
+      | None -> deps
+      | Some action ->
+        deps
+        >>> User_action_interpret.expand
+          action
+          ~dir
+          ~dep_kind:Required
+          ~targets:[]
+          ~deps:alias_conf.deps
+        >>> User_action_interpret.run ~dir ~targets:[] in
+    add_rule (deps >>> dummy)
+
   (* +-----------------------------------------------------------------+
      | lex/yacc                                                        |
      +-----------------------------------------------------------------+ *)
@@ -1425,6 +1457,7 @@ module Gen(P : Params) = struct
       | Rule         rule -> user_rule         rule ~dir
       | Ocamllex     conf -> ocamllex_rules    conf ~dir
       | Ocamlyacc    conf -> ocamlyacc_rules   conf ~dir
+      | Alias        alias -> alias_rules alias ~dir
       | Provides _ | Install _ | Other -> ())
 
   let () = List.iter P.stanzas ~f:rules
diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml
index a88c51a7..09baf2c5 100644
--- a/src/jbuild_types.ml
+++ b/src/jbuild_types.ml
@@ -147,6 +147,11 @@ invalid action, expected one of:
           }
       in
       loop String_map.empty dir t
+
+    let rec sexp_of_t f = function
+      | Run (a, xs) -> List (Atom "run" :: f a :: List.map f xs)
+      | Chdir (a, r) -> List [Atom "chdir" ; f a ; sexp_of_t f r]
+      | Setenv (k, v, r) -> List [Atom "setenv" ; f k ; f v ; sexp_of_t f r]
   end
 
   module T = struct
@@ -168,6 +173,10 @@ invalid action, expected one of:
       match t with
       | Bash x -> f init x
       | Shexp x -> Mini_shexp.fold x ~init ~f
+
+    let sexp_of_t f = function
+      | Bash a -> List [Atom "bash" ; f a]
+      | Shexp a -> List [Atom "shexp" ; Mini_shexp.sexp_of_t f a]
   end
 
   include T
@@ -205,6 +214,17 @@ module Dep_conf = struct
       match sexp with
       | Atom _ -> File (String_with_vars.t sexp)
       | List _ -> t sexp
+
+  open Sexp
+  let sexp_of_t = function
+    | File t ->
+      List [Atom "file" ; String_with_vars.sexp_of_t t]
+    | Alias t ->
+      List [Atom "alias" ; String_with_vars.sexp_of_t t]
+    | Glob_files t ->
+      List [Atom "glob_files" ; String_with_vars.sexp_of_t t]
+    | Files_recursively_in t ->
+      List [Atom "files_recursively_in" ; String_with_vars.sexp_of_t t]
 end
 
 module Preprocess = struct
@@ -607,6 +627,25 @@ module Install_conf = struct
          })
 end
 
+module Alias_conf = struct
+  type t =
+    { name  : string
+    ; deps  : Dep_conf.t list
+    ; action : User_action.Unexpanded.t option
+    }
+
+  let t =
+    record
+      [ field "name" string
+      ; field "deps" (list Dep_conf.t) ~default:[]
+      ; field "action" (option User_action.Unexpanded.t) ]
+      (fun name deps action ->
+         { name
+         ; deps
+         ; action
+         })
+end
+
 module Stanza = struct
   type t =
     | Library     of Library.t
@@ -616,6 +655,7 @@ module Stanza = struct
     | Ocamlyacc   of Ocamlyacc.t
     | Provides    of Provides.t
     | Install     of Install_conf.t
+    | Alias       of Alias_conf.t
     | Other
 
   let t =
@@ -627,7 +667,7 @@ module Stanza = struct
       ; cstr "ocamlyacc"   [Ocamlyacc.t]    (fun x -> Ocamlyacc   x)
       ; cstr "provides"    [Provides.t]     (fun x -> Provides    x)
       ; cstr "install"     [Install_conf.t] (fun x -> Install     x)
-      ; cstr "alias"                 [fun _ -> ()] (fun _ -> Other )
+      ; cstr "alias"       [Alias_conf.t]   (fun x -> Alias       x)
       ; cstr "enforce_style"         [fun _ -> ()] (fun _ -> Other )
       ; cstr "toplevel_expect_tests" [fun _ -> ()] (fun _ -> Other)
       ; cstr "unified_tests"         [fun _ -> ()] (fun _ -> Other)
diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml
index 83ed397a..6fbe26e9 100644
--- a/src/string_with_vars.ml
+++ b/src/string_with_vars.ml
@@ -57,6 +57,18 @@ let of_string s = of_tokens (Token.tokenise s)
 
 let t sexp = of_string (Sexp.Of_sexp.string sexp)
 
+let sexp_of_var_syntax = function
+  | Parens -> Sexp.Atom "parens"
+  | Braces -> Sexp.Atom "braces"
+
+let sexp_of_item =
+  let open Sexp in function
+    | Text s -> List [Atom "text" ; Atom s]
+    | Var (vs, s) -> List [sexp_of_var_syntax vs ; Atom s]
+
+let sexp_of_t = Sexp.To_sexp.list sexp_of_item
+
+
 let fold t ~init ~f =
   List.fold_left t ~init ~f:(fun acc item ->
     match item with
@@ -80,6 +92,7 @@ let expand t ~f =
 module type Container = sig
   type 'a t
   val t : (Sexp.t -> 'a) -> Sexp.t -> 'a t
+  val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t
 
   val map : 'a t -> f:('a -> 'b) -> 'b t
   val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
@@ -89,6 +102,8 @@ module Lift(M : Container) = struct
   type nonrec t = t M.t
   let t sexp = M.t t sexp
 
+  let sexp_of_t a = M.sexp_of_t sexp_of_t a
+
   let fold t ~init ~f =
     M.fold t ~init ~f:(fun acc x -> fold x ~init:acc ~f)
 
diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli
index 9de3556e..a317679d 100644
--- a/src/string_with_vars.mli
+++ b/src/string_with_vars.mli
@@ -7,6 +7,7 @@ open Import
 
 type t
 val t : Sexp.t -> t
+val sexp_of_t : t -> Sexp.t
 
 val of_string : string -> t
 
@@ -19,6 +20,7 @@ val expand : t -> f:(string -> string option) -> string
 module type Container = sig
   type 'a t
   val t : (Sexp.t -> 'a) -> Sexp.t -> 'a t
+  val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t
 
   val map : 'a t -> f:('a -> 'b) -> 'b t
   val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
@@ -28,6 +30,8 @@ module Lift(M : Container) : sig
   type nonrec t = t M.t
   val t : Sexp.t -> t
 
+  val sexp_of_t : t -> Sexp.t
+
   val fold : t -> init:'a -> f:('a -> string -> 'a) -> 'a
 
   val expand : t -> f:(string -> string option) -> string M.t