@@ -0,0 +1,194 @@
1+module Urbit.Deconstructor exposing
2+ ( Deconstructor
3+ , alt
4+ , cell
5+ , float32
6+ , float64
7+ , int
8+ , list
9+ , llec
10+ , map
11+ , run
12+ , runBytes
13+ , sig
14+ , string
15+ , tar
16+ )
17+
18+import Bitwise
19+import Bytes exposing (Bytes, Endianness(..))
20+import Bytes.Decode as BD
21+import Bytes.Extra
22+import Urbit exposing (..)
23+
24+
25+type Deconstructor a b
26+ = Deconstructor (Noun -> a -> Maybe b)
27+
28+
29+run : Deconstructor (a -> a) a -> Noun -> Maybe a
30+run (Deconstructor f) noun =
31+ f noun identity
32+
33+
34+runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
35+runBytes (Deconstructor f) bs =
36+ cue bs
37+ |> Maybe.andThen
38+ (\noun -> f noun identity)
39+
40+
41+string : Deconstructor (String -> a) a
42+string =
43+ Deconstructor
44+ (\x f ->
45+ case x of
46+ Atom bs ->
47+ BD.decode (BD.string (Bytes.width bs)) bs
48+ |> Maybe.map f
49+
50+ Cell _ ->
51+ Nothing
52+ )
53+
54+
55+int : Deconstructor (Int -> a) a
56+int =
57+ Deconstructor
58+ (\x f ->
59+ case x of
60+ Atom bs ->
61+ Bytes.Extra.toByteValues bs
62+ |> List.foldr
63+ (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
64+ 0
65+ |> f
66+ |> Just
67+
68+ Cell _ ->
69+ Nothing
70+ )
71+
72+
73+float32 : Deconstructor (Float -> a) a
74+float32 =
75+ Deconstructor
76+ (\x f ->
77+ case x of
78+ Atom bs ->
79+ BD.decode (BD.float32 LE) bs
80+ |> Maybe.map f
81+
82+ Cell _ ->
83+ Nothing
84+ )
85+
86+
87+float64 : Deconstructor (Float -> a) a
88+float64 =
89+ Deconstructor
90+ (\x f ->
91+ case x of
92+ Atom bs ->
93+ BD.decode (BD.float64 LE) bs
94+ |> Maybe.map f
95+
96+ Cell _ ->
97+ Nothing
98+ )
99+
100+
101+bytes : Deconstructor (Bytes -> a) a
102+bytes =
103+ Deconstructor
104+ (\n f ->
105+ case n of
106+ Atom bs ->
107+ f bs |> Just
108+
109+ Cell _ ->
110+ Nothing
111+ )
112+
113+
114+sig : Deconstructor a a
115+sig =
116+ Deconstructor
117+ (\n a ->
118+ case n of
119+ Atom b ->
120+ if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
121+ Just a
122+
123+ else
124+ Nothing
125+
126+ Cell _ ->
127+ Nothing
128+ )
129+
130+
131+list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
132+list (Deconstructor f) =
133+ Deconstructor
134+ (\n g ->
135+ let
136+ go n_ =
137+ case n_ of
138+ Atom _ ->
139+ Just []
140+
141+ Cell ( el, tail ) ->
142+ Maybe.map2 (\a b -> a :: b) (f el identity) (go tail)
143+ in
144+ go n |> Maybe.map g
145+ )
146+
147+
148+alt : Deconstructor a b -> Deconstructor a b -> Deconstructor a b
149+alt (Deconstructor f) (Deconstructor g) =
150+ Deconstructor
151+ (\n a ->
152+ case f n a of
153+ Just x ->
154+ Just x
155+
156+ Nothing ->
157+ g n a
158+ )
159+
160+
161+tar : Deconstructor a a
162+tar =
163+ Deconstructor (\_ a -> Just a)
164+
165+
166+llec : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
167+llec (Deconstructor r) (Deconstructor l) =
168+ Deconstructor
169+ (\noun a ->
170+ case noun of
171+ Cell ( lhs, rhs ) ->
172+ r rhs a |> Maybe.andThen (\b -> l lhs b)
173+
174+ Atom _ ->
175+ Nothing
176+ )
177+
178+
179+cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
180+cell (Deconstructor l) (Deconstructor r) =
181+ Deconstructor
182+ (\noun a ->
183+ case noun of
184+ Cell ( lhs, rhs ) ->
185+ l lhs a |> Maybe.andThen (\b -> r rhs b)
186+
187+ Atom _ ->
188+ Nothing
189+ )
190+
191+
192+map : a -> Deconstructor a b -> Deconstructor (b -> c) c
193+map a (Deconstructor f) =
194+ Deconstructor (\noun g -> f noun a |> Maybe.map g)