package validate

You can search for identifiers within the package.

in-package search v0.2.0

OCaml library enabling efficient data validation through PPX derivers and a suite of annotation-based validators

Install

dune-project

Dependency

github.com Readme Changelog Edit opam file Versions (4)

Authors

M

Mateusz Ledwoń <mateuszledwon@duck.com>

Maintainers

M

Mateusz Ledwoń <mateuszledwon@duck.com>

Sources

validate-1.0.0.tbz

sha256=af5d77b4c0b861516f1499e5d4d5d55e8214f9871878bb801e579bf26ed5a089

sha512=349b65e41da8aa44da10d5b21da0f05fea4ffe75957f18d21d2140483dedefd04fa3f183fd60f1f75a3ac094f33510587eff551dc6b464b28b72eb916dad9461

doc/src/ppx_derive_validate/exps.ml.html

Source file `exps.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
114
115
116
117
118
119
120
121
122
123
124
125
126
open Ppxlib
open Ast_helper
open Pats

let int_exp i = Exp.constant (Pconst_integer (string_of_int i, None))
let float_exp f = Exp.constant (Pconst_float (string_of_float f, None))
let string_exp ~loc s = Exp.constant (Pconst_string (s, loc, None))
let simple_ident_exp ~loc str = Exp.ident { txt = Lident str; loc }

let module_ident_exp ~loc m str =
  Exp.(ident { txt = Ldot (Lident m, str); loc })

let rec list_exp ~loc = function
  | [] -> Exp.construct { txt = Lident "[]"; loc } None
  | x :: xs ->
      Exp.construct { txt = Lident "::"; loc }
        (Some (Exp.tuple [ x; list_exp ~loc xs ]))

let validate_func_exp ~loc validator_name params =
  let open Exp in
  match params with
  | [] -> module_ident_exp ~loc "Validate" validator_name
  | _ -> apply (module_ident_exp ~loc "Validate" validator_name) params

let field_extractor_exp ~loc name =
  let open Exp in
  fun_ Nolabel None
    (Pat.var { txt = "x"; loc })
    (field (simple_ident_exp ~loc "x") { txt = Lident name; loc })

let validate_list_exp ~loc inner =
  let open Exp in
  apply (module_ident_exp ~loc "Validate" "list") [ (Nolabel, inner) ]

let ignore_ok_exp ~loc inner =
  let open Exp in
  apply (module_ident_exp ~loc "Validate" "ignore_ok") [ (Nolabel, inner) ]

let dive_exp ~loc type_name =
  let open Exp in
  let txt =
    match type_name with
    | Lident name -> Lident (Printf.sprintf "validate_%s" name)
    | Ldot (module_name, name) ->
        Ldot (module_name, Printf.sprintf "validate_%s" name)
    | _ -> Location.raise_errorf ~loc "Something went wrong"
  in

  ident { txt; loc }

let variant_tuple_extractor_exp ~loc expected_type_name total n =
  let pattern = n_element_tuple_pat ~loc ~prefix:"x" total in
  let match_exp =
    Exp.match_
      (simple_ident_exp ~loc "x")
      [
        Exp.case
          (Pat.construct
             { txt = Lident expected_type_name; loc }
             (Some pattern))
          (Exp.construct
             { txt = Lident "Some"; loc }
             (Some (simple_ident_exp ~loc (Printf.sprintf "x%d" n))));
        Exp.case (Pat.any ()) (Exp.construct { txt = Lident "None"; loc } None);
      ]
  in
  Exp.(fun_ Nolabel None (Pat.var { txt = "x"; loc }) match_exp)

let variant_record_extractor_exp ~loc expected_type_name field_names
    extracted_field_name =
  let pattern = record_pat ~loc field_names in
  let match_exp =
    Exp.match_
      (simple_ident_exp ~loc "x")
      [
        Exp.case
          (Pat.construct
             { txt = Lident expected_type_name; loc }
             (Some pattern))
          (Exp.construct
             { txt = Lident "Some"; loc }
             (Some (simple_ident_exp ~loc extracted_field_name)));
        Exp.case (Pat.any ()) (Exp.construct { txt = Lident "None"; loc } None);
      ]
  in
  Exp.(fun_ Nolabel None (Pat.var { txt = "x"; loc }) match_exp)

let validate_field_exp ~loc name extractor_fun_exp validators_list_exp =
  Exp.(
    apply
      (module_ident_exp ~loc "Validate" "field")
      [
        (Nolabel, string_exp ~loc name);
        (Nolabel, extractor_fun_exp);
        (Nolabel, validators_list_exp);
      ])

let validate_named_value_exp ~loc name extractor_fun_exp validators_list_exp =
  Exp.(
    apply
      (module_ident_exp ~loc "Validate" "named_value")
      [
        (Nolabel, string_exp ~loc name);
        (Nolabel, extractor_fun_exp);
        (Nolabel, validators_list_exp);
      ])

let tuple_element_extractor_fun_exp ~loc total n =
  let open Exp in
  let pattern = n_element_tuple_pat ~loc ~prefix:"x" total in
  fun_ Nolabel None pattern (simple_ident_exp ~loc (Printf.sprintf "x%d" n))

let validate_keyed_exp ~loc arg_exp =
  Exp.(apply (module_ident_exp ~loc "Validate" "keyed") [ (Nolabel, arg_exp) ])

let validate_group_exp ~loc arg_exp =
  Exp.(apply (module_ident_exp ~loc "Validate" "group") [ (Nolabel, arg_exp) ])

let validate_exp ~loc arg_exp =
  Exp.(
    apply
      (module_ident_exp ~loc "Validate" "validate")
      [ (Nolabel, arg_exp); (Nolabel, simple_ident_exp ~loc "x") ])

let validate_option ~loc arg_exp =
  Exp.(apply (module_ident_exp ~loc "Validate" "option") [ (Nolabel, arg_exp) ])