Source file ppx_monad_lib.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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
open Ppxlib
open Helpers

let fresh_variable = fresh_variable

let register
    (* Module containing monadic functions *)
    ?monad ?monad_error
    (* Monadic functions *)
    ?mk_return ?mk_bind
    ?mk_fail ?mk_catch
    (* Name and where it applies *)
    ?applies_on name
  =
  (* parse `monad` and `monad_error` as long idents *)
  let monad = Longident.parse <$> monad in
  let monad_error = Longident.parse <$> monad_error in
  (* compute the expander *)
  let expander =
    Expander.mk
      ?monad ?monad_error
      ?mk_return ?mk_bind ?mk_fail ?mk_catch
      ()
  in
  (* compute the labels to which this extension should apply *)
  let labels =
    (match applies_on with
     | Some applies_on -> applies_on
     | None -> name)
    |> (fun r -> "monad.(" ^ r ^ ")")
    |> SimpleRegexp.from_string
    |> SimpleRegexp.unfoldings
  in
  (* for each label, create a rule using the expander *)
  let rule_of_label label =
    Extension.V3.declare label
      Extension.Context.expression
      Ast_pattern.(single_expr_payload __)
      expander
    |> Ppxlib.Context_free.Rule.extension
  in
  let rules = List.map rule_of_label labels in
  (* register a transformation with all those rules *)
  Driver.register_transformation ~rules name