Source file pipe_first.ml

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
(* Based on https://github.com/jaredly/belt/blob/master/belt_ppx/Belt_ppx.ml,
   rewriten in ppxlib register and Context_free.Rule.special_function *)

open Ppxlib

let expander e =
  let rec expander' e =
    let loc = e.pexp_loc in
    match e.pexp_desc with
    | Pexp_apply
        ( { pexp_desc = Pexp_ident { txt = Lident "|."; _ }; pexp_loc_stack; pexp_loc = _; pexp_attributes = _ },
          [ (Nolabel, arg); (Nolabel, fn) ] ) -> (
        let fn = Option.value ~default:fn (expander' fn) in
        let arg = Option.value ~default:arg (expander' arg) in
        match fn with
        | { pexp_desc = Pexp_apply (fn, args); pexp_loc; _ } ->
            let args =
              List.filter_map
                (fun (lab, exp) -> match expander' exp with Some e -> Some (lab, e) | None -> Some (lab, exp))
                args
            in
            Some { pexp_desc = Pexp_apply (fn, (Nolabel, arg) :: args); pexp_attributes = []; pexp_loc; pexp_loc_stack }
        | { pexp_desc = Pexp_construct (lident, None); pexp_loc; pexp_loc_stack; pexp_attributes = _ } ->
            Some { pexp_desc = Pexp_construct (lident, Some arg); pexp_attributes = []; pexp_loc; pexp_loc_stack }
        | _ -> Some (Ast_builder.Default.pexp_apply ~loc fn [ (Nolabel, arg) ]))
    | _ -> None
  in
  expander' e

let rule = Context_free.Rule.special_function "( |. )" expander