on fe9c4e6 help sign in
55 files changed+596−1770
since splitsnapshots
unifiedsplit
.gitignore−1 LICENSE−7 README.md−43 dev/sink-elm-live.sh → dev/elm-live.sh+1−1 dev/vanilla-elm-live.sh−7 docs/sink.md−101 elm.json+2−11 example/urbit/app/journal.hoon → example/journal/app/journal.hoon+19−26 example/urbit/desk.bill → example/journal/desk.bill example/urbit/desk.docket-0 → example/journal/desk.docket-0 example/urbit/gen/journal/add.hoon → example/journal/gen/journal/add.hoon example/urbit/lib/agentio.hoon → example/journal/lib/agentio.hoon example/urbit/lib/dbug.hoon → example/journal/lib/dbug.hoon example/urbit/lib/default-agent.hoon → example/journal/lib/default-agent.hoon example/urbit/lib/docket.hoon → example/journal/lib/docket.hoon example/urbit/lib/journal.hoon → example/journal/lib/journal.hoon example/urbit/lib/skeleton.hoon → example/journal/lib/skeleton.hoon example/urbit/mar/bill.hoon → example/journal/mar/bill.hoon example/urbit/mar/docket-0.hoon → example/journal/mar/docket-0.hoon example/urbit/mar/hoon.hoon → example/journal/mar/hoon.hoon example/urbit/mar/jam.hoon → example/journal/mar/jam.hoon example/urbit/mar/journal/action.hoon → example/journal/mar/journal/action.hoon example/urbit/mar/journal/update.hoon → example/journal/mar/journal/update.hoon example/urbit/mar/json.hoon → example/journal/mar/json.hoon example/urbit/mar/kelvin.hoon → example/journal/mar/kelvin.hoon example/urbit/mar/mime.hoon → example/journal/mar/mime.hoon example/urbit/mar/noun.hoon → example/journal/mar/noun.hoon example/urbit/mar/txt-diff.hoon → example/journal/mar/txt-diff.hoon example/urbit/mar/txt.hoon → example/journal/mar/txt.hoon example/urbit/sur/docket.hoon → example/journal/sur/docket.hoon example/urbit/sur/journal.hoon → example/journal/sur/journal.hoon example/urbit/sys.kelvin → example/journal/sys.kelvin example/script.js+1−16 example/src/Vanilla.elm → example/src/Main.elm+16−21 example/src/Sink.elm−199 example/urbit/lib/noun-diff.hoon−227 example/urbit/lib/sink.hoon−26 res/airlock.jpeg src/BitWriter.elm+5−5 src/Ur.elm+209−82 src/Ur/Cmd.elm+10−27 src/Ur/Cmd/Internal.elm+2−1 src/Ur/Constructor.elm+16−65 src/Ur/Da.elm−10 src/Ur/Deconstructor.elm+198−293 src/Ur/Jam.elm−193 src/Ur/NounDiff.elm−115 src/Ur/Phonemic.elm+12−9 src/Ur/Requests.elm+53−7 src/Ur/Run.elm+27−144 src/Ur/Sub.elm+4−41 src/Ur/Sub/Internal.elm+3−4 src/Ur/Types.elm−60 src/Ur/Uw.elm+7−15 tests/Test/Urbit.elm+11−13
.gitignore−1
@@ -1,3 +1,2 @@
11elm-stuff
22elm.js
3−zod
LICENSEdeleted−7
@@ -1,7 +0,0 @@
1−Copyright 2023 Ilia Kostiuchenko
2−
3−Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
4−
5−The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
6−
7−THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
README.mddeleted−43
@@ -1,43 +0,0 @@
1−# Airlock
2−
3−![](res/airlock.jpeg)
4−
5−## Usage
6−
7−### Demo
8−
9−[![DEMO](https://img.youtube.com/vi/tynCzifvIzE/0.jpg)](https://www.youtube.com/watch?v=tynCzifvIzE)
10−
11−
12−## Getting started
13−
14−The easiest way of using this library is by using the [airlock template](https://github.com/ilyakooo0/airlock-template).
15−
16−### FFI
17−
18−This is for setting up this library from scratch.
19−
20−Urbit subscriptions require [server-side event (SSE)](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events).
21−Unfortunately, Elm does not provide a native implementation.
22−This means that we will need to use [JS FFI (aka ports)](https://guide.elm-lang.org/interop/ports.html).
23−
24−#### Setting up the Elm side
25−
26−You would need to declare two ports for Airlock to use:
27−
28−1. `port createEventSource : String -> Cmd msg`
29−
30− This sets up the SSE channel.
31−2. `port onEventSourceMessage : (JD.Value -> msg) -> Sub msg`
32− This recieves the actual messages from the SSE channel.
33−
34−These two functions need to be passed to one of the functions from `Ur.Run` module.
35−The functions in `Ur.Run` are the same as functions from `Browser`, but have a couple of extra urbit-specific fields.
36−
37−#### Setting up the JS side
38−
39−The SSE JS code is neatly packed into [example/fetch-event-source.js](example/fetch-event-source.js).
40−All you need to do is pass them to Elm ports like in [example/script.js](example/script.js).
41−
42−You can see a full working example in [example](example).
43−
dev/sink-elm-live.sh → dev/elm-live.shrenamed+1−1
@@ -4,4 +4,4 @@ set -e
44
55cd "$(dirname "$0")/../example"
66
7−nix run nixpkgs#elmPackages.elm-live -- src/Sink.elm --start-page=index.html -- --output=elm.js --debug "$@"
7+nix run nixpkgs#elmPackages.elm-live -- src/Main.elm --start-page=index.html -- --output=elm.js --debug "$@"
dev/vanilla-elm-live.shdeleted−7
@@ -1,7 +0,0 @@
1−#!/bin/sh
2−
3−set -e
4−
5−cd "$(dirname "$0")/../example"
6−
7−nix run nixpkgs#elmPackages.elm-live -- src/Vanilla.elm --start-page=index.html -- --output=elm.js --debug "$@"
docs/sink.mddeleted−101
@@ -1,101 +0,0 @@
1−# %sink
2−
3−%sink is a state replication system between your %gall agent and your Elm airlock.
4−
5−%sink allows you to avoid having to manually write subscriptions which send semantic diffs between your %gall agent and the frontend.
6−
7−## How it works
8−
9−%sink consists of two parts:
10−1. The %sink library you import into your %gall agent and call appropriate functions at the right points in your agent lifecycle. More on this in a bit.
11−2. The `Ur.Sub.sink` urbit subscription which reconciles the state and hands you the latest version of %gall agent state that you can then `Deconstruct` into Elm data structures.
12−
13−The whole system works by saving the previous version your %gall agent state and diffing the raw nouns that compose your old state and your new state.
14−On first initialization of the %sink system the whole state you supplied is sent to the frontend. Any subsequent changes are sent as a diff between your old state and your new state.
15−
16−## How to use it
17−
18−### The %gall agent part
19−
20−#### Copying library files
21−
22−In order to use %sink you have to copy the following two files into your agent desk into the `lib` directory:
23−1. [example/urbit/lib/noun-diff.hoon](../example/urbit/lib/noun-diff.hoon) -- contains the algorithm for diffing raw nouns.
24−2. [example/urbit/lib/sink.hoon](../example/urbit/lib/sink.hoon) -- contains the logic of syncing the state between your agent and your frontend.
25−
26−#### Adding sync points into your agent
27−
28−First you need to import the %sink library into your agent:
29−
30−```hoon
31−/+ *sink
32−```
33−
34−Next you need to initialize the sink. Put the following declaration somewhere before your agent door:
35−
36−```hoon
37−::
38−:: A deferred expression of the state you want to sync to the frontend.
39−=* entries (tap:j-orm journal.stat)
40−::
41−:: Replace /sync with whatever path you want to use for syncing your state.
42−=/ snik (sink ~[/sync])
43−::
44−:: Next you initialize your sink with your initial agent state.
45−=/ sink (snik entries)
46−```
47−
48−You can have multiple sinks in the same application to sync different parts of your state on different paths.
49−
50−Don't forget to reinitialize your `sink` when your restore your agent state in the `++on-load` arm:
51−
52−```hoon
53−++ on-load
54− |= old-vase=vase
55− ^- (quip card _this)
56− =/ state !<(versioned-state old-vase)
57− ::
58− :: the `sink (snik entries)` is the important bit.
59− `this(state state, sink (snik entries))
60−```
61−
62−Lastly, you need to send sink updates whenever you change your state. Most likely this will be in your `++on-poke` arm:
63−
64−```hoon
65−::
66−:: This line generates a `card` that you need to pass to arvo and updates
67−:: the `sink` to reference the latest state of your agent.
68−=^ card sink (sync:sink entries)
69−```
70−
71−You can look at the [journal.hoon](../example/urbit/app/journal.hoon) for a full example.
72−
73−#### Adding sink the the frontend
74−
75−For your frontend to recieve %sink updates you need to pass the result of calling `Ur.Sub.sink` to the `urbitSubscriptions` field of `Ur.Run.application` or similar function from `Ur.Run`:
76−
77−```elm
78−main : Ur.Run.Program Model Msg
79−main =
80− Ur.Run.application
81− {
82− -- ...
83− urbitSubscriptions =
84− -- ...
85− Ur.Sub.sink
86− { ship = ship
87− , app = "journal"
88− , path = [ "sync" ]
89− , deconstructor =
90− D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b )))
91− |> D.map GotListings
92− }
93− -- ...
94− }
95−```
96−
97−In the `deconstructor` field you specify a `Deconstructor` the deconstructs _the whole_ state that is being synced form the %gall agent.
98−
99−You do not have to deal with diffs. It is handled automatically
100−
101−You can look at [example/src/Sink.elm](../example/src/Sink.elm) for a full example.
elm.json+2−11
@@ -3,18 +3,9 @@
33 "name": "ilyakooo0/airlock",
44 "summary": "Urbit airlock",
55 "license": "MIT",
6− "version": "1.1.1",
6+ "version": "1.0.0",
77 "exposed-modules": [
8− "Ur",
9− "Ur.Cmd",
10− "Ur.Sub",
11− "Ur.Constructor",
12− "Ur.Deconstructor",
13− "Ur.Phonemic",
14− "Ur.Da",
15− "Ur.Uw",
16− "Ur.Run",
17− "Ur.Types"
8+ "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run"
189 ],
1910 "elm-version": "0.19.0 <= v < 0.20.0",
2011 "dependencies": {
example/urbit/app/journal.hoon → example/journal/app/journal.hoonrenamed+19−26
@@ -1,5 +1,5 @@
11/- *journal
2−/+ default-agent, dbug, agentio, *sink
2+/+ default-agent, dbug, agentio
33|%
44+$ versioned-state
55 $% state-0
@@ -17,15 +17,11 @@
1717 ?. (has:log-orm log unix-ms)
1818 unix-ms
1919 $(time (add unix-ms 1))
20−--
21−
20+--
2221%- agent:dbug
23−=/ state *state-0
24−=* entries (tap:j-orm journal.state)
25−=/ snik (sink ~[/sync])
26−=/ sink (snik entries)
22+=| state-0
23+=* state -
2724^- agent:gall
28−::
2925|_ =bowl:gall
3026+* this .
3127 def ~(. (default-agent this %|) bowl)
@@ -38,8 +34,7 @@
3834++ on-load
3935 |= old-vase=vase
4036 ^- (quip card _this)
41− =/ state !<(versioned-state old-vase)
42− `this(state state, sink (snik entries))
37+ `this(state !<(versioned-state old-vase))
4338::
4439++ on-poke
4540 |= [=mark =vase]
@@ -47,28 +42,27 @@
4742 |^
4843 ?> (team:title our.bowl src.bowl)
4944 ?. ?=(%journal-action mark) (on-poke:def mark vase)
50− =/ now=@ (unique-time now.bowl log.state)
45+ =/ now=@ (unique-time now.bowl log)
5146 =/ act !<(action vase)
5247 =. state (poke-action act)
53− =^ card sink (sync:sink entries)
54− :_ this(log.state (put:log-orm log.state now act))
55− ~[(fact:io journal-update+!>(`update`[now act]) ~[/updates]) card]
48+ :_ this(log (put:log-orm log now act))
49+ ~[(fact:io journal-update+!>(`update`[now act]) ~[/updates])]
5650 ::
5751 ++ poke-action
5852 |= act=action
5953 ^- _state
6054 ?- -.act
6155 %add
62− ?< (has:j-orm journal.state id.act)
63− state(journal (put:j-orm journal.state id.act txt.act))
56+ ?< (has:j-orm journal id.act)
57+ state(journal (put:j-orm journal id.act txt.act))
6458 ::
6559 %edit
66− ?> (has:j-orm journal.state id.act)
67− state(journal (put:j-orm journal.state id.act txt.act))
60+ ?> (has:j-orm journal id.act)
61+ state(journal (put:j-orm journal id.act txt.act))
6862 ::
6963 %del
70− ?> (has:j-orm journal.state id.act)
71− state(journal +:(del:j-orm journal.state id.act))
64+ ?> (has:j-orm journal id.act)
65+ state(journal +:(del:j-orm journal id.act))
7266 ==
7367 --
7468::
@@ -78,7 +72,6 @@
7872 ?> (team:title our.bowl src.bowl)
7973 ?+ path (on-watch:def path)
8074 [%updates ~] `this
81− [%sync ~] [~[flush:sink] this]
8275 ==
8376::
8477++ on-peek
@@ -92,14 +85,14 @@
9285 [%all ~]
9386 :^ ~ ~ %journal-update
9487 !> ^- update
95− [now %jrnl entries]
88+ [now %jrnl (tap:j-orm journal)]
9689 ::
9790 [%before @ @ ~]
9891 =/ before=@ (rash i.t.t.t.path dem)
9992 =/ max=@ (rash i.t.t.t.t.path dem)
10093 :^ ~ ~ %journal-update
10194 !> ^- update
102− [now %jrnl (tab:j-orm journal.state `before max)]
95+ [now %jrnl (tab:j-orm journal `before max)]
10396 ::
10497 [%between @ @ ~]
10598 =/ start=@
@@ -108,7 +101,7 @@
108101 =/ end=@ (add 1 (rash i.t.t.t.t.path dem))
109102 :^ ~ ~ %journal-update
110103 !> ^- update
111− [now %jrnl (tap:j-orm (lot:j-orm journal.state `end `start))]
104+ [now %jrnl (tap:j-orm (lot:j-orm journal `end `start))]
112105 ==
113106 ::
114107 [%x %updates *]
@@ -116,13 +109,13 @@
116109 [%all ~]
117110 :^ ~ ~ %journal-update
118111 !> ^- update
119− [now %logs (tap:log-orm log.state)]
112+ [now %logs (tap:log-orm log)]
120113 ::
121114 [%since @ ~]
122115 =/ since=@ (rash i.t.t.t.path dem)
123116 :^ ~ ~ %journal-update
124117 !> ^- update
125− [now %logs (tap:log-orm (lot:log-orm log.state `since ~))]
118+ [now %logs (tap:log-orm (lot:log-orm log `since ~))]
126119 ==
127120 ==
128121::
example/urbit/desk.bill → example/journal/desk.billrenamed

The content is the same.

example/urbit/desk.docket-0 → example/journal/desk.docket-0renamed

The content is the same.

example/urbit/gen/journal/add.hoon → example/journal/gen/journal/add.hoonrenamed

The content is the same.

example/urbit/lib/agentio.hoon → example/journal/lib/agentio.hoonrenamed

The content is the same.

example/urbit/lib/dbug.hoon → example/journal/lib/dbug.hoonrenamed

The content is the same.

example/urbit/lib/default-agent.hoon → example/journal/lib/default-agent.hoonrenamed

The content is the same.

example/urbit/lib/docket.hoon → example/journal/lib/docket.hoonrenamed

The content is the same.

example/urbit/lib/journal.hoon → example/journal/lib/journal.hoonrenamed

The content is the same.

example/urbit/lib/skeleton.hoon → example/journal/lib/skeleton.hoonrenamed

The content is the same.

example/urbit/mar/bill.hoon → example/journal/mar/bill.hoonrenamed

The content is the same.

example/urbit/mar/docket-0.hoon → example/journal/mar/docket-0.hoonrenamed

The content is the same.

example/urbit/mar/hoon.hoon → example/journal/mar/hoon.hoonrenamed

The content is the same.

example/urbit/mar/jam.hoon → example/journal/mar/jam.hoonrenamed

The content is the same.

example/urbit/mar/journal/action.hoon → example/journal/mar/journal/action.hoonrenamed

The content is the same.

example/urbit/mar/journal/update.hoon → example/journal/mar/journal/update.hoonrenamed

The content is the same.

example/urbit/mar/json.hoon → example/journal/mar/json.hoonrenamed

The content is the same.

example/urbit/mar/kelvin.hoon → example/journal/mar/kelvin.hoonrenamed

The content is the same.

example/urbit/mar/mime.hoon → example/journal/mar/mime.hoonrenamed

The content is the same.

example/urbit/mar/noun.hoon → example/journal/mar/noun.hoonrenamed

The content is the same.

example/urbit/mar/txt-diff.hoon → example/journal/mar/txt-diff.hoonrenamed

The content is the same.

example/urbit/mar/txt.hoon → example/journal/mar/txt.hoonrenamed

The content is the same.

example/urbit/sur/docket.hoon → example/journal/sur/docket.hoonrenamed

The content is the same.

example/urbit/sur/journal.hoon → example/journal/sur/journal.hoonrenamed

The content is the same.

example/urbit/sys.kelvin → example/journal/sys.kelvinrenamed

The content is the same.

example/script.js+1−16
@@ -2,22 +2,7 @@ import { fetchEventSource } from "/fetch-event-source.js"
22
33const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;
44
5−function searchForInit(obj) {
6− if (obj.init) {
7− return obj.init;
8− } else {
9− for (let key in obj) {
10− if (obj.hasOwnProperty(key)) {
11− const result = searchForInit(obj[key]);
12− if (result) {
13− return result;
14− }
15− }
16− }
17− }
18−}
19−
20−let app = searchForInit(Elm)({ node: document.getElementById("elm"), flags: { uid } });
5+let app = Elm.Main.init({ node: document.getElementById("elm"), flags: { uid } });
216
227app.ports.createEventSource.subscribe((url) => {
238 fetchEventSource(url, {
example/src/Vanilla.elm → example/src/Main.elmrenamed+16−21
@@ -1,4 +1,4 @@
1−port module Vanilla exposing (main)
1+port module Main exposing (main)
22
33import BigInt exposing (BigInt)
44import Browser exposing (Document)
@@ -12,6 +12,7 @@ import Ur
1212import Ur.Cmd
1313import Ur.Constructor as C
1414import Ur.Deconstructor as D
15+import Ur.Requests
1516import Ur.Run
1617import Ur.Sub
1718import Widget
@@ -19,11 +20,6 @@ import Widget.Icon as Icon
1920import Widget.Material as Material
2021
2122
22−url : String
23−url =
24− "http://localhost:8080"
25−
26−
2723main : Ur.Run.Program Model Msg
2824main =
2925 Ur.Run.application
@@ -35,20 +31,20 @@ main =
3531 , shipName = Nothing
3632 }
3733 , Cmd.batch
38− [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
34+ [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
3935 |> Cmd.map (result (Debug.toString >> Error) (always Noop))
40− , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
41− , Ur.scry
42− { url = url
36+ , Ur.getShipName "http://localhost:8080" |> Cmd.map (result (always Noop) GotShipName)
37+ , Ur.Requests.scry
38+ { url = "http://localhost:8080"
4339 , agent = "journal"
4440 , path = [ "entries", "all" ]
4541 , error = Noop
4642 , success =
4743 D.cell D.ignore
4844 (D.cell (D.const D.cord "jrnl")
49− (D.list (D.cell D.bigint D.cord))
45+ (D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
46+ |> D.map GotListings
5047 )
51− |> D.map (\( (), ( (), listings ) ) -> GotListings listings)
5248 }
5349 ]
5450 |> Ur.Cmd.cmd
@@ -73,7 +69,7 @@ main =
7369 , onEventSourceMsg = onEventSourceMessage
7470 , onUrlChange = \_ -> Noop
7571 , onUrlRequest = \_ -> Noop
76− , urbitUrl = \_ -> url
72+ , urbitUrl = \_ -> "http://localhost:8080"
7773 }
7874
7975
@@ -177,15 +173,14 @@ type JournalUpdate
177173 | Delete BigInt
178174
179175
180−decodeJournalUpdate : D.Deconstructor JournalUpdate
176+decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a
181177decodeJournalUpdate =
182− D.oneOf
183− [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Add id txt)
184− , D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
185− , D.cell (D.const D.cord "del") D.bigint |> D.map (\( (), id ) -> Delete id)
186− ]
187− |> D.cell D.ignore
188− |> D.map (\( (), upd ) -> upd)
178+ D.cell D.ignore <|
179+ D.oneOf
180+ [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add
181+ , (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit
182+ , D.cell (D.const D.cord "del") D.bigint |> D.map Delete
183+ ]
189184
190185
191186view : Model -> Document Msg
example/src/Sink.elmdeleted−199
@@ -1,199 +0,0 @@
1−port module Sink exposing (main)
2−
3−import BigInt exposing (BigInt)
4−import Browser exposing (Document)
5−import Element exposing (..)
6−import Element.Border as Border
7−import Heroicons.Outline
8−import Json.Decode as JD
9−import Task
10−import Time
11−import Ur
12−import Ur.Cmd
13−import Ur.Constructor as C
14−import Ur.Deconstructor as D
15−import Ur.Run
16−import Ur.Sub
17−import Widget
18−import Widget.Icon as Icon
19−import Widget.Material as Material
20−
21−
22−url : String
23−url =
24− "http://localhost:8080"
25−
26−
27−main : Ur.Run.Program Model Msg
28−main =
29− Ur.Run.application
30− { init =
31− \_ _ ->
32− ( { error = ""
33− , entries = Nothing
34− , newEntry = ""
35− , shipName = Nothing
36− }
37− , Cmd.batch
38− [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
39− |> Cmd.map (result (Debug.toString >> Error) (always Noop))
40− , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
41− ]
42− |> Ur.Cmd.cmd
43− )
44− , update = update
45− , view = view
46− , subscriptions = always Sub.none
47− , createEventSource = createEventSource
48− , urbitSubscriptions =
49− \{ shipName } ->
50− case shipName of
51− Just ship ->
52− Ur.Sub.batch
53− [ Ur.Sub.sink
54− { ship = ship
55− , app = "journal"
56− , path = [ "sync" ]
57− , deconstructor =
58− D.list (D.cell D.bigint D.cord)
59− |> D.map GotListings
60− }
61− ]
62−
63− _ ->
64− Ur.Sub.none
65− , onEventSourceMsg = onEventSourceMessage
66− , onUrlChange = \_ -> Noop
67− , onUrlRequest = \_ -> Noop
68− , urbitUrl = \_ -> url
69− }
70−
71−
72−type alias Model =
73− { error : String
74− , entries : Maybe (List ( BigInt, String ))
75− , newEntry : String
76− , shipName : Maybe String
77− }
78−
79−
80−type Msg
81− = Noop
82− | Error String
83− | GotListings (List ( BigInt, String ))
84− | UpdateNewEntry String
85− | DeleteEntry BigInt
86− | AddEntry String
87− | RunCmd (Ur.Cmd.Cmd Msg)
88− | GotShipName String
89−
90−
91−update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )
92−update msg model =
93− case msg of
94− Noop ->
95− ( model, Ur.Cmd.none )
96−
97− Error err ->
98− ( { model | error = err }, Ur.Cmd.none )
99−
100− GotListings entries ->
101− ( { model | entries = Just entries }, Ur.Cmd.none )
102−
103− UpdateNewEntry txt ->
104− ( { model | newEntry = txt }, Ur.Cmd.none )
105−
106− DeleteEntry id ->
107− ( model
108− , Ur.Cmd.poke
109− { ship = "~zod"
110− , agent = "journal"
111− , mark = "journal-action"
112− , noun = C.cell (C.cord "del") (C.bigint id)
113− }
114− )
115−
116− AddEntry txt ->
117− ( { model | newEntry = "" }
118− , Time.now
119− |> Task.perform
120− (\time ->
121− Ur.Cmd.poke
122− { ship = "~zod"
123− , agent = "journal"
124− , mark = "journal-action"
125− , noun = C.cell (C.cord "add") (C.cell (time |> Time.posixToMillis |> BigInt.fromInt |> C.bigint) (C.cord txt))
126− }
127− |> RunCmd
128− )
129− |> Ur.Cmd.cmd
130− )
131−
132− RunCmd cmd ->
133− ( model, cmd )
134−
135− GotShipName name ->
136− ( { model | shipName = Just name }, Ur.Cmd.none )
137−
138−
139−view : Model -> Document Msg
140−view model =
141− { body =
142− [ layout []
143− ([ el [ alignTop ] (text model.error)
144− , row [ spacing 8 ]
145− [ Widget.textInput (Material.textInput Material.defaultPalette)
146− { chips = []
147− , text = model.newEntry
148− , placeholder = Nothing
149− , label = "New entry"
150− , onChange = UpdateNewEntry
151− }
152− , Widget.iconButton (Material.containedButton Material.defaultPalette)
153− { text = "submit"
154− , icon = Icon.elmHeroicons Heroicons.Outline.check
155− , onPress = AddEntry model.newEntry |> Just
156− }
157− ]
158− , model.entries
159− |> Maybe.withDefault []
160− |> List.map
161− (\( id, txt ) ->
162− row
163− [ Border.rounded 10
164− , Border.shadow { offset = ( 0, 5 ), size = 1, blur = 10, color = rgba 0 0 0 0.3 }
165− , centerX
166− , padding 10
167− , spacing 12
168− ]
169− [ paragraph [] [ text txt ]
170− , Widget.iconButton (Material.containedButton Material.defaultPalette)
171− { text = "delete"
172− , icon = Icon.elmHeroicons Heroicons.Outline.trash
173− , onPress = DeleteEntry id |> Just
174− }
175− ]
176− )
177− |> column [ spacing 10, centerX ]
178− ]
179− |> column [ spacing 18, centerX ]
180− )
181− ]
182− , title = "Airlock"
183− }
184−
185−
186−result : (a -> c) -> (b -> c) -> Result a b -> c
187−result f g res =
188− case res of
189− Ok b ->
190− g b
191−
192− Err a ->
193− f a
194−
195−
196−port createEventSource : String -> Cmd msg
197−
198−
199−port onEventSourceMessage : (JD.Value -> msg) -> Sub msg
example/urbit/lib/noun-diff.hoondeleted−227
@@ -1,227 +0,0 @@
1−=<
2−|%
3− ++ diff
4− |= [old=* new=*]
5− ^- patch
6− =/ del (extract-del (oracle old new) old)
7− =/ ins (extract-ins (oracle old new) new)
8− =/ allowed-holes (~(int in (find-del-holes del)) (find-ins-holes ins))
9− =. del (filter-del-holes allowed-holes del)
10− =/ ins (filter-ins-holes allowed-holes ins)
11− =/ closed-patch (closure (gcp [del ins]))
12− ?> =(& +.closed-patch)
13− -.closed-patch
14− ++ apply
15− |= [patch=_id noun=*]
16− ?- -.patch
17− %diff
18− =/ var-map (del del.patch noun)
19− (ins ins.patch var-map)
20− %cell
21− ?> ?=(^ noun)
22− [$(patch lhs.patch, noun -.noun) $(patch rhs.patch, noun +.noun)]
23− ==
24− ++ id
25− ^- patch
26− [%diff [%hole ~] [%hole ~]]
27− +$ patch
28− $%
29− [%cell lhs=patch rhs=patch]
30− [%diff ^diff]
31− ==
32−--
33−::
34−|%
35− +$ del-diff
36− $%
37− [%hole @]
38− [%cell lhs=del-diff rhs=del-diff]
39− [%ignore ~]
40− ==
41− +$ ins-diff
42− $%
43− [%hole @ original=*]
44− [%cell lhs=ins-diff rhs=ins-diff]
45− [%atom @]
46− ==
47− +$ final-ins-diff
48− $%
49− [%hole @]
50− [%cell lhs=final-ins-diff rhs=final-ins-diff]
51− [%atom @]
52− ==
53− +$ diff [del=del-diff ins=final-ins-diff]
54− +$ patch
55− $%
56− [%cell lhs=patch rhs=patch]
57− [%diff diff]
58− ==
59− ++ insify-noun
60− |= noun=*
61− ^- final-ins-diff
62− ?- noun
63− ^ [%cell $(noun -.noun) $(noun +.noun)]
64− @ [%atom noun]
65− ==
66− ++ empty-set (silt `(list @)`~)
67− ++ find-del-holes
68− |= diff=del-diff
69− ~+
70− ^- (set @)
71− ?- -.diff
72− %hole (silt ~[+.diff])
73− %cell
74− (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
75− %ignore empty-set
76− ==
77− ++ find-final-ins-holes
78− |= diff=final-ins-diff
79− ~+
80− ^- (set @)
81− ?- -.diff
82− %hole (silt ~[+.diff])
83− %cell
84− (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
85− %atom empty-set
86− ==
87− ++ find-ins-holes
88− |= diff=ins-diff
89− ~+
90− ^- (set @)
91− ?- -.diff
92− %hole (silt ~[+<.diff])
93− %cell
94− (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
95− %atom empty-set
96− ==
97− ++ filter-del-holes
98− |= [allowed-holes=(set @) diff=del-diff]
99− ^- del-diff
100− ?: ?=(%ignore -.diff) diff
101− ?- -.diff
102− %hole
103− ?: (~(has in allowed-holes) +.diff) diff
104− [%ignore ~]
105− %cell [%cell $(diff +<.diff) $(diff +>.diff)]
106− ==
107− ++ filter-ins-holes
108− |= [allowed-holes=(set @) diff=ins-diff]
109− ^- final-ins-diff
110− ?- -.diff
111− %hole
112− ?: (~(has in allowed-holes) +<.diff) [%hole +<.diff]
113− (insify-noun original:diff)
114− %cell [%cell $(diff +<.diff) $(diff +>.diff)]
115− %atom diff
116− ==
117− ++ gcp
118− |= diff=diff
119− ^- patch
120− ?- -.ins.diff
121− %atom
122− [%diff diff]
123− %cell
124− ?: ?=(%cell -.del.diff)
125− [%cell $(diff [+<.del.diff +<.ins.diff]) $(diff [+>.del.diff +>.ins.diff])]
126− [%diff diff]
127− %hole
128− [%diff diff]
129− ==
130− ++ closure
131− |= =patch
132− ^- [^patch ?]
133− ?- -.patch
134− %diff
135− =/ del-holes (find-del-holes del:patch)
136− =/ ins-holes (find-final-ins-holes ins:patch)
137− =/ difference (~(dif in ins-holes) del-holes)
138− [patch =(difference empty-set)]
139− %cell
140− =/ lhs $(patch lhs:patch)
141− =/ rhs $(patch rhs:patch)
142− ?: ?&(+.lhs +.rhs) [[%cell -.lhs -.rhs] &]
143− $(patch (pull-diff [%cell -.lhs -.rhs]))
144− ==
145− ++ pull-diff
146− |= =patch
147− ^- [%diff del=del-diff ins=final-ins-diff]
148− ?- -.patch
149− %diff patch
150− %cell
151− =/ pulled-lhs $(patch lhs:patch)
152− =/ pulled-rhs $(patch rhs:patch)
153− :+
154− %diff
155− [%cell del:pulled-lhs del:pulled-rhs]
156− [%cell ins:pulled-lhs ins:pulled-rhs]
157− ==
158− ++ is-subtree
159− |= [tree=* subtree=*]
160− ~+
161− ^- ?
162− ?: =(tree subtree) &
163− ?@ tree |
164− ?|
165− (is-subtree -.tree subtree)
166− (is-subtree +.tree subtree)
167− ==
168− ++ oracle
169− |= [a=* b=*]
170− |= subtree=*
171− ^- (unit @)
172− ?:
173− ?&
174− (is-subtree a subtree)
175− (is-subtree b subtree)
176− ==
177− `(mug subtree)
178− ~
179− ++ extract-del
180− |= [oracle=$-(* (unit @)) subtree=*]
181− ~+
182− ^- del-diff
183− =/ hash (oracle subtree)
184− ?^ hash [%hole +.hash]
185− ?@ subtree [%ignore ~]
186− [%cell (extract-del oracle -.subtree) (extract-del oracle +.subtree)]
187− ++ extract-ins
188− |= [oracle=$-(* (unit @)) subtree=*]
189− ~+
190− ^- ins-diff
191− =/ hash (oracle subtree)
192− ?^ hash [%hole +.hash subtree]
193− ?@ subtree [%atom subtree]
194− [%cell (extract-ins oracle -.subtree) (extract-ins oracle +.subtree)]
195− ++ ins
196− |= [diff=final-ins-diff var-map=(map @ *)]
197− ^- *
198− ?- -.diff
199− %atom
200− +.diff
201− %cell
202− [$(diff +<.diff) $(diff +>.diff)]
203− %hole
204− (~(got by var-map) +.diff)
205− ==
206− ++ del
207− |= [diff=del-diff noun=*]
208− ^- (map @ *)
209− |^ (go diff noun ((map @ *) ~))
210− ++ go
211− |= [diff=del-diff noun=* var-map=(map @ *)]
212− ^- (map @ *)
213− ?- -.diff
214− %ignore var-map
215− %hole
216− =/ subtree (~(get by var-map) +.diff)
217− ?~ subtree (~(put by var-map) +.diff noun)
218− ?> =(+.subtree noun)
219− var-map
220− %cell
221− ?> ?=(^ noun)
222− =/ lhs-var-map $(diff +<.diff, noun -.noun)
223− =/ rhs-var-map $(diff +>.diff, noun +.noun, var-map lhs-var-map)
224− rhs-var-map
225− ==
226− --
227−--
example/urbit/lib/sink.hoondeleted−26
@@ -1,26 +0,0 @@
1−/+ noun-diff
2−|%
3−++ clog
4− |$ [stut]
5− $%
6− [%flush stut]
7− [%drain patch:noun-diff]
8− ==
9−++ sink
10− |* pats=(list path)
11− |* stat=*
12− |@
13− ++ sync
14− |= [stat=_stat]
15− ^- [card:agent:gall _..sync]
16− =/ dif
17− %+ diff:noun-diff ^stat stat
18− :-
19− [%give %fact pats %noun !>(^-((clog) [%drain dif]))]
20− ..sync(stat stat)
21− ++ paths pats
22− ++ flush
23− ^- card:agent:gall
24− [%give %fact pats %noun !>(^-((clog) [%flush stat]))]
25− --
26−--
res/airlock.jpegdeleted

Binary file not shown.

src/BitWriter.elm+5−5
@@ -14,17 +14,17 @@ import Bytes.Encode as BE
1414
1515empty : BitWriter
1616empty =
17− BitWriter { running = Nothing, collected = [], offset = 0 }
17+ BitWriter { running = Nothing, collected = BE.sequence [], offset = 0 }
1818
1919
2020run : BitWriter -> Bytes
2121run (BitWriter { running, collected }) =
2222 case running of
2323 Nothing ->
24− BE.encode (collected |> List.reverse |> BE.sequence)
24+ BE.encode collected
2525
2626 Just { value } ->
27− BE.sequence (BE.unsignedInt8 value :: collected |> List.reverse) |> BE.encode
27+ BE.sequence [ collected, BE.unsignedInt8 value ] |> BE.encode
2828
2929
3030type BitWriter
@@ -35,7 +35,7 @@ type BitWriter
3535 , length : Int
3636 }
3737 , offset : Int
38− , collected : List BE.Encoder
38+ , collected : BE.Encoder
3939 }
4040
4141
@@ -68,7 +68,7 @@ bit b (BitWriter { running, collected, offset }) =
6868 if length == 7 then
6969 BitWriter
7070 { running = Nothing
71− , collected = BE.unsignedInt8 newValue :: collected
71+ , collected = BE.sequence [ collected, BE.unsignedInt8 newValue ]
7272 , offset = newOffset
7373 }
7474
src/Ur.elm+209−82
@@ -1,26 +1,43 @@
1−module Ur exposing (logIn, getShipName, scry, scryTask)
2−
3−{-|
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
423
524
6−# Simple requests
25+{-| An Urbit agent (app) name like `journal` or 'groups'.
26+-}
27+type alias Agent =
28+ String
729
8−@docs logIn, getShipName, scry, scryTask
930
31+{-| An Urbit subscription path.
1032-}
11−
12−import Http
13−import Platform exposing (Task)
14−import Task
15−import Ur.Deconstructor as D
16−import Ur.Types exposing (..)
33+type alias Path =
34+ List String
1735
1836
19−{-| Logs into your Urbit at the given root path and password.
37+type alias Mark =
38+ String
2039
21− logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
2240
23−-}
2441logIn : String -> String -> Cmd (Result Http.Error ())
2542logIn root password =
2643 Http.riskyRequest
@@ -37,13 +54,7 @@ logIn root password =
3754 }
3855
3956
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)
57+getShipName : String -> Cmd (Result Http.Error String)
4758getShipName root =
4859 Http.riskyRequest
4960 { url = root ++ "/~/name"
@@ -56,64 +67,180 @@ getShipName root =
5667 }
5768
5869
59−{-| Scry an agent at some path
60−
61− scry
62− { url = "http://localhost:8080"
63− , agent = "journal"
64− , path = [ "entries", "all" ]
65− , error = Noop
66− , success =
67− D.cell D.ignore
68− (D.cell (D.const D.cord "jrnl")
69− (D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
70− |> D.map GotListings
71− )
72− }
73−
74−-}
75−scry :
76− { url : String
77− , agent : Agent
78− , path : Path
79− , error : msg
80− , success : D.Deconstructor msg
81− }
82− -> Cmd msg
83−scry args =
84− scryTask args |> Task.perform identity
85−
86−
87−{-| Same as `scry` but returns a `Task` instead of a `Cmd`.
88−-}
89−scryTask :
90− { url : String
91− , agent : Agent
92− , path : Path
93− , error : msg
94− , success : D.Deconstructor msg
95− }
96− -> Task a msg
97−scryTask { url, agent, path, error, success } =
98− Http.riskyTask
99− { method = "GET"
100− , headers = []
101− , url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"
102− , body = Http.emptyBody
103− , resolver =
104− Http.bytesResolver
105− (\resp ->
106− case resp of
107− Http.GoodStatus_ _ bytes ->
108− case D.runBytes success bytes of
109− Just msg ->
110− Ok msg
111−
112− Nothing ->
113− Ok error
114−
115− _ ->
116− Ok error
117− )
118− , timeout = Nothing
119− }
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)
src/Ur/Cmd.elm+10−27
@@ -1,52 +1,35 @@
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−
1+module Ur.Cmd exposing
2+ ( Cmd
3+ , batch
4+ , cmd
5+ , none
6+ , poke
7+ )
8+
9+import Ur exposing (Agent, Mark, Noun)
910import Ur.Cmd.Internal
10−import Ur.Types exposing (Agent, Mark, Noun, Ship)
11+import Ur.Phonemic exposing (Ship)
1112
1213
13−{-| Like `Cmd` from `Platform.Cmd`, but for Urbit commands.
14−-}
1514type alias Cmd msg =
1615 List (Ur.Cmd.Internal.Cmd msg)
1716
1817
19−{-| A command that does exactly nothing.
20−-}
2118none : Cmd msg
2219none =
2320 []
2421
2522
26−{-| Sends a %poke to a Gall Agent.
27−
28− poke
29− { ship = "~zod"
30− , agent = "journal"
31− , mark = "journal-action"
32− , noun = C.cell (C.cord "del") (C.bigint id)
33− }
34−
35−-}
3623poke : { ship : Ship, agent : Agent, mark : Mark, noun : Noun } -> Cmd msg
3724poke p =
3825 [ Ur.Cmd.Internal.Poke p ]
3926
4027
41−{-| Turns a `Platform.Cmd` command into a `Ur.Cmd` command.
42−-}
4328cmd : Cmd.Cmd msg -> Cmd msg
4429cmd c =
4530 [ Ur.Cmd.Internal.Cmd c ]
4631
4732
48−{-| Batches multiple commands into one. Similar to `Platform.Cmd.batch`.
49−-}
5033batch : List (Cmd msg) -> Cmd msg
5134batch =
5235 List.concat
src/Ur/Cmd/Internal.elm+2−1
@@ -1,6 +1,7 @@
11module Ur.Cmd.Internal exposing (Cmd(..))
22
3−import Ur.Types exposing (Agent, Mark, Noun, Ship)
3+import Ur exposing (Agent, Mark, Noun)
4+import Ur.Phonemic exposing (Ship)
45
56
67type Cmd msg
src/Ur/Constructor.elm+16−65
@@ -1,58 +1,35 @@
11module Ur.Constructor exposing
2− ( cell, sig, bytes
3− , int, signedInt, bigint
4− , float32, float64
5− , cord, tape
2+ ( Constructor
3+ , bigint
4+ , bytes
5+ , cell
6+ , cord
7+ , float32
8+ , float64
9+ , int
610 , listOf
11+ , sig
12+ , signedInt
13+ , tape
714 )
815
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−
3816import BigInt exposing (BigInt)
3917import BigInt.Bytes
4018import Bitwise
4119import Bytes exposing (Bytes, Endianness(..))
4220import Bytes.Encode as BE
43−import Ur.Types exposing (..)
21+import Ur exposing (..)
22+
23+
24+type alias Constructor a =
25+ a -> Noun
4426
4527
46−{-| Constructs a [Cell](https://developers.urbit.org/reference/glossary/cell) from two Nouns.
47−-}
4828cell : Noun -> Noun -> Noun
4929cell a b =
5030 Cell ( a, b )
5131
5232
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−-}
5633int : Int -> Noun
5734int i =
5835 Atom
@@ -69,15 +46,11 @@ int i =
6946 )
7047
7148
72−{-| Constructs an `Atom` from a `BigInt`.
73−-}
7449bigint : BigInt -> Noun
7550bigint x =
7651 Atom (BigInt.Bytes.encode x)
7752
7853
79−{-| Constructs an `Atom` from a signed `Int`.
80−-}
8154signedInt : Int -> Noun
8255signedInt i =
8356 int
@@ -89,34 +62,21 @@ signedInt i =
8962 )
9063
9164
92−{-| Constructs an `Atom` from `Bytes`.
93−-}
9465bytes : Bytes -> Noun
9566bytes =
9667 Atom
9768
9869
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−-}
10170cord : String -> Noun
10271cord s =
10372 Atom (BE.encode (BE.string s))
10473
10574
106−{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`.
107−-}
10875tape : String -> Noun
10976tape s =
11077 String.toList s |> List.map String.fromChar |> listOf cord
11178
11279
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−-}
12080listOf : (a -> Noun) -> List a -> Noun
12181listOf encEl list =
12282 case list of
@@ -127,25 +87,16 @@ listOf encEl list =
12787 cell (encEl x) (listOf encEl xs)
12888
12989
130−{-| The [`sig`](https://developers.urbit.org/reference/glossary/tape) value. Also known as `~`.
131−
132−It is equivalent to `0`.
133−
134−-}
13590sig : Noun
13691sig =
13792 Atom (BE.encode (BE.sequence []))
13893
13994
140−{-| Constructs an `Atom` from a 32-bit float.
141−-}
14295float32 : Float -> Noun
14396float32 f =
14497 Atom (BE.encode (BE.float32 LE f))
14598
14699
147−{-| Constructs an `Atom` from a 64-bit float.
148−-}
149100float64 : Float -> Noun
150101float64 f =
151102 Atom (BE.encode (BE.float64 LE f))
src/Ur/Da.elm−10
@@ -1,17 +1,9 @@
11module Ur.Da exposing (Da, posixToDa)
22
3−{-|
4−
5−@docs Da, posixToDa
6−
7−-}
8−
93import BigInt exposing (BigInt)
104import Time exposing (Posix)
115
126
13−{-| Represents a `@da`.
14−-}
157type alias Da =
168 BigInt
179
@@ -26,8 +18,6 @@ second =
2618 BigInt.fromIntString "18446744073709551616" |> Maybe.withDefault (BigInt.fromInt 0)
2719
2820
29−{-| Converts `Posix` to a `@da`.
30−-}
3121posixToDa : Posix -> Da
3222posixToDa p =
3323 BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000000)) unixEpochStart
src/Ur/Deconstructor.elm+198−293
@@ -1,64 +1,27 @@
11module Ur.Deconstructor exposing
22 ( Deconstructor
3− , run, runBytes
4− , cell, list, oneOf, const
3+ , alt
4+ , bigint
5+ , bytes
6+ , cell
7+ , const
8+ , cord
9+ , float32
10+ , float64
11+ , ignore
12+ , int
13+ , list
14+ , llec
515 , map
6− , int, signedInt, bigint
7− , float32, float64
8− , cord, tape
9− , bytes, sig, ignore, tar, lazy, debug
16+ , oneOf
17+ , run
18+ , runBytes
19+ , sig
20+ , signedInt
21+ , tape
22+ , tar
1023 )
1124
12−{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
13−
14−You would parse a `[%edit @ cord]` like this:
15−
16− type alias Edit = {id: Int, text : String}
17−
18− (D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord)) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
19−
20−@docs Deconstructor
21−
22−
23−# Running a `Deconstructor`
24−
25−@docs run, runBytes
26−
27−
28−# Higher-order `Deconstructor`s
29−
30−@docs cell, list, oneOf, const
31−
32−
33−# Mapping a `Deconstructor`
34−
35−@docs map
36−
37−
38−# Numbers
39−
40−
41−## `Int`a
42−
43−@docs int, signedInt, bigint
44−
45−
46−## `Float`s
47−
48−@docs float32, float64
49−
50−
51−# `String`s
52−
53−@docs cord, tape
54−
55−
56−# Miscellaneous
57−
58−@docs bytes, sig, ignore, tar, lazy, debug
59−
60−-}
61−
6225import BigInt exposing (BigInt)
6326import BigInt.Bytes
6427import Bitwise
@@ -66,74 +29,107 @@ import Bytes exposing (Bytes, Endianness(..))
6629import Bytes.Decode as BD
6730import Bytes.Encode as BE
6831import Bytes.Extra
69−import Ur.Jam exposing (cue, isSig)
70−import Ur.Types exposing (..)
32+import Ur exposing (..)
33+
7134
35+type Deconstructor a b
36+ = Deconstructor (Noun -> a -> Maybe b)
7237
73−{-| A `Noun` deconstructor.
74−-}
75−type alias Deconstructor a =
76− Noun -> Maybe a
7738
39+run : Deconstructor (a -> a) a -> Noun -> Maybe a
40+run (Deconstructor f) noun =
41+ f noun identity
42+
43+
44+runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
45+runBytes (Deconstructor f) bs =
46+ cue bs
47+ |> Maybe.andThen
48+ (\noun -> f noun identity)
49+
50+
51+const : Deconstructor (a -> a) a -> a -> Deconstructor c c
52+const (Deconstructor f) value =
53+ Deconstructor
54+ (\noun c ->
55+ case f noun identity of
56+ Just a ->
57+ if a == value then
58+ Just c
59+
60+ else
61+ Nothing
7862
79−{-| Executes a `Deconstructor` on a `Noun`.
80−-}
81−run : Deconstructor a -> Noun -> Maybe a
82−run f noun =
83− f noun
63+ Nothing ->
64+ Nothing
65+ )
8466
8567
86−{-| Executes a deconstructor on a `jam`med `Noun`.
87−-}
88−runBytes : Deconstructor a -> Bytes -> Maybe a
89−runBytes f bs =
90− cue bs |> Maybe.andThen f
68+cord : Deconstructor (String -> a) a
69+cord =
70+ Deconstructor
71+ (\x f ->
72+ case x of
73+ Atom bs ->
74+ BD.decode (BD.string (Bytes.width bs)) bs
75+ |> Maybe.map f
9176
77+ Cell _ ->
78+ Nothing
79+ )
9280
93−{-| Asserts that the value should be exactly equal to the second argument.
9481
95−The first argument is a `Deconstructor` for the given type.
82+tape : Deconstructor (String -> a) a
83+tape =
84+ list cord |> fmap String.concat
9685
97−The second argument is the value to compare with.
9886
99−This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
87+int : Deconstructor (Int -> a) a
88+int =
89+ Deconstructor
90+ (\x f ->
91+ case x of
92+ Atom bs ->
93+ (case Bytes.width bs of
94+ 1 ->
95+ BD.decode BD.unsignedInt8 bs
10096
101−-}
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 ()
97+ 2 ->
98+ BD.decode (BD.unsignedInt16 LE) bs
10899
109− else
110− Nothing
100+ 3 ->
101+ BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
111102
112− Nothing ->
113− Nothing
103+ 4 ->
104+ BD.decode (BD.unsignedInt32 LE) bs
114105
106+ _ ->
107+ Nothing
108+ )
109+ |> Maybe.map f
115110
116−{-| Extracts a `BigInt`.
117−-}
118−bigint : Deconstructor BigInt
119−bigint x =
120− case x of
121− Atom bs ->
122− BigInt.Bytes.decode bs |> Just
111+ Cell _ ->
112+ Nothing
113+ )
123114
124− Cell _ ->
125− Nothing
126115
116+bigint : Deconstructor (BigInt -> a) a
117+bigint =
118+ Deconstructor
119+ (\x f ->
120+ case x of
121+ Atom bs ->
122+ BigInt.Bytes.decode bs |> f |> Just
127123
128−{-| Extracts a 32-bit signed `Int`.
124+ Cell _ ->
125+ Nothing
126+ )
129127
130−If the `Atom` is larger than 32 bits the the behaviour is undefined.
131128
132−-}
133−signedInt : Deconstructor Int
129+signedInt : Deconstructor (Int -> a) a
134130signedInt =
135131 int
136− |> map
132+ |> fmap
137133 (\i ->
138134 if Bitwise.and 1 i == 1 then
139135 -(Bitwise.shiftRightBy 1 (1 + i))
@@ -143,236 +139,145 @@ signedInt =
143139 )
144140
145141
146−{-| Extracts a 32-bit `Float`.
147−-}
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
156−
157−
158−{-| Extracts a 64-bit `Float`.
159−-}
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
142+float32 : Deconstructor (Float -> a) a
143+float32 =
144+ Deconstructor
145+ (\x f ->
146+ case x of
147+ Atom bs ->
148+ BD.decode (BD.float32 LE) bs
149+ |> Maybe.map f
168150
151+ Cell _ ->
152+ Nothing
153+ )
169154
170−{-| Extracts the raw `Byte`s of an `Atom`.
171−-}
172−bytes : Deconstructor Bytes
173−bytes n =
174− case n of
175− Atom bs ->
176− Just bs
177155
178− Cell _ ->
179− Nothing
156+float64 : Deconstructor (Float -> a) a
157+float64 =
158+ Deconstructor
159+ (\x f ->
160+ case x of
161+ Atom bs ->
162+ BD.decode (BD.float64 LE) bs
163+ |> Maybe.map f
180164
165+ Cell _ ->
166+ Nothing
167+ )
181168
182−{-| Asserts the the `Atom` should be exactly `sig` (`~`).
183−-}
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 ()
190169
191− else
192− Nothing
170+bytes : Deconstructor (Bytes -> a) a
171+bytes =
172+ Deconstructor
173+ (\n f ->
174+ case n of
175+ Atom bs ->
176+ f bs |> Just
193177
194− Cell _ ->
195− Nothing
178+ Cell _ ->
179+ Nothing
180+ )
196181
197182
198−{-| Extracts a sig-terminated list of arbitrary elements.
183+sig : Deconstructor a a
184+sig =
185+ Deconstructor
186+ (\n a ->
187+ case n of
188+ Atom b ->
189+ if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
190+ Just a
199191
200−The first argument is a `Deconstructor` of the elements of the list.
192+ else
193+ Nothing
201194
202−-}
203−list : Deconstructor a -> Deconstructor (List a)
204−list f n =
205− let
206− go n_ =
207− case n_ of
208− Atom _ ->
209− Just []
195+ Cell _ ->
196+ Nothing
197+ )
210198
211− Cell ( el, tail ) ->
212− Maybe.map2 (\a b -> a :: b) (f el) (go tail)
213− in
214− go n
215199
200+list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
201+list (Deconstructor f) =
202+ Deconstructor
203+ (\n g ->
204+ let
205+ go n_ =
206+ case n_ of
207+ Atom _ ->
208+ Just []
216209
217−alt : Deconstructor a -> Deconstructor a -> Deconstructor a
218−alt f g n =
219− case f n of
220− Just x ->
221− Just x
210+ Cell ( el, tail ) ->
211+ Maybe.map2 (\a b -> a :: b) (f el identity) (go tail)
212+ in
213+ go n |> Maybe.map g
214+ )
222215
223− Nothing ->
224− g n
225216
217+alt : Deconstructor a b -> Deconstructor a b -> Deconstructor a b
218+alt (Deconstructor f) (Deconstructor g) =
219+ Deconstructor
220+ (\n a ->
221+ case f n a of
222+ Just x ->
223+ Just x
226224
227−{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
225+ Nothing ->
226+ g n a
227+ )
228228
229−This is especially useful for deconstructing head-tagged unions from Hoon.
230229
231−-}
232−oneOf : List (Deconstructor a) -> Deconstructor a
230+oneOf : List (Deconstructor a b) -> Deconstructor a b
233231oneOf l =
234232 case l of
235233 [] ->
236− always Nothing
234+ Deconstructor (\_ _ -> Nothing)
237235
238236 x :: xs ->
239237 alt x (oneOf xs)
240238
241239
242−{-| Ignore any value.
240+tar : Deconstructor (Noun -> a) a
241+tar =
242+ Deconstructor (\noun f -> Just (f noun))
243243
244−This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
245244
246−-}
247−ignore : Deconstructor ()
245+ignore : Deconstructor a a
248246ignore =
249− always (Just ())
250−
251−
252−{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
253−
254−Accepts two arbitrary `Deconstructor`s that form a Cell.
255−
256−-}
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 )))
262−
263− Atom _ ->
264− Nothing
265−
266−
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.
270−
271−-}
272−lazy : (() -> Deconstructor a) -> Deconstructor a
273−lazy f noun =
274− f () noun
275−
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
282−
283−
284−{-| Extracts a `cord`.
285−-}
286−cord : Deconstructor String
287−cord x =
288− case x of
289− Atom bs ->
290− BD.decode (BD.string (Bytes.width bs)) bs
291−
292− Cell _ ->
293− Nothing
294−
295−
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.
306−
307−-}
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
247+ Deconstructor (\_ f -> Just f)
318248
319− 3 ->
320− BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
321249
322− 4 ->
323− BD.decode (BD.unsignedInt32 LE) bs
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)
324257
325− _ ->
258+ Atom _ ->
326259 Nothing
260+ )
327261
328− Cell _ ->
329− Nothing
330−
331−
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
350262
351− Nothing ->
352− let
353− _ =
354− log (prettyNoun noun)
355− in
356− Nothing
263+cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
264+cell (Deconstructor l) (Deconstructor r) =
265+ Deconstructor
266+ (\noun a ->
267+ case noun of
268+ Cell ( lhs, rhs ) ->
269+ l lhs a |> Maybe.andThen (\b -> r rhs b)
357270
271+ Atom _ ->
272+ Nothing
273+ )
358274
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− "~"
367275
368− else
369− "@"
276+map : a -> Deconstructor a b -> Deconstructor (b -> c) c
277+map a (Deconstructor f) =
278+ Deconstructor (\noun g -> f noun a |> Maybe.map g)
370279
371− Cell ( lhs, rhs ) ->
372− if isRhs then
373− go False lhs ++ " " ++ go True rhs
374280
375− else
376− "[" ++ go False lhs ++ " " ++ go True rhs ++ "]"
377− in
378− go False noun
281+fmap : (a -> b) -> Deconstructor (a -> c) c -> Deconstructor (b -> c) c
282+fmap f (Deconstructor g) =
283+ Deconstructor (\noun h -> g noun (f >> h))
src/Ur/Jam.elmdeleted−193
@@ -1,193 +0,0 @@
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/NounDiff.elmdeleted−115
@@ -1,115 +0,0 @@
1−module Ur.NounDiff exposing (Patch, apply, deconstructPatch)
2−
3−import Bytes.Extra
4−import Dict exposing (Dict)
5−import Ur.Deconstructor as D
6−import Ur.Types exposing (..)
7−
8−
9−type Patch
10− = PatchCell Patch Patch
11− | Diff DelDiff InsDiff
12−
13−
14−deconstructPatch : () -> D.Deconstructor Patch
15−deconstructPatch () =
16− D.oneOf
17− [ D.cell (D.const D.cord "cell")
18− (D.cell
19− (D.lazy deconstructPatch)
20− (D.lazy deconstructPatch)
21− )
22− |> D.map (\( (), ( a, b ) ) -> PatchCell a b)
23− , D.cell (D.const D.cord "diff") (D.cell (D.lazy deconstructDel) (D.lazy deconstructIns))
24− |> D.map (\( (), ( a, b ) ) -> Diff a b)
25− ]
26−
27−
28−apply : Patch -> Noun -> Noun
29−apply patch noun =
30− case ( patch, noun ) of
31− ( PatchCell lhs rhs, Cell ( lhs_, rhs_ ) ) ->
32− Cell ( apply lhs lhs_, apply rhs rhs_ )
33−
34− ( Diff delDiff insDiff, _ ) ->
35− ins insDiff (del delDiff noun)
36−
37− _ ->
38− noun
39−
40−
41−del : DelDiff -> Noun -> Dict Int Noun
42−del diff noun =
43− let
44− go : DelDiff -> Noun -> Dict Int Noun -> Dict Int Noun
45− go diff_ noun_ dict =
46− case ( diff_, noun_ ) of
47− ( Ignore, _ ) ->
48− dict
49−
50− ( DelCell lhsDiff rhsDiff, Cell ( lhs, rhs ) ) ->
51− go lhsDiff lhs (go rhsDiff rhs dict)
52−
53− ( DelHole hole, _ ) ->
54− -- There should be a continuity check here.
55− -- Check that the noun_ is equal to whatever the hole maps to in dict.
56− -- I don't include it for speed and laziness reasons.
57− Dict.insert hole noun_ dict
58−
59− _ ->
60− dict
61− in
62− go diff noun Dict.empty
63−
64−
65−ins : InsDiff -> Dict Int Noun -> Noun
66−ins diff dict =
67− case diff of
68− InsAtom a ->
69− Atom a
70−
71− InsHole hole ->
72− Dict.get hole dict |> Maybe.withDefault (Atom Bytes.Extra.empty)
73−
74− InsCell lhs rhs ->
75− Cell ( ins lhs dict, ins rhs dict )
76−
77−
78−type DelDiff
79− = Ignore
80− | DelHole Int
81− | DelCell DelDiff DelDiff
82−
83−
84−deconstructDel : () -> D.Deconstructor DelDiff
85−deconstructDel () =
86− D.oneOf
87− [ D.cell (D.const D.cord "ignore") D.ignore |> D.map (\( (), () ) -> Ignore)
88− , D.cell (D.const D.cord "hole") D.int |> D.map (\( (), x ) -> DelHole x)
89− , D.cell (D.const D.cord "cell")
90− (D.cell
91− (D.lazy deconstructDel)
92− (D.lazy deconstructDel)
93− )
94− |> D.map (\( (), ( lhs, rhs ) ) -> DelCell lhs rhs)
95− ]
96−
97−
98−type InsDiff
99− = InsAtom Atom
100− | InsHole Int
101− | InsCell InsDiff InsDiff
102−
103−
104−deconstructIns : () -> D.Deconstructor InsDiff
105−deconstructIns () =
106− D.oneOf
107− [ D.cell (D.const D.cord "hole") D.int |> D.map (\( (), x ) -> InsHole x)
108− , D.cell (D.const D.cord "atom") D.bytes |> D.map (\( (), bs ) -> InsAtom bs)
109− , D.cell (D.const D.cord "cell")
110− (D.cell
111− (D.lazy deconstructIns)
112− (D.lazy deconstructIns)
113− )
114− |> D.map (\( (), ( a, b ) ) -> InsCell a b)
115− ]
src/Ur/Phonemic.elm+12−9
@@ -1,19 +1,22 @@
1−module Ur.Phonemic exposing (fromString)
2−
3−{-|
4−
5−@docs fromString
6−
7−-}
1+module Ur.Phonemic exposing (Ship, fromString)
82
93import BigInt.Bytes
104import Bytes.Extra
11−import Ur.Types exposing (Atom, Noun(..), Ship)
5+import Ur exposing (Atom, Noun(..))
126import Urbit.Encoding.Atom exposing (toBigInt)
137import Urbit.Encoding.Phonemic exposing (..)
148
159
16−{-| Converts a ship name like `~zod` into an `Atom`.
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.
1720-}
1821fromString : Ship -> Atom
1922fromString s =
src/Ur/Requests.elm+53−7
@@ -1,6 +1,8 @@
11module Ur.Requests exposing
22 ( EventId
33 , UrbitRequest(..)
4+ , scry
5+ , scryTask
46 , send
57 , sendTask
68 , tag
@@ -11,9 +13,8 @@ import Http
1113import Task exposing (Task)
1214import Ur exposing (..)
1315import Ur.Constructor as C
14−import Ur.Jam exposing (jam)
15−import Ur.Phonemic
16−import Ur.Types exposing (..)
16+import Ur.Deconstructor as D
17+import Ur.Phonemic exposing (Ship)
1718import Ur.Uw
1819
1920
@@ -67,7 +68,7 @@ sendTask { url, error, success, requests } =
6768 requests
6869 |> List.map (uncurry toNoun)
6970 |> C.listOf identity
70− |> jam
71+ |> Ur.jam
7172 |> Ur.Uw.encode
7273 |> Http.stringBody "application/x-urb-jam"
7374 , resolver =
@@ -88,23 +89,68 @@ type alias EventId =
8889 Int
8990
9091
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+
91137toNoun : EventId -> UrbitRequest -> Noun
92138toNoun eventId req =
93139 case req of
94140 Subscribe ( ship, app, path ) ->
95141 C.cell (C.cord "subscribe") <|
96142 C.cell (C.int eventId) <|
97− C.cell (Atom (Ur.Phonemic.fromString ship)) <|
143+ C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
98144 C.cell (C.cord app) (C.listOf C.cord path)
99145
100146 Unsubscribe subId ->
101− C.cell (C.cord "unsubscribe") <|
147+ C.cell (C.cord "usubscribe") <|
102148 C.cell (C.int eventId) (C.int subId)
103149
104150 Poke { ship, agent, mark, noun } ->
105151 C.cell (C.cord "poke") <|
106152 C.cell (C.int eventId) <|
107− C.cell (Atom (Ur.Phonemic.fromString ship)) <|
153+ C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
108154 C.cell (C.cord agent) <|
109155 C.cell (C.cord mark) <|
110156 noun
src/Ur/Run.elm+27−144
@@ -1,28 +1,22 @@
1−module Ur.Run exposing (element, document, application, Program, Model, Msg)
2−
3−{-| This module contains functions to run your application with Urbit integration.
4−
5−@docs element, document, application, Program, Model, Msg
6−
7−-}
1+module Ur.Run exposing (Model, Msg, Program, application)
82
93import Browser exposing (Document, UrlRequest)
104import Browser.Navigation as Nav
115import Dict exposing (Dict)
126import Either exposing (Either(..))
13−import Html exposing (Html)
7+import Html
148import Json.Decode as JD
159import Task
1610import Time
11+import Ur exposing (Agent, Path)
1712import Ur.Cmd
1813import Ur.Cmd.Internal
1914import Ur.Constructor as C
2015import Ur.Deconstructor as D
21−import Ur.NounDiff exposing (Patch, deconstructPatch)
16+import Ur.Phonemic exposing (Ship)
2217import Ur.Requests exposing (..)
2318import Ur.Sub
2419import Ur.Sub.Internal
25−import Ur.Types exposing (..)
2620import Ur.Uw
2721import Url exposing (Url)
2822
@@ -31,9 +25,8 @@ type alias SubDict msg =
3125 Dict
3226 -- (ship, agent, path)
3327 ( String, String, List String )
34− { deconstructor : D.Deconstructor msg
28+ { deconstructor : D.Deconstructor (msg -> msg) msg
3529 , number : Int
36− , sink : Bool
3730 }
3831
3932
@@ -41,8 +34,6 @@ type alias Flags =
4134 { uid : String }
4235
4336
44−{-| An Urbit wrapper around your application model.
45−-}
4637type alias Model app msg =
4738 { subscriptions : SubDict msg
4839 , subscriptionIntMapping : Dict Int ( String, String, List String )
@@ -51,12 +42,9 @@ type alias Model app msg =
5142 , eventId : Int
5243 , flags : Flags
5344 , requestsToRetry : List UrbitRequest
54− , sinks : Dict Int Noun
5545 }
5646
5747
58−{-| An Urbit wrapper around your application messages.
59−-}
6048type Msg msg
6149 = AppMsg msg
6250 | EventSourceMsg JD.Value
@@ -67,61 +55,10 @@ type Msg msg
6755 | RetryRequests
6856
6957
70−{-| A wrapper around your application `Program`.
71−-}
7258type alias Program model msg =
7359 Platform.Program Flags (Model model msg) (Msg msg)
7460
7561
76−{-| The same as `Browser.element` but with urbit stuff added around it.
77−-}
78−element :
79− { init : ( model, Ur.Cmd.Cmd msg )
80− , view : model -> Html msg
81− , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
82− , subscriptions : model -> Sub msg
83− , urbitSubscriptions : model -> Ur.Sub.Sub msg
84− , createEventSource : String -> Cmd (Msg msg)
85− , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
86− , urbitUrl : model -> String
87− }
88− -> Program model msg
89−element inp =
90− Browser.element
91− { init = init inp inp.init
92− , view = \model -> inp.view model.app |> Html.map AppMsg
93− , update = update inp
94− , subscriptions = subscriptions inp
95− }
96−
97−
98−{-| The same as `Browser.element` but with urbit stuff added around it.
99−-}
100−document :
101− { init : ( model, Ur.Cmd.Cmd msg )
102− , view : model -> Document msg
103− , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
104− , subscriptions : model -> Sub msg
105− , urbitSubscriptions : model -> Ur.Sub.Sub msg
106− , createEventSource : String -> Cmd (Msg msg)
107− , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
108− , urbitUrl : model -> String
109− }
110− -> Program model msg
111−document inp =
112− Browser.document
113− { init = init inp inp.init
114− , view =
115− \model ->
116− inp.view model.app
117− |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })
118− , update = update inp
119− , subscriptions = subscriptions inp
120− }
121−
122−
123−{-| The same as `Browser.element` but with urbit stuff added around it.
124−-}
12562application :
12663 { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
12764 , view : model -> Document msg
@@ -174,11 +111,12 @@ update inp msg model =
174111 ( appModel, appCmds ) =
175112 inp.update msg_ model.app
176113
114+ -- { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =
177115 subsResult =
178116 processUrSubs
179117 model.eventId
180118 model.subscriptions
181− (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))
119+ (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))
182120
183121 ( eventId_, cmds, urReqs ) =
184122 processCmd subsResult.eventId appCmds
@@ -211,10 +149,12 @@ update inp msg model =
211149 Ok string ->
212150 case
213151 D.runBytes
214− (D.cell D.int (D.cell D.cord D.tar))
152+ (D.cell D.int (D.cell D.cord D.tar)
153+ |> D.map (\a b c -> ( a, b, c ))
154+ )
215155 (Ur.Uw.decode string)
216156 of
217− Just ( messageId, ( messageType, rest ) ) ->
157+ Just ( messageId, messageType, rest ) ->
218158 let
219159 ( eventId, ackReqs ) =
220160 tag model.eventId [ Ack messageId ]
@@ -244,51 +184,14 @@ update inp msg model =
244184 Dict.get messageId model.subscriptionIntMapping
245185 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
246186 of
247− Just { deconstructor, sink } ->
248− if sink then
249− case D.run (D.cell D.ignore (D.cell D.ignore deconstructSink) |> D.map (\( (), ( (), s ) ) -> s)) rest of
250− Just (Flush noun) ->
251− ( { model | sinks = Dict.insert messageId noun model.sinks }
252− , case D.run deconstructor noun of
253− Just subMsg ->
254− pureCmd (AppMsg subMsg)
255−
256− -- Got garbage
257− Nothing ->
258− Cmd.none
259− )
260−
261− Just (Drain patch) ->
262− case Dict.get messageId model.sinks of
263− Just oldNoun ->
264− let
265− newNoun =
266− Ur.NounDiff.apply patch oldNoun
267− in
268− ( { model | sinks = Dict.insert messageId newNoun model.sinks }
269− , case D.run deconstructor newNoun of
270− Just subMsg ->
271− pureCmd (AppMsg subMsg)
272−
273− Nothing ->
274− Cmd.none
275− )
276−
277− Nothing ->
278− ( model, Cmd.none )
279−
280− -- Got garbage
281− Nothing ->
282− ( model, Cmd.none )
283−
284− else
285− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor) |> D.map (\( (), ( (), m ) ) -> m)) rest of
286− Just subMsg ->
287− ( model_, pureCmd (AppMsg subMsg) )
288−
289− -- Got gargbage
290− Nothing ->
291− ( model_, ackCmd )
187+ Just { deconstructor } ->
188+ case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
189+ Just subMsg ->
190+ ( model_, pureCmd (AppMsg subMsg) )
191+
192+ -- Got gargbage
193+ Nothing ->
194+ ( model_, ackCmd )
292195
293196 -- Got a fact for a subscription we do not hold
294197 Nothing ->
@@ -313,11 +216,11 @@ update inp msg model =
313216 NeedsActivation ->
314217 let
315218 ( eventId, reqs ) =
316− [ Poke { ship = "", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
219+ [ Poke { ship = "~zod", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
317220 |> tag model.eventId
318221 in
319222 ( { model | eventId = eventId }
320− , send { url = url, requests = reqs, success = OpenConnection, error = Noop }
223+ , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }
321224 )
322225
323226 Noop ->
@@ -344,19 +247,6 @@ update inp msg model =
344247 )
345248
346249
347−type Sink
348− = Flush Noun
349− | Drain Patch
350−
351−
352−deconstructSink : D.Deconstructor Sink
353−deconstructSink =
354− D.oneOf
355− [ D.cell (D.const D.cord "flush") D.tar |> D.map (\( (), n ) -> Flush n)
356− , D.cell (D.const D.cord "drain") (D.lazy deconstructPatch) |> D.map (\( (), patch ) -> Drain patch)
357− ]
358−
359−
360250processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
361251processCmd eventId urCmds =
362252 let
@@ -386,10 +276,10 @@ pureCmd msg =
386276
387277processUrSubs :
388278 EventId
389− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
390− -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }
279+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
280+ -> Dict ( Ship, Agent, Path ) d
391281 ->
392− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
282+ { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
393283 , eventId : EventId
394284 , subscriptionRequests : List ( EventId, UrbitRequest )
395285 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
@@ -398,7 +288,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
398288 let
399289 urbitSubs =
400290 urbitSubs_
401− |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })
291+ |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })
402292
403293 ( eventId_, newSubscriptionActions ) =
404294 Dict.diff urbitSubs existingSubscriptions
@@ -421,11 +311,10 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
421311 newSubscriptions =
422312 Dict.merge
423313 (\_ _ x -> x)
424− (\key number { deconstructor, sink } ->
314+ (\key number { deconstructor } ->
425315 Dict.insert key
426316 { deconstructor = deconstructor
427317 , number = number
428− , sink = sink
429318 }
430319 )
431320 (\_ _ x -> x)
@@ -468,7 +357,6 @@ init inp ( app, appCmds ) flags =
468357 inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
469358 in
470359 ( { subscriptions = subsResult.subscriptions
471− , sinks = Dict.empty
472360 , subscriptionIntMapping = subsResult.subscriptionIntMapping
473361 , app = app
474362 , connected = False
@@ -491,7 +379,7 @@ init inp ( app, appCmds ) flags =
491379
492380subscriptions :
493381 { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
494− -> { d | app : b, requestsToRetry : List e, connected : Bool }
382+ -> { d | app : b, requestsToRetry : List e }
495383 -> Sub (Msg msg)
496384subscriptions inp model =
497385 Sub.batch
@@ -502,9 +390,4 @@ subscriptions inp model =
502390
503391 else
504392 Time.every 1000 (always RetryRequests)
505− , if not model.connected then
506− Time.every 10000 (always NeedsActivation)
507−
508− else
509− Sub.none
510393 ]
src/Ur/Sub.elm+4−41
@@ -1,61 +1,24 @@
1−module Ur.Sub exposing (Sub, subscribe, none, batch, sink)
2−
3−{-| This module is conceptually similar to `Platform.Sub`, but allows you to subscribe to Urbit channels.
4−
5−@docs Sub, subscribe, none, batch, sink
6−
7−-}
1+module Ur.Sub exposing (Sub, batch, none, subscribe)
82
93import Dict
104import Ur.Deconstructor as D
115import Ur.Sub.Internal
126
137
14−{-| Like `Sub` from `Platform.Sub` but for Urbit subscriptions.
15−-}
168type alias Sub msg =
179 Ur.Sub.Internal.Sub msg
1810
1911
20−{-| Creates an Urbit subscription.
12+subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg
13+subscribe { ship, app, path, deconstructor } =
14+ Dict.singleton ( ship, app, path ) deconstructor |> Ur.Sub.Internal.Sub
2115
22− subscribe
23− { ship = ship
24− , app = "journal"
25− , path = [ "updates" ]
26− , deconstructor = decodeJournalUpdate |> D.map GotUpdate
27− }
2816
29−-}
30−subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor msg } -> Sub msg
31−subscribe { ship, app, path, deconstructor } =
32− Dict.singleton ( ship, app, path )
33− { deconstructor = deconstructor
34− , sink = False
35− }
36− |> Ur.Sub.Internal.Sub
37−
38−
39−{-| Creates a %sink subscription.
40−-}
41−sink : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor msg } -> Sub msg
42−sink { ship, app, path, deconstructor } =
43− Dict.singleton ( ship, app, path )
44− { deconstructor = deconstructor
45− , sink = True
46− }
47− |> Ur.Sub.Internal.Sub
48−
49−
50−{-| A subscription that does exactly nothing. (Does not subscribe to anything)
51−-}
5217none : Sub msg
5318none =
5419 Ur.Sub.Internal.Sub Dict.empty
5520
5621
57−{-| Batch multiple subscriptions into one.
58−-}
5922batch : List (Sub msg) -> Sub msg
6023batch subs =
6124 subs |> List.map (\(Ur.Sub.Internal.Sub dict) -> dict) |> List.foldl Dict.union Dict.empty |> Ur.Sub.Internal.Sub
src/Ur/Sub/Internal.elm+3−4
@@ -1,8 +1,9 @@
11module Ur.Sub.Internal exposing (Sub(..))
22
33import Dict exposing (Dict)
4+import Ur exposing (Agent, Path)
45import Ur.Deconstructor as D
5−import Ur.Types exposing (Agent, Path, Ship)
6+import Ur.Phonemic exposing (Ship)
67
78
89type Sub msg
@@ -10,7 +11,5 @@ type Sub msg
1011 (Dict
1112 -- key is (ship, app, path)
1213 ( Ship, Agent, Path )
13− { deconstructor : D.Deconstructor msg
14− , sink : Bool
15− }
14+ (D.Deconstructor (msg -> msg) msg)
1615 )
src/Ur/Types.elmdeleted−60
@@ -1,60 +0,0 @@
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+7−15
@@ -1,11 +1,5 @@
11module Ur.Uw exposing (decode, encode)
22
3−{-| This module works with Urbit base-64 encoded strings aka `@uw`.
4−
5−@docs decode, encode
6−
7−-}
8−
93import BitParser as BP
104import BitWriter as BW
115import Bitwise
@@ -15,7 +9,6 @@ import Dict
159import List.Extra
1610
1711
18−{-| -}
1912decode : String -> Bytes
2013decode string =
2114 if string == "0w0" then
@@ -29,27 +22,26 @@ decode string =
2922 -- 0w
3023 |> List.drop 2
3124
32− go : List Char -> List Int -> BW.BitWriter -> BW.BitWriter
33− go cs append writer =
25+ go : List Char -> BW.BitWriter -> BW.BitWriter
26+ go cs writer =
3427 case cs of
3528 [] ->
36− BW.bits append writer
29+ writer
3730
3831 '.' :: rest ->
39− go rest append writer
32+ go rest writer
4033
4134 c :: rest ->
4235 case Dict.get c charToBits of
4336 Just bits ->
44− go rest (bits ++ append) writer
37+ go rest writer |> BW.bits bits
4538
4639 Nothing ->
47− go rest [] writer
40+ go rest writer
4841 in
49− BW.run (go chars [] BW.empty)
42+ BW.run (go chars BW.empty)
5043
5144
52−{-| -}
5345encode : Bytes -> String
5446encode bytes =
5547 let
tests/Test/Urbit.elm+11−13
@@ -14,8 +14,6 @@ import Test.Utils exposing (..)
1414import Ur exposing (..)
1515import Ur.Constructor as C
1616import Ur.Deconstructor as D
17−import Ur.Jam exposing (cue, jam, mat, rub)
18−import Ur.Types exposing (..)
1917import Ur.Uw
2018
2119
@@ -77,7 +75,7 @@ tests =
7775 Expect.equal
7876 (Just ( 1, 2 ))
7977 (D.runBytes
80− (D.cell D.int D.int)
78+ (D.cell D.int D.int |> D.map Tuple.pair)
8179 (Bytes.fromByteValues [ 0x31, 0x12 ])
8280 )
8381 )
@@ -96,7 +94,7 @@ tests =
9694 Expect.equal
9795 (Just ( 4, [ 1, 2, 3 ] ))
9896 (D.runBytes
99− (D.cell D.int (D.list D.int))
97+ (D.cell D.int (D.list D.int) |> D.map Tuple.pair)
10098 (Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
10199 )
102100 )
@@ -105,7 +103,7 @@ tests =
105103 Expect.equal
106104 (Just ( 8, 11 ))
107105 (D.runBytes
108− (D.cell D.float32 D.float32)
106+ (D.cell D.float32 D.float32 |> D.map Tuple.pair)
109107 (Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
110108 )
111109 )
@@ -114,7 +112,7 @@ tests =
114112 Expect.equal
115113 (Just ( 8, "hi" ))
116114 (D.runBytes
117− (D.cell D.int D.cord)
115+ (D.cell D.int D.cord |> D.map Tuple.pair)
118116 (Bytes.fromByteValues [ 0x41, 0x10, 0x3C, 0x5A, 0x1A ])
119117 )
120118 )
@@ -123,7 +121,7 @@ tests =
123121 Expect.equal
124122 (Just ( 8, "hi" ))
125123 (D.runBytes
126− (D.cell D.int D.tape)
124+ (D.cell D.int D.tape |> D.map Tuple.pair)
127125 (Bytes.fromByteValues [ 0x41, 0x30, 0x38, 0x3A, 0x78, 0x5A ])
128126 )
129127 )
@@ -134,8 +132,8 @@ tests =
134132 (Just "hi")
135133 (D.runBytes
136134 (D.oneOf
137− [ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
138− , D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
135+ [ D.cell (D.const D.cord "tape") D.tape
136+ , D.cell (D.const D.cord "cord") D.cord
139137 ]
140138 )
141139 (Bytes.fromByteValues [ 0x01, 0x9F, 0x2E, 0x0C, 0xAE, 0x1C, 0x1C, 0x1D, 0x3C, 0x2D ])
@@ -147,8 +145,8 @@ tests =
147145 (Just "hi")
148146 (D.runBytes
149147 (D.oneOf
150− [ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
151− , D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
148+ [ D.cell (D.const D.cord "tape") D.tape
149+ , D.cell (D.const D.cord "cord") D.cord
152150 ]
153151 )
154152 (Bytes.fromByteValues [ 0x01, 0x7F, 0xEC, 0x4D, 0x8E, 0x0C, 0x1E, 0x2D, 0x0D ])
@@ -160,7 +158,7 @@ tests =
160158 Expect.equal
161159 (Just ( 8, -8 ))
162160 (D.runBytes
163− (D.cell D.signedInt D.signedInt)
161+ (D.cell D.signedInt D.signedInt |> D.map Tuple.pair)
164162 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
165163 )
166164 )
@@ -190,7 +188,7 @@ tests =
190188 (\( f, i, ui ) ->
191189 Expect.equal (Just ( f, i, ui ))
192190 (D.run
193− (D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\(a, (b, c)) -> ( a, b, c )))
191+ (D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\a b c -> ( a, b, c )))
194192 (C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
195193 )
196194 )