@@ -120,12 +120,21 @@ module CodePrinter = struct
120
120
|> updateMode false
121
121
122
122
(* * compose two context transforming functions *)
123
- let ( +> ) f g ctx =
123
+ let compose_aux f g ctx =
124
124
let fCtx = f ctx in
125
125
match fCtx.mode with
126
126
| ConfirmedMultiline -> fCtx
127
127
| _ -> g fCtx
128
128
129
+ let compose (fs : appendEvents list ) ctx =
130
+ let rec visit fs =
131
+ match fs with
132
+ | [] -> id
133
+ | [f] -> f
134
+ | f :: g :: rest -> visit (compose_aux f g :: rest)
135
+ in
136
+ visit fs ctx
137
+
129
138
let sepNln ctx =
130
139
{
131
140
ctx with
@@ -145,7 +154,7 @@ module CodePrinter = struct
145
154
let sepOpenL ctx = write " [" ctx
146
155
let sepCloseL ctx = write " ]" ctx
147
156
let sepEq ctx = write " = " ctx
148
- let wrapInParentheses f = sepOpenT +> f +> sepCloseT
157
+ let wrapInParentheses f = compose [ sepOpenT; f; sepCloseT]
149
158
let indent ctx =
150
159
let nextIdent = ctx.current_indent + ctx.indent_size in
151
160
{
@@ -163,15 +172,15 @@ module CodePrinter = struct
163
172
events = UnindentBy ctx.indent_size :: ctx .events;
164
173
}
165
174
166
- let indentAndNln f = indent +> sepNln +> f +> unindent
175
+ let indentAndNln f = compose [ indent; sepNln; f; unindent]
167
176
168
177
let col (f : 't -> appendEvents ) (intertwine : appendEvents ) items ctx =
169
178
let rec visit items ctx =
170
179
match items with
171
180
| [] -> ctx
172
181
| [item] -> f item ctx
173
182
| item :: rest ->
174
- let ctx' = ( f item +> intertwine) ctx in
183
+ let ctx' = compose [ f item; intertwine] ctx in
175
184
visit rest ctx'
176
185
in
177
186
visit items ctx
@@ -203,29 +212,42 @@ module CodePrinter = struct
203
212
| List xs -> genList xs
204
213
205
214
and genApplication (name : string ) (argument : oak ) : appendEvents =
206
- let short = write name +> sepOpenT +> genOak argument +> sepCloseT in
215
+ let short = compose [ write name; sepOpenT; genOak argument; sepCloseT] in
207
216
let long =
208
- write name +> sepOpenT
209
- +> (match argument with
210
- | List _ | Record _ -> genOak argument
211
- | _ -> indentAndNln (genOak argument) +> sepNln)
212
- +> sepCloseT
217
+ compose
218
+ [
219
+ write name;
220
+ sepOpenT;
221
+ (match argument with
222
+ | List _ | Record _ -> genOak argument
223
+ | _ -> compose [indentAndNln (genOak argument); sepNln]);
224
+ sepCloseT;
225
+ ]
213
226
in
214
227
expressionFitsOnRestOfLine short long
215
228
216
229
and genRecord (recordFields : namedField list ) : appendEvents =
217
230
let short =
218
231
match recordFields with
219
- | [] -> sepOpenR +> sepCloseR
232
+ | [] -> compose [ sepOpenR; sepCloseR]
220
233
| fields ->
221
- sepOpenR +> sepSpace
222
- +> col genNamedField sepSemi fields
223
- +> sepSpace +> sepCloseR
234
+ compose
235
+ [
236
+ sepOpenR;
237
+ sepSpace;
238
+ col genNamedField sepSemi fields;
239
+ sepSpace;
240
+ sepCloseR;
241
+ ]
224
242
in
225
243
let long =
226
- sepOpenR
227
- +> indentAndNln (col genNamedField sepNln recordFields)
228
- +> sepNln +> sepCloseR
244
+ compose
245
+ [
246
+ sepOpenR;
247
+ indentAndNln (col genNamedField sepNln recordFields);
248
+ sepNln;
249
+ sepCloseR;
250
+ ]
229
251
in
230
252
expressionFitsOnRestOfLine short long
231
253
@@ -239,16 +261,19 @@ module CodePrinter = struct
239
261
and genNamedField (field : namedField ) : appendEvents =
240
262
let genValue =
241
263
match field.value with
242
- | Tuple _ -> sepOpenT +> genOak field.value +> sepCloseT
264
+ | Tuple _ -> compose [ sepOpenT; genOak field.value; sepCloseT]
243
265
| _ -> genOak field.value
244
266
in
245
- let short = write ( field.name) +> sepEq +> genValue in
267
+ let short = compose [ write field.name; sepEq; genValue] in
246
268
let long =
247
- write (field.name) +> sepEq
248
- +>
249
- match field.value with
250
- | List _ | Record _ -> genOak field.value
251
- | _ -> indentAndNln genValue
269
+ compose
270
+ [
271
+ write field.name;
272
+ sepEq;
273
+ (match field.value with
274
+ | List _ | Record _ -> genOak field.value
275
+ | _ -> indentAndNln genValue);
276
+ ]
252
277
in
253
278
expressionFitsOnRestOfLine short long
254
279
@@ -259,13 +284,14 @@ module CodePrinter = struct
259
284
in
260
285
let short =
261
286
match items with
262
- | [] -> sepOpenL +> sepCloseL
287
+ | [] -> compose [ sepOpenL; sepCloseL]
263
288
| _ ->
264
- sepOpenL +> sepSpace +> col genItem sepSemi items +> sepSpace
265
- +> sepCloseL
289
+ compose
290
+ [sepOpenL; sepSpace; col genItem sepSemi items; sepSpace; sepCloseL]
266
291
in
267
292
let long =
268
- sepOpenL +> indentAndNln (col genItem sepNln items) +> sepNln +> sepCloseL
293
+ compose
294
+ [sepOpenL; indentAndNln (col genItem sepNln items); sepNln; sepCloseL]
269
295
in
270
296
expressionFitsOnRestOfLine short long
271
297
end
0 commit comments