package core

  1. Overview
  2. Docs
package core
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file validated.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
open! Import
open Std_internal
open Validated_intf

module type Raw = Raw

type ('raw, 'witness) t = 'raw

module type S = S with type ('a, 'b) validated := ('a, 'b) t
module type S_bin_io = S_bin_io with type ('a, 'b) validated := ('a, 'b) t

module type S_bin_io_compare_hash_sexp =
  S_bin_io_compare_hash_sexp with type ('a, 'b) validated := ('a, 'b) t

let raw t = t

module Make (Raw : Raw) = struct
  type witness
  type t = Raw.t [@@deriving sexp_of]

  let validation_failed t error =
    Error.create
      "validation failed"
      (t, error, Raw.here)
      [%sexp_of: Raw.t * Error.t * Source_code_position.t]
  ;;

  let create_exn t =
    match Validate.result (Raw.validate t) with
    | Ok () -> t
    | Error error -> Error.raise (validation_failed t error)
  ;;

  let create t =
    match Validate.result (Raw.validate t) with
    | Ok () -> Ok t
    | Error error -> Error (validation_failed t error)
  ;;

  let t_of_sexp sexp = create_exn (Raw.t_of_sexp sexp)
  let raw t = t
end

module Add_bin_io (Raw : sig
    type t [@@deriving bin_io]

    include Raw_bin_io with type t := t
  end)
    (Validated : S with type raw := Raw.t) =
struct
  include
    Binable.Of_binable_without_uuid [@alert "-legacy"]
      (Raw)
      (struct
        type t = Raw.t

        let of_binable raw =
          if Raw.validate_binio_deserialization then Validated.create_exn raw else raw
        ;;

        let to_binable = Fn.id
      end)
end

module Add_compare (Raw : sig
    type t [@@deriving compare]

    include Raw with type t := t
  end)
    (_ : S with type raw := Raw.t) =
struct
  let compare t1 t2 = [%compare: Raw.t] (raw t1) (raw t2)
end

module Add_hash (Raw : sig
    type t [@@deriving hash]

    include Raw with type t := t
  end)
    (Validated : S with type raw := Raw.t) =
struct
  let hash_fold_t state t = Raw.hash_fold_t state (Validated.raw t)
  let hash t = Raw.hash (Validated.raw t)
end

module Add_typerep (Raw : sig
    type t [@@deriving typerep]

    include Raw with type t := t
  end)
    (_ : S with type raw := Raw.t) =
struct
  type t = Raw.t [@@deriving typerep]
end

module Make_binable (Raw : Raw_bin_io) = struct
  module T0 = Make (Raw)
  include T0
  include Add_bin_io (Raw) (T0)
end

module Make_bin_io_compare_hash_sexp (Raw : sig
    type t [@@deriving compare, hash]

    include Raw_bin_io with type t := t
  end) =
struct
  module T = Make_binable (Raw)
  include T
  include Add_compare (Raw) (T)

  include (
    Add_hash (Raw) (T) :
    sig
      type t [@@deriving hash]
    end
    with type t := t)
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct