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
|
(**************************************************************************)
(* *)
(* OCamlFormat *)
(* *)
(* Copyright (c) Facebook, Inc. and its affiliates. *)
(* *)
(* This source code is licensed under the MIT license found in *)
(* the LICENSE file in the root directory of this source tree. *)
(* *)
(**************************************************************************)
type format_args =
{path: string option; config: (string * string) list option}
let empty_args = {path= None; config= None}
module Version = struct
type t = V1 | V2
let to_string = function V1 -> "v1" | V2 -> "v2"
let of_string = function
| "v1" | "V1" -> Some V1
| "v2" | "V2" -> Some V2
| _ -> None
end
module Make (IO : IO.S) = struct
module type Command_S = sig
type t
val read_input : IO.ic -> t IO.t
val output : IO.oc -> t -> unit IO.t
end
module Init = struct
type t = [`Halt | `Unknown | `Version of string]
let read_input ic =
let open IO in
read ic
>>= function
| None -> return `Halt
| Some (Atom "Halt") -> return `Halt
| Some (List [Atom "Version"; Atom v]) -> return (`Version v)
| Some _ -> return `Unknown
let to_sexp =
let open Csexp in
function
| `Version v -> List [Atom "Version"; Atom v]
| _ -> assert false
let output oc t = IO.write oc [to_sexp t]
end
module V1 = struct
type t =
[ `Halt
| `Unknown
| `Error of string
| `Config of (string * string) list
| `Format of string ]
let read_input ic =
let open Csexp in
let open IO in
read ic
>>= function
| None -> return `Halt
| Some (List [Atom "Format"; Atom x]) -> return (`Format x)
| Some (List [Atom "Config"; List l]) ->
let c =
List.fold_left
(fun acc -> function
| List [Atom name; Atom value] -> (name, value) :: acc
| _ -> acc )
[] l
|> List.rev
in
return (`Config c)
| Some (List [Atom "Error"; Atom x]) -> return (`Error x)
| Some (Atom "Halt") -> return `Halt
| Some _ -> return `Unknown
let to_sexp =
let open Csexp in
function
| `Format x -> List [Atom "Format"; Atom x]
| `Config c ->
let l =
List.map (fun (name, value) -> List [Atom name; Atom value]) c
in
List [Atom "Config"; List l]
| `Error x -> List [Atom "Error"; Atom x]
| `Halt -> Atom "Halt"
| _ -> assert false
let output oc t = IO.write oc [to_sexp t]
end
module V2 = struct
type t =
[`Halt | `Unknown | `Error of string | `Format of string * format_args]
let read_input ic =
let open Csexp in
let open IO in
let csexp_to_config csexpl =
List.filter_map
(function
| List [Atom name; Atom value] -> Some (name, value) | _ -> None )
csexpl
in
read ic
>>= function
| None -> return `Halt
| Some (List (Atom "Format" :: Atom x :: l)) ->
let extract args csexp =
match csexp with
| List [Atom "Config"; List l] ->
{args with config= Some (csexp_to_config l)}
| List [Atom "Path"; Atom path] -> {args with path= Some path}
| _ -> args
in
let args = List.fold_left extract empty_args l in
return (`Format (x, args))
| Some (List [Atom "Error"; Atom x]) -> return (`Error x)
| Some (Atom "Halt") -> return `Halt
| Some _ -> return `Unknown
let to_sexp =
let open Csexp in
function
| `Format (x, {path; config}) ->
let map_config name config =
let c =
List.map
(fun (name, value) -> List [Atom name; Atom value])
config
in
List [Atom name; List c]
in
let ofp =
Option.map (fun path -> List [Atom "Path"; Atom path]) path
and oconfig = Option.map (map_config "Config") config in
List
(List.filter_map
(fun i -> i)
[Some (Atom "Format"); Some (Atom x); ofp; oconfig] )
| `Error x -> List [Atom "Error"; Atom x]
| `Halt -> Atom "Halt"
| _ -> assert false
let output oc t = IO.write oc [to_sexp t]
end
end
|
