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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
open Module_types
module Error =
struct
type t = {
code: string;
message: string;
}
let code (error: t): string =
error.code
let message (error: t): string =
error.message
let make (code: string) (message: string): t =
{code; message}
end
module type STAT =
sig
type t
type time
val compare: time -> time -> int
val is_directory: t -> bool
val is_file: t -> bool
val modification: t -> time
end
module type SIG =
sig
module M: MONAD
include MONAD
module Path:
sig
val absolute: string -> string t
val split: string -> (string * string) option
val normalize: string -> string
val join: string -> string -> string
end
module Process:
sig
val exit: int -> 'a t
val execute: unit t -> unit
val command_line: string array t
val current_working_directory: string t
end
module Directory:
sig
val read: string -> string array option t
end
module File:
sig
module In:
sig
type fd
val open_: string -> (fd, Error.t) result t
val close: fd -> unit t
end
module Out:
sig
type fd
val open_: string -> (fd, Error.t) result t
val create: string -> (fd, Error.t) result t
val close: fd -> unit t
val putc: char -> fd -> unit t
val substring: string -> int -> int -> fd -> unit t
val string: string -> fd -> unit t
val line: string -> fd -> unit t
val newline: fd -> unit t
val fill: int -> char -> fd -> unit t
end
val stdin: In.fd
val stdout: Out.fd
val stderr: Out.fd
module Read (W: WRITABLE):
sig
val read_buffer: In.fd -> W.t -> W.t t
val read: In.fd -> W.t -> (W.t, W.t * Error.t) result t
end
end
module Stdout:
sig
val putc: char -> unit t
val string: string -> unit t
val line: string -> unit t
val newline: unit t
val fill: int -> char -> unit t
end
module Stderr:
sig
val putc: char -> unit t
val string: string -> unit t
val line: string -> unit t
val newline: unit t
val fill: int -> char -> unit t
end
val cli_loop:
'a
-> ('a -> string option)
-> ('a -> string -> 'a t)
-> ('a -> 'a t)
-> 'a t
end
module Output(Io: SIG) =
struct
type fd = Io.File.Out.fd
type t = fd -> unit Io.t
let empty: t =
fun _ -> Io.return ()
let (<+>) (a: t) (b: t): t =
fun fd ->
Io.(a fd >>= fun () -> b fd)
let char (c: char): t =
Io.File.Out.putc c
let fill (n: int) (c: char): t =
Io.File.Out.fill n c
let substring (str: string) (start: int) (len: int): t =
Io.File.Out.substring str start len
let string (str: string): t =
Io.File.Out.string str
let line str =
Io.File.Out.line str
let newline =
Io.File.Out.newline
let run (fd: fd) (p: t): unit Io.t =
p fd
end