git.iko.soy/airlock
on master help sign in
Added proper docs
commit3d83802d2ba1744d4f7ff496714cae6ff579fe6d authoriko <mail@iko.soy> dateSun 18 Jun 2023, 11:44 (3 years ago) parent9bf0a78
15 files changed+598−346
compare with master
unifiedsplit
elm.json+1−1 src/Ur.elm+66−209 src/Ur/Cmd.elm+14−10 src/Ur/Cmd/Internal.elm+1−2 src/Ur/Constructor.elm+65−16 src/Ur/Da.elm+10 src/Ur/Deconstructor.elm+133−31 src/Ur/Jam.elm+193 src/Ur/Phonemic.elm+9−12 src/Ur/Requests.elm+6−52 src/Ur/Run.elm+20−10 src/Ur/Sub.elm+11−1 src/Ur/Sub/Internal.elm+1−2 src/Ur/Types.elm+60 src/Ur/Uw.elm+8
elm.json+1−1
@@ -5,7 +5,7 @@
55 "license": "MIT",
66 "version": "1.0.0",
77 "exposed-modules": [
8− "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run"
8+ "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run", "Ur.Types"
99 ],
1010 "elm-version": "0.19.0 <= v < 0.20.0",
1111 "dependencies": {
src/Ur.elm+66−209
@@ -1,43 +1,26 @@
1−module Ur exposing
2− ( Agent
3− , Atom
4− , Mark
5− , Noun(..)
6− , Path
7− , cue
8− , getShipName
9− , jam
10− , logIn
11− , mat
12− , rub
13− )
14−
15−import BitParser as BP exposing (BitParser)
16−import BitWriter as BW exposing (BitWriter)
17−import Bitwise
18−import Bytes exposing (Bytes)
19−import Bytes.Extra as Bytes
20−import Dict exposing (Dict)
21−import Http
22−import List.Extra as List
1+module Ur exposing (logIn, getShipName, scry, scryTask)
232
3+{-|
244
25−{-| An Urbit agent (app) name like `journal` or 'groups'.
26−-}
27−type alias Agent =
28− String
295
6+# Simple requests
7+
8+@docs logIn, getShipName, scry, scryTask
309
31−{-| An Urbit subscription path.
3210-}
33−type alias Path =
34− List String
3511
12+import Http
13+import Platform exposing (Task)
14+import Task
15+import Ur.Deconstructor as D
16+import Ur.Types exposing (..)
3617
37−type alias Mark =
38− String
3918
19+{-| Logs into your Urbit at the given root path and password.
4020
21+ logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
22+
23+-}
4124logIn : String -> String -> Cmd (Result Http.Error ())
4225logIn root password =
4326 Http.riskyRequest
@@ -54,7 +37,13 @@ logIn root password =
5437 }
5538
5639
57−getShipName : String -> Cmd (Result Http.Error String)
40+{-| Queries the name of the current ship.
41+Return strings like `~zod` or `~racfer-hattes`.
42+
43+ getShipName "http://localhost:8080"
44+
45+-}
46+getShipName : String -> Cmd (Result Http.Error Ship)
5847getShipName root =
5948 Http.riskyRequest
6049 { url = root ++ "/~/name"
@@ -67,180 +56,48 @@ getShipName root =
6756 }
6857
6958
70−type Noun
71− = Cell ( Noun, Noun )
72− | Atom Atom
73−
74−
75−type alias Atom =
76− Bytes
77−
78−
79−jam : Noun -> Bytes
80−jam n =
81− BW.run (jamWriter n BW.empty)
82−
83−
84−
85−-- Does not use references because it is complex to implement in Elm and would probably lead
86−-- to poor performance
87−
88−
89−jamWriter : Noun -> BitWriter -> BitWriter
90−jamWriter noun writer =
91− case noun of
92− Atom atom ->
93− writer
94− |> BW.bit 0
95− |> mat atom
96−
97− Cell ( a, b ) ->
98− writer
99− |> BW.bit 1
100− |> BW.bit 0
101− |> jamWriter a
102− |> jamWriter b
103−
104−
105−cue : Bytes -> Maybe Noun
106−cue =
107− BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second
108−
109−
110−cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )
111−cueParser refs =
112− BP.getOffset
113− |> BP.andThen
114− (\offset ->
115− BP.bit
116− |> BP.andThen
117− (\isAtom ->
118− if isAtom == 0 then
119− rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))
120−
121− else
122− BP.bit
123− |> BP.andThen
124− (\isRef ->
125− if isRef == 0 then
126− cueParser refs
127− |> BP.andThen
128− (\( refs_, a ) ->
129− cueParser refs_
130− |> BP.andThen
131− (\( refs__, b ) ->
132− let
133− c =
134− Cell ( a, b )
135− in
136− ( Dict.insert offset c refs__, c )
137− |> BP.succeed
138− )
139− )
140−
141− else
142− rub
143− |> BP.andThen
144− (\ref ->
145− case
146− Dict.get
147− (Bytes.toByteValues ref
148− |> List.foldr
149− (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
150− 0
151− )
152− refs
153− of
154− Just n ->
155− BP.succeed ( refs, n )
156−
157− _ ->
158− BP.fail
159− )
160− )
161− )
162− )
163−
164−
165−isSig : Bytes -> Bool
166−isSig bytes =
167− Bytes.toByteValues bytes |> List.all (\x -> x == 0)
168−
169−
170−mat : Bytes -> BitWriter -> BitWriter
171−mat bytes writer =
172− if isSig bytes then
173− writer |> BW.bit 1
174−
175− else
176− let
177− bits =
178− bytesToBits bytes |> List.dropWhileRight (\x -> x == 0)
179−
180− lengthBits =
181− bits |> List.length |> intToBits |> List.reverse |> List.drop 1 |> List.reverse
182− in
183− writer
184− |> BW.bit 0
185− |> BW.bits (List.repeat (List.length lengthBits) 0)
186− |> BW.bit 1
187− |> BW.bits lengthBits
188− |> BW.bits bits
189−
190−
191−rub : BitParser Bytes
192−rub =
193− BP.bit
194− |> BP.andThen
195− (\zeroBit ->
196− if zeroBit == 1 then
197− BP.succeed Bytes.empty
198−
199− else
200− let
201− countZeros n =
202− BP.bit
203− |> BP.andThen
204− (\b ->
205− if b == 0 then
206− countZeros (n + 1)
207−
208− else
209− BP.succeed n
210− )
211− in
212− countZeros 0
213− |> BP.andThen
214− (\lengthOfLength ->
215− BP.rawBits lengthOfLength
216− |> BP.andThen
217− (\preLengthRawBits ->
218− let
219− length =
220− BP.bitsToInt (preLengthRawBits ++ [ 1 ])
221− in
222− BP.bits length
223− )
224− )
225− )
226−
227−
228−bytesToBits : Bytes -> List Int
229−bytesToBits bytes =
230− case
231− BP.run (BP.rawBits (Bytes.width bytes * 8)) bytes
232− of
233− Nothing ->
234− []
235−
236− Just bits ->
237− bits
238−
239−
240−intToBits : Int -> List Int
241−intToBits n =
242− if n <= 0 then
243− []
244−
245− else
246− Bitwise.and 1 n :: intToBits (Bitwise.shiftRightBy 1 n)
59+{-| -}
60+scry :
61+ { url : String
62+ , agent : Agent
63+ , path : Path
64+ , error : msg
65+ , success : D.Deconstructor (msg -> msg) msg
66+ }
67+ -> Cmd msg
68+scry args =
69+ scryTask args |> Task.perform identity
70+
71+
72+{-| -}
73+scryTask :
74+ { url : String
75+ , agent : Agent
76+ , path : Path
77+ , error : msg
78+ , success : D.Deconstructor (msg -> msg) msg
79+ }
80+ -> Task a msg
81+scryTask { url, agent, path, error, success } =
82+ Http.riskyTask
83+ { method = "GET"
84+ , headers = []
85+ , url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"
86+ , body = Http.emptyBody
87+ , resolver =
88+ Http.bytesResolver
89+ (\resp ->
90+ case resp of
91+ Http.GoodStatus_ _ bytes ->
92+ case D.runBytes success bytes of
93+ Just msg ->
94+ Ok msg
95+
96+ Nothing ->
97+ Ok error
98+
99+ _ ->
100+ Ok error
101+ )
102+ , timeout = Nothing
103+ }
src/Ur/Cmd.elm+14−10
@@ -1,35 +1,39 @@
1−module Ur.Cmd exposing
2− ( Cmd
3− , batch
4− , cmd
5− , none
6− , poke
7− )
8−
9−import Ur exposing (Agent, Mark, Noun)
1+module Ur.Cmd exposing (Cmd, poke, cmd, none, batch)
2+
3+{-| This module is conceptually similar to `Platform.Cmd`, but also allows you to send Urbit requests.
4+
5+@docs Cmd, poke, cmd, none, batch
6+
7+-}
8+
109import Ur.Cmd.Internal
11−import Ur.Phonemic exposing (Ship)
10+import Ur.Types exposing (Agent, Mark, Noun, Ship)
1211
1312
13+{-| -}
1414type alias Cmd msg =
1515 List (Ur.Cmd.Internal.Cmd msg)
1616
1717
18+{-| -}
1819none : Cmd msg
1920none =
2021 []
2122
2223
24+{-| -}
2325poke : { ship : Ship, agent : Agent, mark : Mark, noun : Noun } -> Cmd msg
2426poke p =
2527 [ Ur.Cmd.Internal.Poke p ]
2628
2729
30+{-| -}
2831cmd : Cmd.Cmd msg -> Cmd msg
2932cmd c =
3033 [ Ur.Cmd.Internal.Cmd c ]
3134
3235
36+{-| -}
3337batch : List (Cmd msg) -> Cmd msg
3438batch =
3539 List.concat
src/Ur/Cmd/Internal.elm+1−2
@@ -1,7 +1,6 @@
11module Ur.Cmd.Internal exposing (Cmd(..))
22
3−import Ur exposing (Agent, Mark, Noun)
4−import Ur.Phonemic exposing (Ship)
3+import Ur.Types exposing (Agent, Mark, Noun, Ship)
54
65
76type Cmd msg
src/Ur/Constructor.elm+65−16
@@ -1,35 +1,58 @@
11module Ur.Constructor exposing
2− ( Constructor
3− , bigint
4− , bytes
5− , cell
6− , cord
7− , float32
8− , float64
9− , int
2+ ( cell, sig, bytes
3+ , int, signedInt, bigint
4+ , float32, float64
5+ , cord, tape
106 , listOf
11− , sig
12− , signedInt
13− , tape
147 )
158
9+{-| Different ways of constructing `Noun` from Elm types.
10+
11+
12+# Primitive constructors
13+
14+@docs cell, sig, bytes
15+
16+
17+# Integers
18+
19+@docs int, signedInt, bigint
20+
21+
22+# Floats
23+
24+@docs float32, float64
25+
26+
27+# String
28+
29+@docs cord, tape
30+
31+
32+# Higher-order constructors
33+
34+@docs listOf
35+
36+-}
37+
1638import BigInt exposing (BigInt)
1739import BigInt.Bytes
1840import Bitwise
1941import Bytes exposing (Bytes, Endianness(..))
2042import Bytes.Encode as BE
21−import Ur exposing (..)
22−
23−
24−type alias Constructor a =
25− a -> Noun
43+import Ur.Types exposing (..)
2644
2745
46+{-| Constructs a [Cell](https://developers.urbit.org/reference/glossary/cell) from two Nouns.
47+-}
2848cell : Noun -> Noun -> Noun
2949cell a b =
3050 Cell ( a, b )
3151
3252
53+{-| Constructs an `Atom` from an unsigned 32-bit `Int`.
54+If you pass something other than an unsigned 32-bit integer the behaviour is undefined.
55+-}
3356int : Int -> Noun
3457int i =
3558 Atom
@@ -46,11 +69,15 @@ int i =
4669 )
4770
4871
72+{-| Constructs an `Atom` from a `BigInt`.
73+-}
4974bigint : BigInt -> Noun
5075bigint x =
5176 Atom (BigInt.Bytes.encode x)
5277
5378
79+{-| Constructs an `Atom` from a signed `Int`.
80+-}
5481signedInt : Int -> Noun
5582signedInt i =
5683 int
@@ -62,21 +89,34 @@ signedInt i =
6289 )
6390
6491
92+{-| Constructs an `Atom` from `Bytes`
93+-}
6594bytes : Bytes -> Noun
6695bytes =
6796 Atom
6897
6998
99+{-| Constructs a [`cord`](https://developers.urbit.org/reference/glossary/cord), [`knot`](https://developers.urbit.org/guides/additional/strings#knot) or a [`term`](https://developers.urbit.org/guides/additional/strings#term) from a String.
100+-}
70101cord : String -> Noun
71102cord s =
72103 Atom (BE.encode (BE.string s))
73104
74105
106+{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`
107+-}
75108tape : String -> Noun
76109tape s =
77110 String.toList s |> List.map String.fromChar |> listOf cord
78111
79112
113+{-| Constructs a `sig`-terminated list.
114+
115+The first argument is a constructor for the elements of the list.
116+
117+The second argument is the list of values to encode.
118+
119+-}
80120listOf : (a -> Noun) -> List a -> Noun
81121listOf encEl list =
82122 case list of
@@ -87,16 +127,25 @@ listOf encEl list =
87127 cell (encEl x) (listOf encEl xs)
88128
89129
130+{-| The [`sig`](https://developers.urbit.org/reference/glossary/tape) value. Also known as `~`.
131+
132+It is equivalent to `0`.
133+
134+-}
90135sig : Noun
91136sig =
92137 Atom (BE.encode (BE.sequence []))
93138
94139
140+{-| Constructs an `Atom` from a 32-bit float.
141+-}
95142float32 : Float -> Noun
96143float32 f =
97144 Atom (BE.encode (BE.float32 LE f))
98145
99146
147+{-| Constructs an `Atom` from a 64-bit float.
148+-}
100149float64 : Float -> Noun
101150float64 f =
102151 Atom (BE.encode (BE.float64 LE f))
src/Ur/Da.elm+10
@@ -1,9 +1,17 @@
11module Ur.Da exposing (Da, posixToDa)
22
3+{-|
4+
5+@docs Da, posixToDa
6+
7+-}
8+
39import BigInt exposing (BigInt)
410import Time exposing (Posix)
511
612
13+{-| Represents a `@da`.
14+-}
715type alias Da =
816 BigInt
917
@@ -18,6 +26,8 @@ second =
1826 BigInt.fromIntString "18446744073709551616" |> Maybe.withDefault (BigInt.fromInt 0)
1927
2028
29+{-| Converts `Posix` to a `@da`
30+-}
2131posixToDa : Posix -> Da
2232posixToDa p =
2333 BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000000)) unixEpochStart
src/Ur/Deconstructor.elm+133−31
@@ -1,27 +1,72 @@
11module Ur.Deconstructor exposing
22 ( Deconstructor
3− , alt
4− , bigint
5− , bytes
6− , cell
7− , const
8− , cord
9− , float32
10− , float64
11− , ignore
12− , int
13− , list
14− , llec
3+ , run, runBytes
4+ , cell, list, oneOf, const
155 , map
16− , oneOf
17− , run
18− , runBytes
19− , sig
20− , signedInt
21− , tape
22− , tar
6+ , int, signedInt, bigint
7+ , float32, float64
8+ , cord, tape
9+ , bytes, sig, ignore, tar
2310 )
2411
12+{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
13+
14+The principal (and types) are very similar to `Url.Parser` from `elm/url`.
15+
16+You would parse a `[%edit cord @]` like this:
17+
18+ type alias Edit = {text : String, id: Int}
19+
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`.
27+
28+@docs Deconstructor
29+
30+
31+# Running a `Deconstructor`
32+
33+@docs run, runBytes
34+
35+
36+# Higher-order `Deconstructor`s
37+
38+@docs cell, list, oneOf, const
39+
40+
41+# Mapping a `Deconstructor`
42+
43+@docs map
44+
45+
46+# Numbers
47+
48+
49+## `Int`a
50+
51+@docs int, signedInt, bigint
52+
53+
54+## `Float`s
55+
56+@docs float32, float64
57+
58+
59+# `String`s
60+
61+@docs cord, tape
62+
63+
64+# Miscellaneous
65+
66+@docs bytes, sig, ignore, tar
67+
68+-}
69+
2570import BigInt exposing (BigInt)
2671import BigInt.Bytes
2772import Bitwise
@@ -29,18 +74,25 @@ import Bytes exposing (Bytes, Endianness(..))
2974import Bytes.Decode as BD
3075import Bytes.Encode as BE
3176import Bytes.Extra
32−import Ur exposing (..)
77+import Ur.Jam exposing (cue)
78+import Ur.Types exposing (..)
3379
3480
81+{-| A `Noun` deconstructor.
82+-}
3583type Deconstructor a b
3684 = Deconstructor (Noun -> a -> Maybe b)
3785
3886
87+{-| Executes a `Deconstructor` on a `Noun`.
88+-}
3989run : Deconstructor (a -> a) a -> Noun -> Maybe a
4090run (Deconstructor f) noun =
4191 f noun identity
4292
4393
94+{-| Executes a deconstructor on a `jam`med `Noun`.
95+-}
4496runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
4597runBytes (Deconstructor f) bs =
4698 cue bs
@@ -48,6 +100,15 @@ runBytes (Deconstructor f) bs =
48100 (\noun -> f noun identity)
49101
50102
103+{-| Asserts that the value at the current position should be exactly equal to the second argument.
104+
105+The first argument is a `Deconstructor` for the gven tyoe.
106+
107+The second argument is the value to compare with.
108+
109+This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
110+
111+-}
51112const : Deconstructor (a -> a) a -> a -> Deconstructor c c
52113const (Deconstructor f) value =
53114 Deconstructor
@@ -65,6 +126,8 @@ const (Deconstructor f) value =
65126 )
66127
67128
129+{-| Extracts a `cord` at the current location.
130+-}
68131cord : Deconstructor (String -> a) a
69132cord =
70133 Deconstructor
@@ -79,11 +142,18 @@ cord =
79142 )
80143
81144
145+{-| Extracts a `tape` at the current location.
146+-}
82147tape : Deconstructor (String -> a) a
83148tape =
84149 list cord |> fmap String.concat
85150
86151
152+{-| Extracts a 32-bit unsigned `Int` at the given location.
153+
154+If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
155+
156+-}
87157int : Deconstructor (Int -> a) a
88158int =
89159 Deconstructor
@@ -113,6 +183,8 @@ int =
113183 )
114184
115185
186+{-| Extracts a `BigInt` at the current location.
187+-}
116188bigint : Deconstructor (BigInt -> a) a
117189bigint =
118190 Deconstructor
@@ -126,6 +198,11 @@ bigint =
126198 )
127199
128200
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+-}
129206signedInt : Deconstructor (Int -> a) a
130207signedInt =
131208 int
@@ -139,6 +216,8 @@ signedInt =
139216 )
140217
141218
219+{-| Extracts a 32-bit `Float` at the given location.
220+-}
142221float32 : Deconstructor (Float -> a) a
143222float32 =
144223 Deconstructor
@@ -153,6 +232,8 @@ float32 =
153232 )
154233
155234
235+{-| Extracts a 64-bit `Float` at the given location.
236+-}
156237float64 : Deconstructor (Float -> a) a
157238float64 =
158239 Deconstructor
@@ -167,6 +248,8 @@ float64 =
167248 )
168249
169250
251+{-| Extracts the raw `Byte`s of an `Atom` at the current location.
252+-}
170253bytes : Deconstructor (Bytes -> a) a
171254bytes =
172255 Deconstructor
@@ -180,6 +263,8 @@ bytes =
180263 )
181264
182265
266+{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).
267+-}
183268sig : Deconstructor a a
184269sig =
185270 Deconstructor
@@ -197,6 +282,11 @@ sig =
197282 )
198283
199284
285+{-| Extracts a sig-terminated list of arbitrary elements at the current position.
286+
287+The first argument is a `Deconstructor` of the elements of the list.
288+
289+-}
200290list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
201291list (Deconstructor f) =
202292 Deconstructor
@@ -227,6 +317,11 @@ alt (Deconstructor f) (Deconstructor g) =
227317 )
228318
229319
320+{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
321+
322+This is especially useful for deconstructing head-tagged unions from Hoon.
323+
324+-}
230325oneOf : List (Deconstructor a b) -> Deconstructor a b
231326oneOf l =
232327 case l of
@@ -237,29 +332,31 @@ oneOf l =
237332 alt x (oneOf xs)
238333
239334
335+{-| Extract the raw `Noun` at the current position.
336+
337+Always succeeds.
338+
339+-}
240340tar : Deconstructor (Noun -> a) a
241341tar =
242342 Deconstructor (\noun f -> Just (f noun))
243343
244344
345+{-| Ignore any value at the current position.
346+
347+This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
348+
349+-}
245350ignore : Deconstructor a a
246351ignore =
247352 Deconstructor (\_ f -> Just f)
248353
249354
250−llec : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
251−llec (Deconstructor r) (Deconstructor l) =
252− Deconstructor
253− (\noun a ->
254− case noun of
255− Cell ( lhs, rhs ) ->
256− r rhs a |> Maybe.andThen (\b -> l lhs b)
257−
258− Atom _ ->
259− Nothing
260− )
355+{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
261356
357+Accepts two arbitrary `Deconstructor`s that form a Cell.
262358
359+-}
263360cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
264361cell (Deconstructor l) (Deconstructor r) =
265362 Deconstructor
@@ -273,6 +370,11 @@ cell (Deconstructor l) (Deconstructor r) =
273370 )
274371
275372
373+{-| Maps (applies) a function to all of the values deconstructed.
374+
375+This is useful when you want to create a data type with extracted values as fields.
376+
377+-}
276378map : a -> Deconstructor a b -> Deconstructor (b -> c) c
277379map a (Deconstructor f) =
278380 Deconstructor (\noun g -> f noun a |> Maybe.map g)
src/Ur/Jam.elmnew file+193
@@ -0,0 +1,193 @@
1+module Ur.Jam exposing (..)
2+
3+{-|
4+
5+
6+# Encoding and decoding Nouns
7+
8+@docs jam, cue
9+
10+-}
11+
12+import BitParser as BP exposing (BitParser)
13+import BitWriter as BW exposing (BitWriter)
14+import Bitwise
15+import Bytes exposing (Bytes)
16+import Bytes.Extra as Bytes
17+import Dict exposing (Dict)
18+import List.Extra as List
19+import Ur.Types exposing (..)
20+
21+
22+{-| `jam` encodes arbitrary Nouns into an Atom.
23+-}
24+jam : Noun -> Bytes
25+jam n =
26+ BW.run (jamWriter n BW.empty)
27+
28+
29+
30+-- Does not use references because it is complex to implement in Elm and would probably lead
31+-- to poor performance
32+
33+
34+jamWriter : Noun -> BitWriter -> BitWriter
35+jamWriter noun writer =
36+ case noun of
37+ Atom atom ->
38+ writer
39+ |> BW.bit 0
40+ |> mat atom
41+
42+ Cell ( a, b ) ->
43+ writer
44+ |> BW.bit 1
45+ |> BW.bit 0
46+ |> jamWriter a
47+ |> jamWriter b
48+
49+
50+{-| Decodes a `jam`med Noun (Atom) into the original Noun.
51+-}
52+cue : Bytes -> Maybe Noun
53+cue =
54+ BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second
55+
56+
57+cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )
58+cueParser refs =
59+ BP.getOffset
60+ |> BP.andThen
61+ (\offset ->
62+ BP.bit
63+ |> BP.andThen
64+ (\isAtom ->
65+ if isAtom == 0 then
66+ rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))
67+
68+ else
69+ BP.bit
70+ |> BP.andThen
71+ (\isRef ->
72+ if isRef == 0 then
73+ cueParser refs
74+ |> BP.andThen
75+ (\( refs_, a ) ->
76+ cueParser refs_
77+ |> BP.andThen
78+ (\( refs__, b ) ->
79+ let
80+ c =
81+ Cell ( a, b )
82+ in
83+ ( Dict.insert offset c refs__, c )
84+ |> BP.succeed
85+ )
86+ )
87+
88+ else
89+ rub
90+ |> BP.andThen
91+ (\ref ->
92+ case
93+ Dict.get
94+ (Bytes.toByteValues ref
95+ |> List.foldr
96+ (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
97+ 0
98+ )
99+ refs
100+ of
101+ Just n ->
102+ BP.succeed ( refs, n )
103+
104+ _ ->
105+ BP.fail
106+ )
107+ )
108+ )
109+ )
110+
111+
112+isSig : Bytes -> Bool
113+isSig bytes =
114+ Bytes.toByteValues bytes |> List.all (\x -> x == 0)
115+
116+
117+mat : Bytes -> BitWriter -> BitWriter
118+mat bytes writer =
119+ if isSig bytes then
120+ writer |> BW.bit 1
121+
122+ else
123+ let
124+ bits =
125+ bytesToBits bytes |> List.dropWhileRight (\x -> x == 0)
126+
127+ lengthBits =
128+ bits |> List.length |> intToBits |> List.reverse |> List.drop 1 |> List.reverse
129+ in
130+ writer
131+ |> BW.bit 0
132+ |> BW.bits (List.repeat (List.length lengthBits) 0)
133+ |> BW.bit 1
134+ |> BW.bits lengthBits
135+ |> BW.bits bits
136+
137+
138+rub : BitParser Bytes
139+rub =
140+ BP.bit
141+ |> BP.andThen
142+ (\zeroBit ->
143+ if zeroBit == 1 then
144+ BP.succeed Bytes.empty
145+
146+ else
147+ let
148+ countZeros n =
149+ BP.bit
150+ |> BP.andThen
151+ (\b ->
152+ if b == 0 then
153+ countZeros (n + 1)
154+
155+ else
156+ BP.succeed n
157+ )
158+ in
159+ countZeros 0
160+ |> BP.andThen
161+ (\lengthOfLength ->
162+ BP.rawBits lengthOfLength
163+ |> BP.andThen
164+ (\preLengthRawBits ->
165+ let
166+ length =
167+ BP.bitsToInt (preLengthRawBits ++ [ 1 ])
168+ in
169+ BP.bits length
170+ )
171+ )
172+ )
173+
174+
175+bytesToBits : Bytes -> List Int
176+bytesToBits bytes =
177+ case
178+ BP.run (BP.rawBits (Bytes.width bytes * 8)) bytes
179+ of
180+ Nothing ->
181+ []
182+
183+ Just bits ->
184+ bits
185+
186+
187+intToBits : Int -> List Int
188+intToBits n =
189+ if n <= 0 then
190+ []
191+
192+ else
193+ Bitwise.and 1 n :: intToBits (Bitwise.shiftRightBy 1 n)
src/Ur/Phonemic.elm+9−12
@@ -1,22 +1,19 @@
1−module Ur.Phonemic exposing (Ship, fromString)
1+module Ur.Phonemic exposing (fromString)
2+
3+{-|
4+
5+@docs fromString
6+
7+-}
28
39import BigInt.Bytes
410import Bytes.Extra
5−import Ur exposing (Atom, Noun(..))
11+import Ur.Types exposing (Atom, Noun(..), Ship)
612import Urbit.Encoding.Atom exposing (toBigInt)
713import Urbit.Encoding.Phonemic exposing (..)
814
915
10−{-| A ship name like `~zod` or `~racfer-hattes`.
11−
12−Also know as `@p`.
13−
14−-}
15−type alias Ship =
16− String
17−
18−
19−{-| Converts a string like '~zod' into an Atom.
16+{-| Converts a ship name like `~zod` into an Atom.
2017-}
2118fromString : Ship -> Atom
2219fromString s =
src/Ur/Requests.elm+6−52
@@ -1,8 +1,6 @@
11module Ur.Requests exposing
22 ( EventId
33 , UrbitRequest(..)
4− , scry
5− , scryTask
64 , send
75 , sendTask
86 , tag
@@ -13,8 +11,9 @@ import Http
1311import Task exposing (Task)
1412import Ur exposing (..)
1513import Ur.Constructor as C
16−import Ur.Deconstructor as D
17−import Ur.Phonemic exposing (Ship)
14+import Ur.Jam exposing (jam)
15+import Ur.Phonemic
16+import Ur.Types exposing (..)
1817import Ur.Uw
1918
2019
@@ -68,7 +67,7 @@ sendTask { url, error, success, requests } =
6867 requests
6968 |> List.map (uncurry toNoun)
7069 |> C.listOf identity
71− |> Ur.jam
70+ |> jam
7271 |> Ur.Uw.encode
7372 |> Http.stringBody "application/x-urb-jam"
7473 , resolver =
@@ -89,58 +88,13 @@ type alias EventId =
8988 Int
9089
9190
92−scry :
93− { url : String
94− , agent : Agent
95− , path : Path
96− , error : msg
97− , success : D.Deconstructor (msg -> msg) msg
98− }
99− -> Cmd msg
100−scry args =
101− scryTask args |> Task.perform identity
102−
103−
104−scryTask :
105− { url : String
106− , agent : Agent
107− , path : Path
108− , error : msg
109− , success : D.Deconstructor (msg -> msg) msg
110− }
111− -> Task a msg
112−scryTask { url, agent, path, error, success } =
113− Http.riskyTask
114− { method = "GET"
115− , headers = []
116− , url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"
117− , body = Http.emptyBody
118− , resolver =
119− Http.bytesResolver
120− (\resp ->
121− case resp of
122− Http.GoodStatus_ _ bytes ->
123− case D.runBytes success bytes of
124− Just msg ->
125− Ok msg
126−
127− Nothing ->
128− Ok error
129−
130− _ ->
131− Ok error
132− )
133− , timeout = Nothing
134− }
135−
136−
13791toNoun : EventId -> UrbitRequest -> Noun
13892toNoun eventId req =
13993 case req of
14094 Subscribe ( ship, app, path ) ->
14195 C.cell (C.cord "subscribe") <|
14296 C.cell (C.int eventId) <|
143− C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
97+ C.cell (Atom (Ur.Phonemic.fromString ship)) <|
14498 C.cell (C.cord app) (C.listOf C.cord path)
14599
146100 Unsubscribe subId ->
@@ -150,7 +104,7 @@ toNoun eventId req =
150104 Poke { ship, agent, mark, noun } ->
151105 C.cell (C.cord "poke") <|
152106 C.cell (C.int eventId) <|
153− C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
107+ C.cell (Atom (Ur.Phonemic.fromString ship)) <|
154108 C.cell (C.cord agent) <|
155109 C.cell (C.cord mark) <|
156110 noun
src/Ur/Run.elm+20−10
@@ -1,11 +1,10 @@
1−module Ur.Run exposing
2− ( Model
3− , Msg
4− , Program
5− , application
6− , document
7− , element
8− )
1+module Ur.Run exposing (element, document, application, Program, Model, Msg)
2+
3+{-|
4+
5+@docs element, document, application, Program, Model, Msg
6+
7+-}
98
109import Browser exposing (Document, UrlRequest)
1110import Browser.Navigation as Nav
@@ -15,15 +14,14 @@ import Html exposing (Html)
1514import Json.Decode as JD
1615import Task
1716import Time
18−import Ur exposing (Agent, Path)
1917import Ur.Cmd
2018import Ur.Cmd.Internal
2119import Ur.Constructor as C
2220import Ur.Deconstructor as D
23−import Ur.Phonemic exposing (Ship)
2421import Ur.Requests exposing (..)
2522import Ur.Sub
2623import Ur.Sub.Internal
24+import Ur.Types exposing (..)
2725import Ur.Uw
2826import Url exposing (Url)
2927
@@ -41,6 +39,8 @@ type alias Flags =
4139 { uid : String }
4240
4341
42+{-| An Urbit wrapper around your application model.
43+-}
4444type alias Model app msg =
4545 { subscriptions : SubDict msg
4646 , subscriptionIntMapping : Dict Int ( String, String, List String )
@@ -52,6 +52,8 @@ type alias Model app msg =
5252 }
5353
5454
55+{-| An Urbit wrapper around your application messages.
56+-}
5557type Msg msg
5658 = AppMsg msg
5759 | EventSourceMsg JD.Value
@@ -62,10 +64,14 @@ type Msg msg
6264 | RetryRequests
6365
6466
67+{-| A wrapper around your application `Program`
68+-}
6569type alias Program model msg =
6670 Platform.Program Flags (Model model msg) (Msg msg)
6771
6872
73+{-| The same as `Browser.element` but with urbit stuff added around it.
74+-}
6975element :
7076 { init : ( model, Ur.Cmd.Cmd msg )
7177 , view : model -> Html msg
@@ -86,6 +92,8 @@ element inp =
8692 }
8793
8894
95+{-| The same as `Browser.element` but with urbit stuff added around it.
96+-}
8997document :
9098 { init : ( model, Ur.Cmd.Cmd msg )
9199 , view : model -> Document msg
@@ -109,6 +117,8 @@ document inp =
109117 }
110118
111119
120+{-| The same as `Browser.element` but with urbit stuff added around it.
121+-}
112122application :
113123 { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
114124 , view : model -> Document msg
src/Ur/Sub.elm+11−1
@@ -1,24 +1,34 @@
1−module Ur.Sub exposing (Sub, batch, none, subscribe)
1+module Ur.Sub exposing (Sub, subscribe, none, batch)
2+
3+{-| This module is conceptually similar to `Platform.Sub`, but also you to subscribe to Urbit channels.
4+
5+@docs Sub, subscribe, none, batch
6+
7+-}
28
39import Dict
410import Ur.Deconstructor as D
511import Ur.Sub.Internal
612
713
14+{-| -}
815type alias Sub msg =
916 Ur.Sub.Internal.Sub msg
1017
1118
19+{-| -}
1220subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg
1321subscribe { ship, app, path, deconstructor } =
1422 Dict.singleton ( ship, app, path ) deconstructor |> Ur.Sub.Internal.Sub
1523
1624
25+{-| -}
1726none : Sub msg
1827none =
1928 Ur.Sub.Internal.Sub Dict.empty
2029
2130
31+{-| -}
2232batch : List (Sub msg) -> Sub msg
2333batch subs =
2434 subs |> List.map (\(Ur.Sub.Internal.Sub dict) -> dict) |> List.foldl Dict.union Dict.empty |> Ur.Sub.Internal.Sub
src/Ur/Sub/Internal.elm+1−2
@@ -1,9 +1,8 @@
11module Ur.Sub.Internal exposing (Sub(..))
22
33import Dict exposing (Dict)
4−import Ur exposing (Agent, Path)
54import Ur.Deconstructor as D
6−import Ur.Phonemic exposing (Ship)
5+import Ur.Types exposing (Agent, Path, Ship)
76
87
98type Sub msg
src/Ur/Types.elmnew file+60
@@ -0,0 +1,60 @@
1+module Ur.Types exposing
2+ ( Noun(..), Atom
3+ , Agent, Mark, Path, Ship
4+ )
5+
6+{-|
7+
8+
9+# Nouns
10+
11+@docs Noun, Atom
12+
13+
14+# Types
15+
16+@docs Agent, Mark, Path, Ship
17+
18+-}
19+
20+import Bytes exposing (Bytes)
21+
22+
23+{-| An [Urbit agent](https://developers.urbit.org/reference/glossary/agent) (app) name like `journal` or `groups`.
24+-}
25+type alias Agent =
26+ String
27+
28+
29+{-| An [Urbit subscription path](https://developers.urbit.org/reference/glossary/path).
30+-}
31+type alias Path =
32+ List String
33+
34+
35+{-| An [Urbit mark](https://developers.urbit.org/reference/arvo/clay/marks/marks)
36+-}
37+type alias Mark =
38+ String
39+
40+
41+{-| A ship name like `~zod` or `~racfer-hattes`.
42+
43+Also know as `@p`.
44+
45+-}
46+type alias Ship =
47+ String
48+
49+
50+{-| An [Urbit Noun](https://developers.urbit.org/reference/glossary/noun).
51+-}
52+type Noun
53+ = Cell ( Noun, Noun )
54+ | Atom Atom
55+
56+
57+{-| An [Urbit Atom](https://developers.urbit.org/reference/glossary/atom)
58+-}
59+type alias Atom =
60+ Bytes
src/Ur/Uw.elm+8
@@ -1,5 +1,11 @@
11module Ur.Uw exposing (decode, encode)
22
3+{-| This module works with Urbit base-64 encoded strings.
4+
5+@docs decode, encode
6+
7+-}
8+
39import BitParser as BP
410import BitWriter as BW
511import Bitwise
@@ -9,6 +15,7 @@ import Dict
915import List.Extra
1016
1117
18+{-| -}
1219decode : String -> Bytes
1320decode string =
1421 if string == "0w0" then
@@ -42,6 +49,7 @@ decode string =
4249 BW.run (go chars BW.empty)
4350
4451
52+{-| -}
4553encode : Bytes -> String
4654encode bytes =
4755 let