@@ -6,24 +6,16 @@ module Ur.Deconstructor exposing
66 , int, signedInt, bigint
77 , float32, float64
88 , cord, tape
9− , bytes, sig, ignore, tar, lazy
9+ , bytes, sig, ignore, tar, lazy, debug
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−
1614You would parse a `[%edit @ cord]` like this:
1715
1816 type alias Edit = {id: Int, text : String}
1917
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`.
18+ (D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord)) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
2719
2820@docs Deconstructor
2921
@@ -63,7 +55,7 @@ that "capture" a value: `D.int` and `D.cord`.
6355
6456# Miscellaneous
6557
66−@docs bytes, sig, ignore, tar, lazy
58+@docs bytes, sig, ignore, tar, lazy, debug
6759
6860-}
6961
@@ -74,33 +66,31 @@ import Bytes exposing (Bytes, Endianness(..))
7466import Bytes.Decode as BD
7567import Bytes.Encode as BE
7668import Bytes.Extra
77−import Ur.Jam exposing (cue)
69+import Ur.Jam exposing (cue, isSig)
7870import Ur.Types exposing (..)
7971
8072
8173{-| A `Noun` deconstructor.
8274-}
83−type Deconstructor a b
84− = Deconstructor (Noun -> a -> Maybe b)
75+type alias Deconstructor a =
76+ Noun -> Maybe a
8577
8678
8779{-| Executes a `Deconstructor` on a `Noun`.
8880-}
89−run : Deconstructor (a -> a) a -> Noun -> Maybe a
90−run (Deconstructor f) noun =
91− f noun identity
81+run : Deconstructor a -> Noun -> Maybe a
82+run f noun =
83+ f noun
9284
9385
9486{-| Executes a deconstructor on a `jam`med `Noun`.
9587-}
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)
88+runBytes : Deconstructor a -> Bytes -> Maybe a
89+runBytes f bs =
90+ cue bs |> Maybe.andThen f
10191
10292
103−{-| Asserts that the value at the current position should be exactly equal to the second argument.
93+{-| Asserts that the value should be exactly equal to the second argument.
10494
10595The first argument is a `Deconstructor` for the given type.
10696
@@ -109,104 +99,41 @@ The second argument is the value to compare with.
10999This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
110100
111101-}
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
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 ()
120108
121− else
122− Nothing
109+ else
110+ Nothing
123111
124− Nothing ->
125− Nothing
126− )
112+ Nothing ->
113+ Nothing
127114
128115
129−{-| Extracts a `cord` at the current location.
116+{-| Extracts a `BigInt`.
130117-}
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− )
118+bigint : Deconstructor BigInt
119+bigint x =
120+ case x of
121+ Atom bs ->
122+ BigInt.Bytes.decode bs |> Just
143123
144−
145−{-| Extracts a `tape` at the current location.
146−-}
147−tape : Deconstructor (String -> a) a
148−tape =
149− list cord |> fmap String.concat
124+ Cell _ ->
125+ Nothing
150126
151127
152−{-| Extracts a 32-bit unsigned `Int` at the given location.
128+{-| Extracts a 32-bit signed `Int`.
153129
154−If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
130+If the `Atom` is larger than 32 bits the the behaviour is undefined.
155131
156132-}
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
133+signedInt : Deconstructor Int
207134signedInt =
208135 int
209− |> fmap
136+ |> map
210137 (\i ->
211138 if Bitwise.and 1 i == 1 then
212139 -(Bitwise.shiftRightBy 1 (1 + i))
@@ -216,105 +143,85 @@ signedInt =
216143 )
217144
218145
219−{-| Extracts a 32-bit `Float` at the given location.
146+{-| Extracts a 32-bit `Float`.
220147-}
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− )
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
233156
234157
235−{-| Extracts a 64-bit `Float` at the given location.
158+{-| Extracts a 64-bit `Float`.
236159-}
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− )
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
249168
250169
251−{-| Extracts the raw `Byte`s of an `Atom` at the current location.
170+{-| Extracts the raw `Byte`s of an `Atom`.
252171-}
253−bytes : Deconstructor (Bytes -> a) a
254−bytes =
255− Deconstructor
256− (\n f ->
257− case n of
258− Atom bs ->
259− f bs |> Just
172+bytes : Deconstructor Bytes
173+bytes n =
174+ case n of
175+ Atom bs ->
176+ Just bs
260177
261− Cell _ ->
262− Nothing
263− )
178+ Cell _ ->
179+ Nothing
264180
265181
266−{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).
182+{-| Asserts the the `Atom` should be exactly `sig` (`~`).
267183-}
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
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 ()
276190
277− else
278− Nothing
191+ else
192+ Nothing
279193
280− Cell _ ->
281− Nothing
282− )
194+ Cell _ ->
195+ Nothing
283196
284197
285−{-| Extracts a sig-terminated list of arbitrary elements at the current position.
198+{-| Extracts a sig-terminated list of arbitrary elements.
286199
287200The first argument is a `Deconstructor` of the elements of the list.
288201
289202-}
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 []
203+list : Deconstructor a -> Deconstructor (List a)
204+list f n =
205+ let
206+ go n_ =
207+ case n_ of
208+ Atom _ ->
209+ Just []
299210
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− )
211+ Cell ( el, tail ) ->
212+ Maybe.map2 (\a b -> a :: b) (f el) (go tail)
213+ in
214+ go n
305215
306216
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
217+alt : Deconstructor a -> Deconstructor a -> Deconstructor a
218+alt f g n =
219+ case f n of
220+ Just x ->
221+ Just x
314222
315− Nothing ->
316− g n a
317− )
223+ Nothing ->
224+ g n
318225
319226
320227{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
@@ -322,77 +229,150 @@ alt (Deconstructor f) (Deconstructor g) =
322229This is especially useful for deconstructing head-tagged unions from Hoon.
323230
324231-}
325−oneOf : List (Deconstructor a b) -> Deconstructor a b
232+oneOf : List (Deconstructor a) -> Deconstructor a
326233oneOf l =
327234 case l of
328235 [] ->
329− Deconstructor (\_ _ -> Nothing)
236+ always Nothing
330237
331238 x :: xs ->
332239 alt x (oneOf xs)
333240
334241
335−{-| Extract the raw `Noun` at the current position.
242+{-| Ignore any value.
336243
337−Always succeeds.
244+This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
338245
339246-}
340−tar : Deconstructor (Noun -> a) a
341−tar =
342− Deconstructor (\noun f -> Just (f noun))
247+ignore : Deconstructor ()
248+ignore =
249+ always (Just ())
343250
344251
345−{-| Ignore any value at the current position.
252+{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
346253
347−This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
254+Accepts two arbitrary `Deconstructor`s that form a Cell.
348255
349256-}
350−ignore : Deconstructor a a
351−ignore =
352− Deconstructor (\_ f -> Just f)
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 )))
353262
263+ Atom _ ->
264+ Nothing
354265
355−{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
356266
357−Accepts two arbitrary `Deconstructor`s that form a Cell.
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.
358270
359271-}
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)
272+lazy : (() -> Deconstructor a) -> Deconstructor a
273+lazy f noun =
274+ f () noun
367275
368− Atom _ ->
369− Nothing
370− )
276+
277+{-| Maps over the result of the deconstructor.
278+-}
279+map : (a -> b) -> Deconstructor a -> Deconstructor b
280+map g f noun =
281+ f noun |> Maybe.map g
371282
372283
373−{-| "Lazily" applies a deconstructor.
374−This is useful when you are defining a recursive `Deconstructor` which needs to call itself.
284+{-| Extracts a `cord`.
375285-}
376−lazy : (() -> Deconstructor a b) -> Deconstructor a b
377−lazy f =
378− Deconstructor
379− (\noun a ->
380− case f () of
381− Deconstructor g ->
382− g noun a
383− )
286+cord : Deconstructor String
287+cord x =
288+ case x of
289+ Atom bs ->
290+ BD.decode (BD.string (Bytes.width bs)) bs
384291
292+ Cell _ ->
293+ Nothing
385294
386−{-| Maps (applies) a function to all of the values deconstructed.
387295
388−This is useful when you want to create a data type with extracted values as fields.
296+{-| Extracts a `tape`.
297+-}
298+tape : Deconstructor String
299+tape =
300+ list cord |> map String.concat
301+
302+
303+{-| Extracts a 32-bit unsigned `Int`.
304+
305+If the `Atom` is larger than 32 bits the the behaviour is undefined.
389306
390307-}
391−map : a -> Deconstructor a b -> Deconstructor (b -> c) c
392−map a (Deconstructor f) =
393− Deconstructor (\noun g -> f noun a |> Maybe.map g)
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
324+
325+ _ ->
326+ Nothing
327+
328+ Cell _ ->
329+ Nothing
394330
395331
396−fmap : (a -> b) -> Deconstructor (a -> c) c -> Deconstructor (b -> c) c
397−fmap f (Deconstructor g) =
398− Deconstructor (\noun h -> g noun (f >> h))
332+{-| Extract the raw `Noun`.
333+
334+Always succeeds.
335+
336+-}
337+tar : Deconstructor Noun
338+tar =
339+ Just
340+
341+
342+{-| Debug a deconstructor.
343+If the deconstructor from the second argument fails then the failed nock will be printed to the console.
344+-}
345+debug : (String -> String) -> Deconstructor a -> Deconstructor a
346+debug log f noun =
347+ case f noun of
348+ Just x ->
349+ Just x
350+
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+ "~"
367+
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