package encore

  1. Overview
  2. Docs

Source file proxy_decoder.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
module Impl : Meta.S with type 'a t = 'a Angstrom.t =
struct
  type 'a t = 'a Angstrom.t

  let ( <$> ) bijection p =
    let open Angstrom in

    (p >>= fun x ->

     try let x = bijection.Bijection.to_ x in return x
     with
     | Bijection.Exn.Bijection (to_, of_) ->
       Angstrom.fail (Fmt.strf "bijection: %s to %s" to_ of_))

  let ( <*> ) pa pb =
    let open Angstrom in
    pa >>= fun a -> pb >>= fun b -> return (a, b)

  let ( <|> ) pu pv =
    let open Angstrom in
    pu <|> pv

  let ( *> ) pu pe =
    let open Angstrom in
    pu *> pe

  let ( <* ) pe pu =
    let open Angstrom in
    pe <* pu

  let ( $> )
    : unit t -> (unit, 'a) Bijection.texn -> 'a t
    = fun pu bijection ->
      let open Angstrom in
      pu >>= fun () ->
      let open Bijection in
      match bijection.to_ (), bijection.kd with
      | x, E -> return x
      | exception Bijection.Exn.Bijection (to_, of_) ->
        Angstrom.fail (Fmt.strf "bijection: %s to %s" to_ of_)

  let ( <$ )
    : 'a t -> (unit, 'a) Bijection.texn -> unit t
    = fun pe bijection ->
      let open Angstrom in
      pe >>= fun x ->
      let open Bijection in
      match bijection.of_ x, bijection.kd with
      | x, E -> return x
      | exception Bijection.Exn.Bijection (to_, of_) ->
        Angstrom.fail (Fmt.strf "bijection: %s to %s" to_ of_)

  let fix = Angstrom.fix
  let nop = Angstrom.return ()
  let any = Angstrom.any_char

  let fail err = Angstrom.fail err
  let pure ~compare:_ v = Angstrom.return v
  let take = Angstrom.take
  let peek a b =
    let open Angstrom in
    peek_char >>= function
    | Some _ ->
       a >>| fun x -> Either.L x
    | None ->
       b >>| fun y -> Either.R y
  let skip = Angstrom.skip_many

  let const s = Angstrom.(string s <?> s)

  let commit =
    Angstrom.commit

  let while0 = Angstrom.take_while
  let while1 = Angstrom.take_while1
  let bigstring_while0 = Angstrom.take_bigstring_while
  let bigstring_while1 = Angstrom.take_bigstring_while1

  let buffer =
    let open Angstrom in
    available >>= take

  let bigstring_buffer =
    let open Angstrom in
    available >>= take_bigstring

  module Option =
  struct
    let ( <$> ) bijection p =
      let open Angstrom in
      p >>= fun x -> match bijection.Bijection.to_ x with
      | Some x -> return x
      | None -> Angstrom.fail "bijection: 'a to 'b"

    let ( $>) pu bijection =
      let open Angstrom in
      pu >>= fun () ->
      let open Bijection in
      match bijection.to_ (), bijection.kd with
      | Some x, O -> return x
      | None, O -> Angstrom.fail "bijection: unit to 'a"

    let (<$ ) pe bijection =
      let open Angstrom in
      pe >>= fun x ->
      let open Bijection in
      match bijection.of_ x, bijection.kd with
      | Some x, O -> return x
      | None, O -> Angstrom.fail "bijection: 'a to unit"
  end
end