git.iko.soy/airlock
on master help sign in
Added noun construction (#3)
89f0999iko
src/Urbit/Constructor.elmnew file+93
compare with master
unifiedsplit
@@ -0,0 +1,93 @@
1+module Urbit.Constructor exposing
2+ ( Constructor
3+ , cell
4+ , cord
5+ , float32
6+ , float64
7+ , int
8+ , listOf
9+ , sig
10+ , signedInt
11+ , tape
12+ )
13+
14+import Bitwise
15+import Bytes exposing (Bytes, Endianness(..))
16+import Bytes.Encode as BE
17+import Urbit exposing (..)
18+
19+
20+type alias Constructor a =
21+ a -> Noun
22+
23+
24+cell : Noun -> Noun -> Noun
25+cell a b =
26+ Cell ( a, b )
27+
28+
29+int : Int -> Noun
30+int i =
31+ Atom
32+ (BE.encode
33+ (if i <= 255 then
34+ BE.unsignedInt8 i
35+
36+ else if i <= 65535 then
37+ BE.unsignedInt16 LE i
38+
39+ else
40+ BE.unsignedInt32 LE i
41+ )
42+ )
43+
44+
45+signedInt : Int -> Noun
46+signedInt i =
47+ int
48+ (if i < 0 then
49+ negate (Bitwise.shiftLeftBy 1 i) - 1
50+
51+ else
52+ Bitwise.shiftLeftBy 1 i
53+ )
54+
55+
56+bytes : Bytes -> Noun
57+bytes =
58+ Atom
59+
60+
61+cord : String -> Noun
62+cord s =
63+ Atom (BE.encode (BE.string s))
64+
65+
66+tape : String -> Noun
67+tape s =
68+ String.toList s |> List.map String.fromChar |> listOf cord
69+
70+
71+listOf : (a -> Noun) -> List a -> Noun
72+listOf encEl list =
73+ case list of
74+ [] ->
75+ sig
76+
77+ x :: xs ->
78+ cell (encEl x) (listOf encEl xs)
79+
80+
81+sig : Noun
82+sig =
83+ Atom (BE.encode (BE.sequence []))
84+
85+
86+float32 : Float -> Noun
87+float32 f =
88+ Atom (BE.encode (BE.float32 LE f))
89+
90+
91+float64 : Float -> Noun
92+float64 f =
93+ Atom (BE.encode (BE.float64 LE f))
src/Urbit/Deconstructor.elm+18−6
@@ -23,6 +23,7 @@ module Urbit.Deconstructor exposing
23import Bitwise
23import Bitwise
24import Bytes exposing (Bytes, Endianness(..))
24import Bytes exposing (Bytes, Endianness(..))
25import Bytes.Decode as BD
25import Bytes.Decode as BD
26+import Bytes.Encode as BE
26import Bytes.Extra
27import Bytes.Extra
27import Urbit exposing (..)
28import Urbit exposing (..)
28
29
@@ -85,12 +86,23 @@ int =
85 (\x f ->
86 (\x f ->
86 case x of
87 case x of
87 Atom bs ->
88 Atom bs ->
88− Bytes.Extra.toByteValues bs
89+ (case Bytes.width bs of
89− |> List.foldr
90+ 1 ->
90− (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
91+ BD.decode BD.unsignedInt8 bs
91− 0
92+
92− |> f
93+ 2 ->
93− |> Just
94+ BD.decode (BD.unsignedInt16 LE) bs
95+
96+ 3 ->
97+ BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
98+
99+ 4 ->
100+ BD.decode (BD.unsignedInt32 LE) bs
101+
102+ _ ->
103+ Nothing
104+ )
105+ |> Maybe.map f
94
106
95 Cell _ ->
107 Cell _ ->
96 Nothing
108 Nothing
tests/Test/Urbit.elm+55
@@ -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.Constructor as C
13import Urbit.Deconstructor as D
14import Urbit.Deconstructor as D
14
15
15
16
@@ -148,6 +149,60 @@ tests =
148 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
149 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
149 )
150 )
150 )
151 )
152+ , test "65.600"
153+ (\() ->
154+ Expect.equal
155+ (Just 65600)
156+ (D.runBytes
157+ D.int
158+ (Bytes.fromByteValues [ 0xC0, 0x00, 0x02, 0x08 ])
159+ )
160+ )
161+ ]
162+ , describe "Constructor <-> Deconstructor"
163+ [ Test.fuzz
164+ (Fuzz.triple Fuzz.niceFloat Fuzz.int (Fuzz.intAtLeast 0))
165+ "[@rd @s @u]"
166+ (\( f, i, ui ) ->
167+ Expect.equal (Just ( f, i, ui ))
168+ (D.run
169+ (D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\a b c -> ( a, b, c )))
170+ (C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
171+ )
172+ )
173+ , Test.fuzz
174+ (Fuzz.list Fuzz.int)
175+ "~[@s]"
176+ (\x ->
177+ Expect.equal
178+ (Just x)
179+ (D.run
180+ (D.list D.signedInt)
181+ (C.listOf C.signedInt x)
182+ )
183+ )
184+ , Test.fuzz
185+ Fuzz.string
186+ "cord"
187+ (\x ->
188+ Expect.equal
189+ (Just x)
190+ (D.run
191+ D.cord
192+ (C.cord x)
193+ )
194+ )
195+ , Test.fuzz
196+ Fuzz.string
197+ "tape"
198+ (\x ->
199+ Expect.equal
200+ (Just x)
201+ (D.run
202+ D.tape
203+ (C.tape x)
204+ )
205+ )
151 ]
206 ]
152 ]
207 ]
153
208