Source file ppx_yojson_conv.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
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
(* yojson_conv: Preprocessing Module for Automated Yojson Conversions *)

open Ppxlib
module Attrs = Ppx_yojson_conv_expander.Attrs

module Yojson_of = struct
  module E = Ppx_yojson_conv_expander.Yojson_of

  let name = "yojson_of"

  let str_type_decl =
    Deriving.Generator.make_noarg
      E.str_type_decl
      ~attributes:
        [ Attribute.T Attrs.default
        ; Attribute.T Attrs.drop_default
        ; Attribute.T Attrs.drop_if
        ]
  ;;

  let sig_type_decl = Deriving.Generator.make_noarg E.sig_type_decl
  let extension ~loc:_ ~path:_ ctyp = E.core_type ctyp
  let deriver = Deriving.add name ~str_type_decl ~sig_type_decl ~extension

  let () =
    Driver.register_transformation
      name
      ~rules:
        [ Context_free.Rule.extension
            (Extension.declare
               name
               Core_type
               Ast_pattern.(ptyp __)
               (fun ~loc:_ ~path:_ ty -> E.type_extension ty))
        ]
  ;;
end

module Yojson_fields = struct
  module E = Ppx_yojson_conv_expander.Yojson_fields

  let name = "yojson_fields"
  let str_type_decl = Deriving.Generator.make_noarg E.str_type_decl ~attributes:[]
  let deriver = Deriving.add name ~str_type_decl
end

module Of_yojson = struct
  module E = Ppx_yojson_conv_expander.Of_yojson

  let name = "of_yojson"

  let str_type_decl =
    Deriving.Generator.make_noarg
      (E.str_type_decl ~poly:false)
      ~attributes:[ Attribute.T Attrs.default ]
  ;;

  let sig_type_decl = Deriving.Generator.make_noarg (E.sig_type_decl ~poly:false)
  let extension ~loc:_ ~path ctyp = E.core_type ~path ctyp
  let deriver = Deriving.add name ~str_type_decl ~sig_type_decl ~extension

  let () =
    Driver.register_transformation
      name
      ~rules:
        [ Context_free.Rule.extension
            (Extension.declare
               name
               Core_type
               Ast_pattern.(ptyp __)
               (fun ~loc:_ ~path:_ ty -> E.type_extension ty))
        ]
  ;;
end

module Of_yojson_poly = struct
  module E = Ppx_yojson_conv_expander.Of_yojson

  let str_type_decl =
    Deriving.Generator.make_noarg
      (E.str_type_decl ~poly:true)
      ~attributes:[ Attribute.T Attrs.default ]
  ;;

  let sig_type_decl = Deriving.Generator.make_noarg (E.sig_type_decl ~poly:true)
  let deriver = Deriving.add "of_yojson_poly" ~sig_type_decl ~str_type_decl
end

let yojson_of = Yojson_of.deriver
let yojson_fields_of = Yojson_fields.deriver
let of_yojson = Of_yojson.deriver
let of_yojson_poly = Of_yojson_poly.deriver

module Yojson_in_sig = struct
  module E = Ppx_yojson_conv_expander.Sig_yojson

  let sig_type_decl = Deriving.Generator.make_noarg E.sig_type_decl

  let deriver =
    Deriving.add
      "ppx_yojson_conv: let this be a string that wouldn't parse if put in the source"
      ~sig_type_decl
  ;;
end

let yojson =
  Deriving.add_alias
    "yojson"
    [ yojson_of; of_yojson ]
    ~sig_type_decl:[ Yojson_in_sig.deriver ]
;;

let yojson_poly = Deriving.add_alias "yojson_poly" [ yojson_of; of_yojson_poly ]