blob: c628ad2141229797662256165d0c2ee3167914fe (
plain)
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
;; parser.cljs - parser monad for gnunet-web website
;; Copyright (C) 2013-2015 David Barksdale <amatus@amatus.name>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(ns gnunet-web.parser
(:require [goog.crypt :as gcrypt]
[monads.core :as m :refer [bind get-state join maybe plus set-state
state-t zero]])
(:require-macros [monads.macros :as monadic]))
(extend-type monads.core/state-transformer
IMeta
(-meta [x] (.-meta x))
IWithMeta
(-with-meta [x meta]
;; XXX: return a new state-transformer, don't mutate this one
(set! (.-meta x) meta)
x))
(def parser (state-t maybe))
(defn m-until
"While (p x) is false, replace x by the value returned by the
monadic computation (f x). Return (parser x) for the first
x for which (p x) is true."
[p f x]
(letfn [(until [p f x s]
(if (p x)
(bind (set-state s) (fn [_] (parser x)))
(let [y ((f x) s)]
(if (= y (zero y))
(zero (parser nil))
(let [[x s] (join y)]
(recur p f x s))))))]
(bind (parser nil)
(fn [_] (bind (get-state) (fn [s] (until p f x s)))))))
(defn optional
"Makes a parser optional."
[mv]
(plus [mv (parser nil)]))
(defn none-or-more
"Makes a parser repeat none or more times."
[mv]
(bind
(m-until
first
(fn [[_ xs]]
(plus
[(bind mv (fn [x] (parser [false (conj xs x)])))
(parser [true xs])]))
[false []])
(comp parser second)))
(defn one-or-more
"Makes a parser repeat one or more times."
[mv]
(monadic/do parser
[x mv
xs (none-or-more mv)]
(cons x xs)))
(defn repeat-n
"Makes a parser repeat exactly n times."
[n mv]
(m/seq (clojure.core/repeat n mv)))
;; Parsing Typed Arrays
(def tail (get-state))
(defn items
"Produces a parser which consumes n items from the input.
Input must be a Uint8Array."
[n]
(monadic/do parser
[array (get-state)
:when (<= 0 n (.-length array))
_ (set-state (.subarray array n))]
(.subarray array 0 n)))
(defn satisfy
"Produces a parser that matches an item which satisfies the given predicate."
[p]
(monadic/do parser
[x (items 1)
:let [x (aget x 0)]
:when (p x)]
x))
(def parse-uint8
"Parse an unsigned 8-bit integer.
Input must be a Uint8Array."
(monadic/do parser
[array (get-state)
:when (<= 1 (.-length array))
_ (set-state (.subarray array 1))]
(aget array 0)))
(def parse-uint16
"Parse an unsigned 16-bit integer in network byte order (big endian).
Input must be a Uint8Array."
(monadic/do parser
[msb parse-uint8
lsb parse-uint8]
(+ lsb (* 256 msb))))
(def parse-uint32
"Parse an unsigned 32-bit integer in network byte order (big endian).
Input must be a Uint8Array."
(monadic/do parser
[msh parse-uint16
lsh parse-uint16]
(+ lsh (* 65536 msh))))
(def parse-uint64
"Parse an unsigned 64-bit integer in network byte order (big endian).
Clojurescript cannot represent a 64-bit integer so we return a vector
of numbers.
Input must be a Uint8Array."
(monadic/do parser
[msw parse-uint32
lsw parse-uint32]
[msw lsw]))
(def parse-utf8
(monadic/do parser
[xs (none-or-more (satisfy (comp not zero?)))
_ (items 1)]
(gcrypt/utf8ByteArrayToString (to-array xs))))
(def parse-absolute-time parse-uint64)
|
