git.iko.soy/airlock
on master help sign in
wip
672e348iko
src/Urbit/Deconstructor.elmnew file+194
compare with master
unifiedsplit
@@ -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)
tests/Test/Urbit.elm+30
@@ -10,6 +10,7 @@ import List.Extra as List
10import Test exposing (..)
10import Test exposing (..)
11import Test.Utils exposing (..)
11import Test.Utils exposing (..)
12import Urbit exposing (..)
12import Urbit exposing (..)
13+import Urbit.Deconstructor as D
13
14
14
15
15tests : Test
16tests : Test
@@ -64,6 +65,35 @@ tests =
64 )
65 )
65 )
66 )
66 ]
67 ]
68+ , describe "Decon"
69+ [ test "[1 2]"
70+ (\() ->
71+ Expect.equal
72+ (Just ( 1, 2 ))
73+ (D.runBytes
74+ (D.cell D.int D.int |> D.map Tuple.pair)
75+ (Bytes.fromByteValues [ 0x31, 0x12 ])
76+ )
77+ )
78+ , test "[4 ~[1 2 3]]"
79+ (\() ->
80+ Expect.equal
81+ (Just ( 4, [ 1, 2, 3 ] ))
82+ (D.runBytes
83+ (D.cell D.int (D.list D.int) |> D.map Tuple.pair)
84+ (Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
85+ )
86+ )
87+ , test "[.8 .11]"
88+ (\() ->
89+ Expect.equal
90+ (Just ( 8, 11 ))
91+ (D.runBytes
92+ (D.cell D.float32 D.float32 |> D.map Tuple.pair)
93+ (Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
94+ )
95+ )
96+ ]
67 ]
97 ]
68
98
69
99