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
module Make (Runtime : Required.RUNTIME) = struct
let exnc ?custom_error_handler exn =
let msg =
Format.asprintf "%a"
(Diagnostic.exception_to_diagnostic ?custom_error:custom_error_handler
~in_exception_handler:true)
exn
in
msg |> Runtime.log `Error |> Runtime.bind (fun () -> raise Exit)
let runtimec error =
let error = Runtime.runtime_error_to_string error in
let msg =
Format.asprintf "%a" Diagnostic.runtime_error_to_diagnostic error
in
Runtime.log `Error msg
let map f x = Runtime.bind (fun x -> Runtime.return @@ f x) x
let map_ok f x = map (Result.map f) x
let read_file ~on snapshots path = function
| false -> Runtime.read_file ~on path
| true -> (
match Path.Map.find_opt path !snapshots with
| Some content ->
Runtime.bind
(fun () -> Runtime.return (Ok content))
(Runtime.log `Debug
@@ Format.asprintf "%a already stored" Path.pp path)
| None ->
path
|> Runtime.read_file ~on
|> map_ok (fun content ->
let () = snapshots := Path.Map.add path content !snapshots in
content))
let run ?custom_error_handler program =
let exnc = exnc ?custom_error_handler in
let snapshots : string Path.Map.t ref = ref Path.Map.empty in
let handler =
Effect.Deep.
{
exnc
; retc = (fun () -> Runtime.return ())
; effc =
(fun (type a) (eff : a Effect.t) ->
match eff with
| Eff.Yocaml_failwith exn -> Some (fun _k -> exnc exn)
| Eff.Yocaml_log (src, level, message) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k) (Runtime.log ?src level message))
| Eff.Yocaml_get_time () ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k) (Runtime.get_time ()))
| Eff.Yocaml_file_exists (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k)
(Runtime.file_exists ~on:filesystem path))
| Eff.Yocaml_read_file (filesystem, as_snapshot, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(read_file ~on:filesystem snapshots path as_snapshot))
| Eff.Yocaml_get_mtime (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(Runtime.get_mtime ~on:filesystem path))
| Eff.Yocaml_hash_content content ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k) (Runtime.hash_content content))
| Eff.Yocaml_write_file (filesystem, path, content) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(Runtime.write_file ~on:filesystem path content))
| Eff.Yocaml_create_dir (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(Runtime.create_directory ~on:filesystem path))
| Eff.Yocaml_is_directory (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k)
(Runtime.is_directory ~on:filesystem path))
| Eff.Yocaml_is_file (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind (continue k)
(Runtime.is_file ~on:filesystem path))
| Eff.Yocaml_read_dir (filesystem, path) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(Runtime.read_dir ~on:filesystem path))
| Eff.Yocaml_exec_command (prog, args, is_success) ->
Some
(fun (k : (a, _) continuation) ->
Runtime.bind
(function
| Ok x -> continue k x | Error err -> runtimec err)
(Runtime.exec ~is_success prog args))
| _ -> None)
}
in
Eff.run handler program ()
end