@@ -6,16 +6,24 @@ module Ur.Deconstructor exposing
66 , int, signedInt, bigint
77 , float32, float64
88 , cord, tape
9− , bytes, sig, ignore, tar, lazy, debug
9+ , bytes, sig, ignore, tar, lazy
1010 )
1111
1212{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
1313
14+The principal (and types) are very similar to `Url.Parser` from `elm/url`.
15+
1416You would parse a `[%edit @ cord]` like this:
1517
1618 type alias Edit = {id: Int, text : String}
1719
18− (D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord)) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
20+ (D.cell (D.const D.cord "edit") (D.cell D.int D.cord)) |> D.map Edit
21+
22+When you `map` a `Deconstructor` the function you pass to `map` will accept exactly the number of arguments
23+that "captured" values in exacly the order they occured in the `Deconstructor`.
24+
25+In our case we `map` the `Edit` type, which accepts exaclty two arguments because there are two `Deconstructor`s
26+that "capture" a value: `D.int` and `D.cord`.
1927
2028@docs Deconstructor
2129
@@ -55,7 +63,7 @@ You would parse a `[%edit @ cord]` like this:
5563
5664# Miscellaneous
5765
58−@docs bytes, sig, ignore, tar, lazy, debug
66+@docs bytes, sig, ignore, tar, lazy
5967
6068-}
6169
@@ -66,74 +74,139 @@ import Bytes exposing (Bytes, Endianness(..))
6674import Bytes.Decode as BD
6775import Bytes.Encode as BE
6876import Bytes.Extra
69−import Ur.Jam exposing (cue, isSig)
77+import Ur.Jam exposing (cue)
7078import Ur.Types exposing (..)
7179
7280
7381{-| A `Noun` deconstructor.
7482-}
75−type alias Deconstructor a =
76− Noun -> Maybe a
83+type Deconstructor a b
84+ = Deconstructor (Noun -> a -> Maybe b)
7785
7886
7987{-| Executes a `Deconstructor` on a `Noun`.
8088-}
81−run : Deconstructor a -> Noun -> Maybe a
82−run f noun =
83− f noun
89+run : Deconstructor (a -> a) a -> Noun -> Maybe a
90+run (Deconstructor f) noun =
91+ f noun identity
8492
8593
8694{-| Executes a deconstructor on a `jam`med `Noun`.
8795-}
88−runBytes : Deconstructor a -> Bytes -> Maybe a
89−runBytes f bs =
90− cue bs |> Maybe.andThen f
96+runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
97+runBytes (Deconstructor f) bs =
98+ cue bs
99+ |> Maybe.andThen
100+ (\noun -> f noun identity)
91101
92102
93−{-| Asserts that the value should be exactly equal to the second argument.
103+{-| Asserts that the value at the current position should be exactly equal to the second argument.
94104
95−The first argument is a `Deconstructor` for the given type.
105+The first argument is a `Deconstructor` for the gven tyoe.
96106
97107The second argument is the value to compare with.
98108
99109This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
100110
101111-}
102−const : Deconstructor a -> a -> Deconstructor ()
103−const f value noun =
104− case f noun of
105− Just a ->
106− if a == value then
107− Just ()
112+const : Deconstructor (a -> a) a -> a -> Deconstructor c c
113+const (Deconstructor f) value =
114+ Deconstructor
115+ (\noun c ->
116+ case f noun identity of
117+ Just a ->
118+ if a == value then
119+ Just c
108120
109− else
110− Nothing
121+ else
122+ Nothing
111123
112− Nothing ->
113− Nothing
124+ Nothing ->
125+ Nothing
126+ )
114127
115128
116−{-| Extracts a `BigInt`.
129+{-| Extracts a `cord` at the current location.
117130-}
118−bigint : Deconstructor BigInt
119−bigint x =
120− case x of
121− Atom bs ->
122− BigInt.Bytes.decode bs |> Just
131+cord : Deconstructor (String -> a) a
132+cord =
133+ Deconstructor
134+ (\x f ->
135+ case x of
136+ Atom bs ->
137+ BD.decode (BD.string (Bytes.width bs)) bs
138+ |> Maybe.map f
139+
140+ Cell _ ->
141+ Nothing
142+ )
123143
124− Cell _ ->
125− Nothing
144+
145+{-| Extracts a `tape` at the current location.
146+-}
147+tape : Deconstructor (String -> a) a
148+tape =
149+ list cord |> fmap String.concat
126150
127151
128−{-| Extracts a 32-bit signed `Int`.
152+{-| Extracts a 32-bit unsigned `Int` at the given location.
129153
130−If the `Atom` is larger than 32 bits the the behaviour is undefined.
154+If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
131155
132156-}
133−signedInt : Deconstructor Int
157+int : Deconstructor (Int -> a) a
158+int =
159+ Deconstructor
160+ (\x f ->
161+ case x of
162+ Atom bs ->
163+ (case Bytes.width bs of
164+ 1 ->
165+ BD.decode BD.unsignedInt8 bs
166+
167+ 2 ->
168+ BD.decode (BD.unsignedInt16 LE) bs
169+
170+ 3 ->
171+ BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
172+
173+ 4 ->
174+ BD.decode (BD.unsignedInt32 LE) bs
175+
176+ _ ->
177+ Nothing
178+ )
179+ |> Maybe.map f
180+
181+ Cell _ ->
182+ Nothing
183+ )
184+
185+
186+{-| Extracts a `BigInt` at the current location.
187+-}
188+bigint : Deconstructor (BigInt -> a) a
189+bigint =
190+ Deconstructor
191+ (\x f ->
192+ case x of
193+ Atom bs ->
194+ BigInt.Bytes.decode bs |> f |> Just
195+
196+ Cell _ ->
197+ Nothing
198+ )
199+
200+
201+{-| Extracts a 32-bit signed `Int` at the given location.
202+
203+If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
204+
205+-}
206+signedInt : Deconstructor (Int -> a) a
134207signedInt =
135208 int
136− |> map
209+ |> fmap
137210 (\i ->
138211 if Bitwise.and 1 i == 1 then
139212 -(Bitwise.shiftRightBy 1 (1 + i))
@@ -143,85 +216,105 @@ signedInt =
143216 )
144217
145218
146−{-| Extracts a 32-bit `Float`.
219+{-| Extracts a 32-bit `Float` at the given location.
147220-}
148−float32 : Deconstructor Float
149−float32 x =
150− case x of
151− Atom bs ->
152− BD.decode (BD.float32 LE) bs
153−
154− Cell _ ->
155− Nothing
221+float32 : Deconstructor (Float -> a) a
222+float32 =
223+ Deconstructor
224+ (\x f ->
225+ case x of
226+ Atom bs ->
227+ BD.decode (BD.float32 LE) bs
228+ |> Maybe.map f
229+
230+ Cell _ ->
231+ Nothing
232+ )
156233
157234
158−{-| Extracts a 64-bit `Float`.
235+{-| Extracts a 64-bit `Float` at the given location.
159236-}
160−float64 : Deconstructor Float
161−float64 x =
162− case x of
163− Atom bs ->
164− BD.decode (BD.float64 LE) bs
165−
166− Cell _ ->
167− Nothing
237+float64 : Deconstructor (Float -> a) a
238+float64 =
239+ Deconstructor
240+ (\x f ->
241+ case x of
242+ Atom bs ->
243+ BD.decode (BD.float64 LE) bs
244+ |> Maybe.map f
245+
246+ Cell _ ->
247+ Nothing
248+ )
168249
169250
170−{-| Extracts the raw `Byte`s of an `Atom`.
251+{-| Extracts the raw `Byte`s of an `Atom` at the current location.
171252-}
172−bytes : Deconstructor Bytes
173−bytes n =
174− case n of
175− Atom bs ->
176− Just bs
253+bytes : Deconstructor (Bytes -> a) a
254+bytes =
255+ Deconstructor
256+ (\n f ->
257+ case n of
258+ Atom bs ->
259+ f bs |> Just
177260
178− Cell _ ->
179− Nothing
261+ Cell _ ->
262+ Nothing
263+ )
180264
181265
182−{-| Asserts the the `Atom` should be exactly `sig` (`~`).
266+{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).
183267-}
184−sig : Deconstructor ()
185−sig n =
186− case n of
187− Atom b ->
188− if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
189− Just ()
268+sig : Deconstructor a a
269+sig =
270+ Deconstructor
271+ (\n a ->
272+ case n of
273+ Atom b ->
274+ if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
275+ Just a
190276
191− else
192− Nothing
277+ else
278+ Nothing
193279
194− Cell _ ->
195− Nothing
280+ Cell _ ->
281+ Nothing
282+ )
196283
197284
198−{-| Extracts a sig-terminated list of arbitrary elements.
285+{-| Extracts a sig-terminated list of arbitrary elements at the current position.
199286
200287The first argument is a `Deconstructor` of the elements of the list.
201288
202289-}
203−list : Deconstructor a -> Deconstructor (List a)
204−list f n =
205− let
206− go n_ =
207− case n_ of
208− Atom _ ->
209− Just []
290+list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
291+list (Deconstructor f) =
292+ Deconstructor
293+ (\n g ->
294+ let
295+ go n_ =
296+ case n_ of
297+ Atom _ ->
298+ Just []
210299
211− Cell ( el, tail ) ->
212− Maybe.map2 (\a b -> a :: b) (f el) (go tail)
213− in
214− go n
300+ Cell ( el, tail ) ->
301+ Maybe.map2 (\a b -> a :: b) (f el identity) (go tail)
302+ in
303+ go n |> Maybe.map g
304+ )
215305
216306
217−alt : Deconstructor a -> Deconstructor a -> Deconstructor a
218−alt f g n =
219− case f n of
220− Just x ->
221− Just x
307+alt : Deconstructor a b -> Deconstructor a b -> Deconstructor a b
308+alt (Deconstructor f) (Deconstructor g) =
309+ Deconstructor
310+ (\n a ->
311+ case f n a of
312+ Just x ->
313+ Just x
222314
223− Nothing ->
224− g n
315+ Nothing ->
316+ g n a
317+ )
225318
226319
227320{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
@@ -229,150 +322,75 @@ alt f g n =
229322This is especially useful for deconstructing head-tagged unions from Hoon.
230323
231324-}
232−oneOf : List (Deconstructor a) -> Deconstructor a
325+oneOf : List (Deconstructor a b) -> Deconstructor a b
233326oneOf l =
234327 case l of
235328 [] ->
236− always Nothing
329+ Deconstructor (\_ _ -> Nothing)
237330
238331 x :: xs ->
239332 alt x (oneOf xs)
240333
241334
242−{-| Ignore any value.
243−
244−This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
245−
246−-}
247−ignore : Deconstructor ()
248−ignore =
249− always (Just ())
250−
251−
252−{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
253−
254−Accepts two arbitrary `Deconstructor`s that form a Cell.
255−
256−-}
257−cell : Deconstructor a -> Deconstructor b -> Deconstructor ( a, b )
258−cell l r noun =
259− case noun of
260− Cell ( lhs, rhs ) ->
261− l lhs |> Maybe.andThen (\a -> r rhs |> Maybe.map (\b -> ( a, b )))
262−
263− Atom _ ->
264− Nothing
265−
266−
267−{-| Maps (applies) a function to all of the values deconstructed.
268−
269−This is useful when you want to create a data type with extracted values as fields.
270−
271−-}
272−lazy : (() -> Deconstructor a) -> Deconstructor a
273−lazy f noun =
274− f () noun
335+{-| Extract the raw `Noun` at the current position.
275336
337+Always succeeds.
276338
277−{-| Maps over the result of the deconstructor.
278339-}
279−map : (a -> b) -> Deconstructor a -> Deconstructor b
280−map g f noun =
281− f noun |> Maybe.map g
340+tar : Deconstructor (Noun -> a) a
341+tar =
342+ Deconstructor (\noun f -> Just (f noun))
282343
283344
284−{-| Extracts a `cord`.
285−-}
286−cord : Deconstructor String
287−cord x =
288− case x of
289− Atom bs ->
290− BD.decode (BD.string (Bytes.width bs)) bs
291−
292− Cell _ ->
293− Nothing
345+{-| Ignore any value at the current position.
294346
347+This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
295348
296−{-| Extracts a `tape`.
297349-}
298−tape : Deconstructor String
299−tape =
300− list cord |> map String.concat
350+ignore : Deconstructor a a
351+ignore =
352+ Deconstructor (\_ f -> Just f)
301353
302354
303−{-| Extracts a 32-bit unsigned `Int`.
355+{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
304356
305−If the `Atom` is larger than 32 bits the the behaviour is undefined.
357+Accepts two arbitrary `Deconstructor`s that form a Cell.
306358
307359-}
308−int : Deconstructor Int
309−int x =
310− case x of
311− Atom bs ->
312− case Bytes.width bs of
313− 1 ->
314− BD.decode BD.unsignedInt8 bs
315−
316− 2 ->
317− BD.decode (BD.unsignedInt16 LE) bs
318−
319− 3 ->
320− BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
321−
322− 4 ->
323− BD.decode (BD.unsignedInt32 LE) bs
360+cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
361+cell (Deconstructor l) (Deconstructor r) =
362+ Deconstructor
363+ (\noun a ->
364+ case noun of
365+ Cell ( lhs, rhs ) ->
366+ l lhs a |> Maybe.andThen (\b -> r rhs b)
324367
325− _ ->
368+ Atom _ ->
326369 Nothing
327−
328− Cell _ ->
329− Nothing
370+ )
330371
331372
332−{-| Extract the raw `Noun`.
373+{-| -}
374+lazy : (() -> Deconstructor a b) -> Deconstructor a b
375+lazy f =
376+ Deconstructor
377+ (\noun a ->
378+ case f () of
379+ Deconstructor g ->
380+ g noun a
381+ )
333382
334−Always succeeds.
335383
336−-}
337−tar : Deconstructor Noun
338−tar =
339− Just
384+{-| Maps (applies) a function to all of the values deconstructed.
340385
386+This is useful when you want to create a data type with extracted values as fields.
341387
342−{-| Debug a deconstructor.
343−If the deconstructor from the second argument fails then the failed nock will be printed to the console.
344388-}
345−debug : (String -> String) -> Deconstructor a -> Deconstructor a
346−debug log f noun =
347− case f noun of
348− Just x ->
349− Just x
389+map : a -> Deconstructor a b -> Deconstructor (b -> c) c
390+map a (Deconstructor f) =
391+ Deconstructor (\noun g -> f noun a |> Maybe.map g)
350392
351− Nothing ->
352− let
353− _ =
354− log (prettyNoun noun)
355− in
356− Nothing
357−
358−
359−prettyNoun : Noun -> String
360−prettyNoun noun =
361− let
362− go isRhs n =
363− case n of
364− Atom a ->
365− if isSig a then
366− "~"
367393
368− else
369− "@"
370−
371− Cell ( lhs, rhs ) ->
372− if isRhs then
373− go False lhs ++ " " ++ go True rhs
374−
375− else
376− "[" ++ go False lhs ++ " " ++ go True rhs ++ "]"
377− in
378− go False noun
394+fmap : (a -> b) -> Deconstructor (a -> c) c -> Deconstructor (b -> c) c
395+fmap f (Deconstructor g) =
396+ Deconstructor (\noun h -> g noun (f >> h))