Remove unnecessary functors
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg
parent
700b78e094
commit
2c0ca6e840
174
src/action.ml
174
src/action.ml
|
|
@ -15,15 +15,10 @@ end
|
||||||
|
|
||||||
module Diff_mode = Action_intf.Diff_mode
|
module Diff_mode = Action_intf.Diff_mode
|
||||||
|
|
||||||
module type With_sexp = sig
|
|
||||||
include Dsexp.Sexpable
|
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
end
|
|
||||||
|
|
||||||
module Make_ast
|
module Make_ast
|
||||||
(Program : With_sexp)
|
(Program : Dsexp.Sexpable)
|
||||||
(Path : With_sexp)
|
(Path : Dsexp.Sexpable)
|
||||||
(String : With_sexp)
|
(String : Dsexp.Sexpable)
|
||||||
(Ast : Action_intf.Ast
|
(Ast : Action_intf.Ast
|
||||||
with type program := Program.t
|
with type program := Program.t
|
||||||
with type path := Path.t
|
with type path := Path.t
|
||||||
|
|
@ -135,83 +130,57 @@ struct
|
||||||
Diff { optional = false; file1; file2; mode = Binary })
|
Diff { optional = false; file1; file2; mode = Binary })
|
||||||
])
|
])
|
||||||
|
|
||||||
module Make_gen (P : sig
|
let rec dgen =
|
||||||
type sexp
|
let open Dsexp in
|
||||||
val atom : string -> sexp
|
let program = Program.dgen in
|
||||||
val list : sexp list -> sexp
|
let string = String.dgen in
|
||||||
val path : Path.t -> sexp
|
let path = Path.dgen in
|
||||||
val string : String.t -> sexp
|
function
|
||||||
val program : Program.t -> sexp
|
| Run (a, xs) ->
|
||||||
end) = struct
|
List (atom "run" :: program a :: List.map xs ~f:string)
|
||||||
open P
|
| Chdir (a, r) -> List [atom "chdir" ; path a ; dgen r]
|
||||||
let rec gen =
|
| Setenv (k, v, r) -> List [atom "setenv" ; string k ; string v ; dgen r]
|
||||||
function
|
| Redirect (outputs, fn, r) ->
|
||||||
| Run (a, xs) ->
|
List [ atom (sprintf "with-%s-to" (Outputs.to_string outputs))
|
||||||
list (atom "run" :: program a :: List.map xs ~f:string)
|
; path fn
|
||||||
| Chdir (a, r) -> list [atom "chdir" ; path a ; gen r]
|
; dgen r
|
||||||
| Setenv (k, v, r) -> list [atom "setenv" ; string k ; string v ; gen r]
|
]
|
||||||
| Redirect (outputs, fn, r) ->
|
| Ignore (outputs, r) ->
|
||||||
list [ atom (sprintf "with-%s-to" (Outputs.to_string outputs))
|
List [ atom (sprintf "ignore-%s" (Outputs.to_string outputs))
|
||||||
; path fn
|
; dgen r
|
||||||
; gen r
|
]
|
||||||
]
|
| Progn l -> List (atom "progn" :: List.map l ~f:dgen)
|
||||||
| Ignore (outputs, r) ->
|
| Echo xs ->
|
||||||
list [ atom (sprintf "ignore-%s" (Outputs.to_string outputs))
|
List (atom "echo" :: List.map xs ~f:string)
|
||||||
; gen r
|
| Cat x -> List [atom "cat"; path x]
|
||||||
]
|
| Copy (x, y) ->
|
||||||
| Progn l -> list (atom "progn" :: List.map l ~f:gen)
|
List [atom "copy"; path x; path y]
|
||||||
| Echo xs ->
|
| Symlink (x, y) ->
|
||||||
list (atom "echo" :: List.map xs ~f:string)
|
List [atom "symlink"; path x; path y]
|
||||||
| Cat x -> list [atom "cat"; path x]
|
| Copy_and_add_line_directive (x, y) ->
|
||||||
| Copy (x, y) ->
|
List [atom "copy#"; path x; path y]
|
||||||
list [atom "copy"; path x; path y]
|
| System x -> List [atom "system"; string x]
|
||||||
| Symlink (x, y) ->
|
| Bash x -> List [atom "bash"; string x]
|
||||||
list [atom "symlink"; path x; path y]
|
| Write_file (x, y) -> List [atom "write-file"; path x; string y]
|
||||||
| Copy_and_add_line_directive (x, y) ->
|
| Rename (x, y) -> List [atom "rename"; path x; path y]
|
||||||
list [atom "copy#"; path x; path y]
|
| Remove_tree x -> List [atom "remove-tree"; path x]
|
||||||
| System x -> list [atom "system"; string x]
|
| Mkdir x -> List [atom "mkdir"; path x]
|
||||||
| Bash x -> list [atom "bash"; string x]
|
| Digest_files paths -> List [atom "digest-files";
|
||||||
| Write_file (x, y) -> list [atom "write-file"; path x; string y]
|
List (List.map paths ~f:path)]
|
||||||
| Rename (x, y) -> list [atom "rename"; path x; path y]
|
| Diff { optional; file1; file2; mode = Binary} ->
|
||||||
| Remove_tree x -> list [atom "remove-tree"; path x]
|
assert (not optional);
|
||||||
| Mkdir x -> list [atom "mkdir"; path x]
|
List [atom "cmp"; path file1; path file2]
|
||||||
| Digest_files paths -> list [atom "digest-files";
|
| Diff { optional = false; file1; file2; mode = _ } ->
|
||||||
list (List.map paths ~f:path)]
|
List [atom "diff"; path file1; path file2]
|
||||||
| Diff { optional; file1; file2; mode = Binary} ->
|
| Diff { optional = true; file1; file2; mode = _ } ->
|
||||||
assert (not optional);
|
List [atom "diff?"; path file1; path file2]
|
||||||
list [atom "cmp"; path file1; path file2]
|
| Merge_files_into (srcs, extras, target) ->
|
||||||
| Diff { optional = false; file1; file2; mode = _ } ->
|
List
|
||||||
list [atom "diff"; path file1; path file2]
|
[ atom "merge-files-into"
|
||||||
| Diff { optional = true; file1; file2; mode = _ } ->
|
; List (List.map ~f:path srcs)
|
||||||
list [atom "diff?"; path file1; path file2]
|
; List (List.map ~f:string extras)
|
||||||
| Merge_files_into (srcs, extras, target) ->
|
; path target
|
||||||
list
|
]
|
||||||
[ atom "merge-files-into"
|
|
||||||
; list (List.map ~f:path srcs)
|
|
||||||
; list (List.map ~f:string extras)
|
|
||||||
; path target
|
|
||||||
]
|
|
||||||
end
|
|
||||||
|
|
||||||
module Dgen = Make_gen(struct
|
|
||||||
type sexp = Dsexp.t
|
|
||||||
let atom = Dsexp.unsafe_atom_of_string
|
|
||||||
let list s = Dsexp.List s
|
|
||||||
let program = Program.dgen
|
|
||||||
let string = String.dgen
|
|
||||||
let path = Path.dgen
|
|
||||||
end)
|
|
||||||
let dgen = Dgen.gen
|
|
||||||
|
|
||||||
module Sexpgen = Make_gen(struct
|
|
||||||
type sexp = Sexp.t
|
|
||||||
let atom a = Sexp.Atom a
|
|
||||||
let list a = Sexp.List a
|
|
||||||
let program = Program.sexp_of_t
|
|
||||||
let string = String.sexp_of_t
|
|
||||||
let path = Path.sexp_of_t
|
|
||||||
end)
|
|
||||||
let sexp_of_t = Sexpgen.gen
|
|
||||||
|
|
||||||
let run prog args = Run (prog, args)
|
let run prog args = Run (prog, args)
|
||||||
let chdir path t = Chdir (path, t)
|
let chdir path t = Chdir (path, t)
|
||||||
|
|
@ -301,30 +270,9 @@ module Prog = struct
|
||||||
let dparse : t Dsexp.Of_sexp.t =
|
let dparse : t Dsexp.Of_sexp.t =
|
||||||
Dsexp.Of_sexp.map Path_dsexp.dparse ~f:Result.ok
|
Dsexp.Of_sexp.map Path_dsexp.dparse ~f:Result.ok
|
||||||
|
|
||||||
module Make_gen(P : sig
|
let dgen = function
|
||||||
type sexp
|
| Ok s -> Path_dsexp.dgen s
|
||||||
val path : Path.t -> sexp
|
| Error (e : Not_found.t) -> Dsexp.To_sexp.string e.program
|
||||||
val string : string -> sexp
|
|
||||||
end) = struct
|
|
||||||
open P
|
|
||||||
let gen = function
|
|
||||||
| Ok s -> path s
|
|
||||||
| Error (e : Not_found.t) -> string e.program
|
|
||||||
end
|
|
||||||
|
|
||||||
module D = Make_gen(struct
|
|
||||||
type sexp = Dsexp.t
|
|
||||||
let path = Path_dsexp.dgen
|
|
||||||
let string = Dsexp.To_sexp.string
|
|
||||||
end)
|
|
||||||
let dgen = D.gen
|
|
||||||
|
|
||||||
module S = Make_gen(struct
|
|
||||||
type sexp = Sexp.t
|
|
||||||
let path = Path.sexp_of_t
|
|
||||||
let string = Sexp.To_sexp.string
|
|
||||||
end)
|
|
||||||
let sexp_of_t = S.gen
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module type Ast = Action_intf.Ast
|
module type Ast = Action_intf.Ast
|
||||||
|
|
@ -337,17 +285,11 @@ module String_with_sexp = struct
|
||||||
type t = string
|
type t = string
|
||||||
let dparse = Dsexp.Of_sexp.string
|
let dparse = Dsexp.Of_sexp.string
|
||||||
let dgen = Dsexp.To_sexp.string
|
let dgen = Dsexp.To_sexp.string
|
||||||
let sexp_of_t = Sexp.To_sexp.string
|
|
||||||
end
|
|
||||||
|
|
||||||
module Path_sexp = struct
|
|
||||||
include Path_dsexp
|
|
||||||
let sexp_of_t = Path.sexp_of_t
|
|
||||||
end
|
end
|
||||||
|
|
||||||
include Make_ast
|
include Make_ast
|
||||||
(Prog)
|
(Prog)
|
||||||
(Path_sexp)
|
(Path_dsexp)
|
||||||
(String_with_sexp)
|
(String_with_sexp)
|
||||||
(Ast)
|
(Ast)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -97,8 +97,6 @@ module Unexpanded : sig
|
||||||
-> Partial.t
|
-> Partial.t
|
||||||
|
|
||||||
val remove_locs : t -> t
|
val remove_locs : t -> t
|
||||||
|
|
||||||
val sexp_of_t : t Sexp.To_sexp.t
|
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Infer dependencies and targets.
|
(** Infer dependencies and targets.
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue