1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
let track_files list = Task.make (Deps.from_list list) Eff.return
let track_file file = track_files [ file ]
let read_file ?snapshot file =
Task.make (Deps.singleton file) (fun () ->
Eff.read_file ?snapshot ~on:`Source file)
let directory_exists path =
Task.from_effect ~has_dynamic_dependencies:false (fun () ->
Eff.is_directory ~on:`Source path)
let file_exists path =
Task.from_effect ~has_dynamic_dependencies:false (fun () ->
Eff.is_file ~on:`Source path)
let read_file_with_metadata (type a) (module P : Required.DATA_PROVIDER)
(module R : Required.DATA_READABLE with type t = a) ?
?snapshot path =
Task.make (Deps.singleton path) (fun () ->
Eff.read_file_with_metadata
(module P)
(module R)
?extraction_strategy ?snapshot ~on:`Source path)
let read_file_as_metadata (type a) (module P : Required.DATA_PROVIDER)
(module R : Required.DATA_READABLE with type t = a) ?snapshot path =
Task.make (Deps.singleton path) (fun () ->
Eff.read_file_as_metadata (module P) (module R) ?snapshot ~on:`Source path)
let read_template (module T : Required.DATA_TEMPLATE) ?(snapshot = true)
?(strict = true) template =
let open Task in
read_file ~snapshot template
>>> lift ~has_dynamic_dependencies:false (fun template_content ->
let callback (type a)
(module I : Required.DATA_INJECTABLE with type t = a) ~metadata
content =
let parameters =
("yocaml_body", Data.string content) :: I.normalize metadata
|> List.map (fun (k, v) -> (k, T.from v))
in
T.render ~strict parameters template_content
in
callback)
module type S = Required.DATA_INJECTABLE
let read_templates (type a) (module T : Required.DATA_TEMPLATE)
?(snapshot = true) ?(strict = true) (templates : Path.t list) =
match List.map (read_template (module T) ~snapshot ~strict) templates with
| [] ->
Task.pure
(fun (module I : S with type t = a) ~metadata:_ (content : string) ->
content)
| x :: xs ->
List.fold_left
(fun acc t ->
let af f g (module I : S with type t = a) ~metadata content =
g
(module I : S with type t = a)
~metadata
(f (module I : S with type t = a) ~metadata content)
in
Task.map2 af acc t)
x xs
let as_template (type a) (module T : Required.DATA_TEMPLATE)
(module I : Required.DATA_INJECTABLE with type t = a) ?(snapshot = true)
?(strict = true) template =
let action ((meta, content), tpl_content) =
let parameters = ("yocaml_body", Data.string content) :: I.normalize meta in
let parameters = List.map (fun (k, v) -> (k, T.from v)) parameters in
try
let new_content = T.render ~strict parameters tpl_content in
Eff.return (meta, new_content)
with exn -> Eff.raise exn
in
let open Task in
(fun x -> (x, ())) |>> second (read_file ~snapshot template) >>* action
let chain_templates (type a) (module T : Required.DATA_TEMPLATE)
(module I : Required.DATA_INJECTABLE with type t = a) ?(snapshot = true)
?(strict = true) templates =
List.fold_left
(fun task template ->
let open Task in
task >>> as_template ~snapshot ~strict (module T) (module I) template)
Task.id templates
let exec_cmd_with_result ?is_success cmd =
let deps = cmd |> Cmd.deps_of |> Deps.from_list in
Task.make ~has_dynamic_dependencies:false deps (fun () ->
Eff.exec_cmd ?is_success cmd)
let exec_cmd ?is_success cmd =
Task.rcompose
(exec_cmd_with_result ?is_success cmd)
(Task.lift ~has_dynamic_dependencies:false (fun _result -> ()))
let pipe f arr =
let open Task in
let lift f = lift ~has_dynamic_dependencies:false f in
lift (fun x -> (x, ())) >>> second arr >>> lift (fun (a, b) -> f a b)
let pipe_files ?(separator = "") files =
let f x y = x ^ separator ^ y in
List.fold_left
(fun arr file -> Task.(arr >>> pipe f (read_file file)))
(Task.const "") files
let fetch_some ?(only = `Files) ?(where = fun _ -> true) ?(on = `Source)
callback path =
Task.rcompose (track_file path)
(Task.from_effect (fun () ->
let open Eff in
let* files = read_directory ~on ~only ~where path in
List.filter_map callback files))
let fetch ?only ?where ?on callback =
fetch_some ?only ?where ?on (fun p ->
let open Eff in
let+ result = callback p in
Some result)