git.iko.soy/airlock
on master help sign in
swap
7e8573715 ahead, 0 behind
.gitignore+1
since splitsnapshots
unifiedsplit
@@ -1,2 +1,3 @@
1elm-stuff
1elm-stuff
2elm.js
2elm.js
3+zod
LICENSEnew file+7
@@ -0,0 +1,7 @@
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.md+8−1
@@ -6,10 +6,17 @@
6
6
7### Demo
7### Demo
8
8
9−[![Demo](https://img.youtube.com/vi/KV49E-D-SOY/default.jpg)](https://youtu.be/KV49E-D-SOY)
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).
10
15
11### FFI
16### FFI
12
17
18+This is for setting up this library from scratch.
19+
13Urbit subscriptions require [server-side event (SSE)](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events).
20Urbit subscriptions require [server-side event (SSE)](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events).
14Unfortunately, Elm does not provide a native implementation.
21Unfortunately, Elm does not provide a native implementation.
15This means that we will need to use [JS FFI (aka ports)](https://guide.elm-lang.org/interop/ports.html).
22This means that we will need to use [JS FFI (aka ports)](https://guide.elm-lang.org/interop/ports.html).
dev/elm-live.sh → dev/sink-elm-live.shrenamed+1−1
@@ -4,4 +4,4 @@ set -e
4
4
5cd "$(dirname "$0")/../example"
5cd "$(dirname "$0")/../example"
6
6
7−nix run nixpkgs#elmPackages.elm-live -- src/Main.elm --start-page=index.html -- --output=elm.js --debug "$@"
7+nix run nixpkgs#elmPackages.elm-live -- src/Sink.elm --start-page=index.html -- --output=elm.js --debug "$@"
dev/vanilla-elm-live.shnew file+7
@@ -0,0 +1,7 @@
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.mdnew file+101
@@ -0,0 +1,101 @@
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+11−2
@@ -3,9 +3,18 @@
3 "name": "ilyakooo0/airlock",
3 "name": "ilyakooo0/airlock",
4 "summary": "Urbit airlock",
4 "summary": "Urbit airlock",
5 "license": "MIT",
5 "license": "MIT",
6− "version": "1.0.0",
6+ "version": "1.1.1",
7 "exposed-modules": [
7 "exposed-modules": [
8− "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run", "Ur.Types"
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"
9 ],
18 ],
10 "elm-version": "0.19.0 <= v < 0.20.0",
19 "elm-version": "0.19.0 <= v < 0.20.0",
11 "dependencies": {
20 "dependencies": {
example/script.js+16−1
@@ -2,7 +2,22 @@ import { fetchEventSource } from "/fetch-event-source.js"
2
2
3const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;
3const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;
4
4
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+
5−let app = Elm.Main.init({ node: document.getElementById("elm"), flags: { uid } });
20+let app = searchForInit(Elm)({ node: document.getElementById("elm"), flags: { uid } });
6
21
7app.ports.createEventSource.subscribe((url) => {
22app.ports.createEventSource.subscribe((url) => {
8 fetchEventSource(url, {
23 fetchEventSource(url, {
example/src/Sink.elmnew file+199
@@ -0,0 +1,199 @@
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/src/Main.elm → example/src/Vanilla.elmrenamed+21−16
@@ -1,4 +1,4 @@
1−port module Main exposing (main)
1+port module Vanilla exposing (main)
2
2
3import BigInt exposing (BigInt)
3import BigInt exposing (BigInt)
4import Browser exposing (Document)
4import Browser exposing (Document)
@@ -12,7 +12,6 @@ import Ur
12import Ur.Cmd
12import Ur.Cmd
13import Ur.Constructor as C
13import Ur.Constructor as C
14import Ur.Deconstructor as D
14import Ur.Deconstructor as D
15−import Ur.Requests
16import Ur.Run
15import Ur.Run
17import Ur.Sub
16import Ur.Sub
18import Widget
17import Widget
@@ -20,6 +19,11 @@ import Widget.Icon as Icon
20import Widget.Material as Material
19import Widget.Material as Material
21
20
22
21
22+url : String
23+url =
24+ "http://localhost:8080"
25+
26+
23main : Ur.Run.Program Model Msg
27main : Ur.Run.Program Model Msg
24main =
28main =
25 Ur.Run.application
29 Ur.Run.application
@@ -31,20 +35,20 @@ main =
31 , shipName = Nothing
35 , shipName = Nothing
32 }
36 }
33 , Cmd.batch
37 , Cmd.batch
34− [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
38+ [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
35 |> Cmd.map (result (Debug.toString >> Error) (always Noop))
39 |> Cmd.map (result (Debug.toString >> Error) (always Noop))
36− , Ur.getShipName "http://localhost:8080" |> Cmd.map (result (always Noop) GotShipName)
40+ , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
37− , Ur.Requests.scry
41+ , Ur.scry
38− { url = "http://localhost:8080"
42+ { url = url
39 , agent = "journal"
43 , agent = "journal"
40 , path = [ "entries", "all" ]
44 , path = [ "entries", "all" ]
41 , error = Noop
45 , error = Noop
42 , success =
46 , success =
43 D.cell D.ignore
47 D.cell D.ignore
44 (D.cell (D.const D.cord "jrnl")
48 (D.cell (D.const D.cord "jrnl")
45− (D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
49+ (D.list (D.cell D.bigint D.cord))
46− |> D.map GotListings
47 )
50 )
51+ |> D.map (\( (), ( (), listings ) ) -> GotListings listings)
48 }
52 }
49 ]
53 ]
50 |> Ur.Cmd.cmd
54 |> Ur.Cmd.cmd
@@ -69,7 +73,7 @@ main =
69 , onEventSourceMsg = onEventSourceMessage
73 , onEventSourceMsg = onEventSourceMessage
70 , onUrlChange = \_ -> Noop
74 , onUrlChange = \_ -> Noop
71 , onUrlRequest = \_ -> Noop
75 , onUrlRequest = \_ -> Noop
72− , urbitUrl = \_ -> "http://localhost:8080"
76+ , urbitUrl = \_ -> url
73 }
77 }
74
78
75
79
@@ -173,14 +177,15 @@ type JournalUpdate
173 | Delete BigInt
177 | Delete BigInt
174
178
175
179
176−decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a
180+decodeJournalUpdate : D.Deconstructor JournalUpdate
177decodeJournalUpdate =
181decodeJournalUpdate =
178− D.cell D.ignore <|
179− D.oneOf
182+ D.oneOf
180− [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add
183+ [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Add id txt)
181− , (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit
184+ , D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
182− , D.cell (D.const D.cord "del") D.bigint |> D.map Delete
185+ , D.cell (D.const D.cord "del") D.bigint |> D.map (\( (), id ) -> Delete id)
183− ]
186+ ]
187+ |> D.cell D.ignore
188+ |> D.map (\( (), upd ) -> upd)
184
189
185
190
186view : Model -> Document Msg
191view : Model -> Document Msg
example/journal/app/journal.hoon → example/urbit/app/journal.hoonrenamed+26−19
@@ -1,5 +1,5 @@
1/- *journal
1/- *journal
2−/+ default-agent, dbug, agentio
2+/+ default-agent, dbug, agentio, *sink
3|%
3|%
4+$ versioned-state
4+$ versioned-state
5 $% state-0
5 $% state-0
@@ -17,11 +17,15 @@
17 ?. (has:log-orm log unix-ms)
17 ?. (has:log-orm log unix-ms)
18 unix-ms
18 unix-ms
19 $(time (add unix-ms 1))
19 $(time (add unix-ms 1))
20−--
20+--
21+
21%- agent:dbug
22%- agent:dbug
22−=| state-0
23+=/ state *state-0
23−=* state -
24+=* entries (tap:j-orm journal.state)
25+=/ snik (sink ~[/sync])
26+=/ sink (snik entries)
24^- agent:gall
27^- agent:gall
28+::
25|_ =bowl:gall
29|_ =bowl:gall
26+* this .
30+* this .
27 def ~(. (default-agent this %|) bowl)
31 def ~(. (default-agent this %|) bowl)
@@ -34,7 +38,8 @@
34++ on-load
38++ on-load
35 |= old-vase=vase
39 |= old-vase=vase
36 ^- (quip card _this)
40 ^- (quip card _this)
37− `this(state !<(versioned-state old-vase))
41+ =/ state !<(versioned-state old-vase)
42+ `this(state state, sink (snik entries))
38::
43::
39++ on-poke
44++ on-poke
40 |= [=mark =vase]
45 |= [=mark =vase]
@@ -42,27 +47,28 @@
42 |^
47 |^
43 ?> (team:title our.bowl src.bowl)
48 ?> (team:title our.bowl src.bowl)
44 ?. ?=(%journal-action mark) (on-poke:def mark vase)
49 ?. ?=(%journal-action mark) (on-poke:def mark vase)
45− =/ now=@ (unique-time now.bowl log)
50+ =/ now=@ (unique-time now.bowl log.state)
46 =/ act !<(action vase)
51 =/ act !<(action vase)
47 =. state (poke-action act)
52 =. state (poke-action act)
53+ =^ card sink (sync:sink entries)
48− :_ this(log (put:log-orm log now act))
54+ :_ this(log.state (put:log-orm log.state now act))
49− ~[(fact:io journal-update+!>(`update`[now act]) ~[/updates])]
55+ ~[(fact:io journal-update+!>(`update`[now act]) ~[/updates]) card]
50 ::
56 ::
51 ++ poke-action
57 ++ poke-action
52 |= act=action
58 |= act=action
53 ^- _state
59 ^- _state
54 ?- -.act
60 ?- -.act
55 %add
61 %add
56− ?< (has:j-orm journal id.act)
62+ ?< (has:j-orm journal.state id.act)
57− state(journal (put:j-orm journal id.act txt.act))
63+ state(journal (put:j-orm journal.state id.act txt.act))
58 ::
64 ::
59 %edit
65 %edit
60− ?> (has:j-orm journal id.act)
66+ ?> (has:j-orm journal.state id.act)
61− state(journal (put:j-orm journal id.act txt.act))
67+ state(journal (put:j-orm journal.state id.act txt.act))
62 ::
68 ::
63 %del
69 %del
64− ?> (has:j-orm journal id.act)
70+ ?> (has:j-orm journal.state id.act)
65− state(journal +:(del:j-orm journal id.act))
71+ state(journal +:(del:j-orm journal.state id.act))
66 ==
72 ==
67 --
73 --
68::
74::
@@ -72,6 +78,7 @@
72 ?> (team:title our.bowl src.bowl)
78 ?> (team:title our.bowl src.bowl)
73 ?+ path (on-watch:def path)
79 ?+ path (on-watch:def path)
74 [%updates ~] `this
80 [%updates ~] `this
81+ [%sync ~] [~[flush:sink] this]
75 ==
82 ==
76::
83::
77++ on-peek
84++ on-peek
@@ -85,14 +92,14 @@
85 [%all ~]
92 [%all ~]
86 :^ ~ ~ %journal-update
93 :^ ~ ~ %journal-update
87 !> ^- update
94 !> ^- update
88− [now %jrnl (tap:j-orm journal)]
95+ [now %jrnl entries]
89 ::
96 ::
90 [%before @ @ ~]
97 [%before @ @ ~]
91 =/ before=@ (rash i.t.t.t.path dem)
98 =/ before=@ (rash i.t.t.t.path dem)
92 =/ max=@ (rash i.t.t.t.t.path dem)
99 =/ max=@ (rash i.t.t.t.t.path dem)
93 :^ ~ ~ %journal-update
100 :^ ~ ~ %journal-update
94 !> ^- update
101 !> ^- update
95− [now %jrnl (tab:j-orm journal `before max)]
102+ [now %jrnl (tab:j-orm journal.state `before max)]
96 ::
103 ::
97 [%between @ @ ~]
104 [%between @ @ ~]
98 =/ start=@
105 =/ start=@
@@ -101,7 +108,7 @@
101 =/ end=@ (add 1 (rash i.t.t.t.t.path dem))
108 =/ end=@ (add 1 (rash i.t.t.t.t.path dem))
102 :^ ~ ~ %journal-update
109 :^ ~ ~ %journal-update
103 !> ^- update
110 !> ^- update
104− [now %jrnl (tap:j-orm (lot:j-orm journal `end `start))]
111+ [now %jrnl (tap:j-orm (lot:j-orm journal.state `end `start))]
105 ==
112 ==
106 ::
113 ::
107 [%x %updates *]
114 [%x %updates *]
@@ -109,13 +116,13 @@
109 [%all ~]
116 [%all ~]
110 :^ ~ ~ %journal-update
117 :^ ~ ~ %journal-update
111 !> ^- update
118 !> ^- update
112− [now %logs (tap:log-orm log)]
119+ [now %logs (tap:log-orm log.state)]
113 ::
120 ::
114 [%since @ ~]
121 [%since @ ~]
115 =/ since=@ (rash i.t.t.t.path dem)
122 =/ since=@ (rash i.t.t.t.path dem)
116 :^ ~ ~ %journal-update
123 :^ ~ ~ %journal-update
117 !> ^- update
124 !> ^- update
118− [now %logs (tap:log-orm (lot:log-orm log `since ~))]
125+ [now %logs (tap:log-orm (lot:log-orm log.state `since ~))]
119 ==
126 ==
120 ==
127 ==
121::
128::
example/journal/desk.bill → example/urbit/desk.billrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

example/urbit/lib/noun-diff.hoonnew file+227
@@ -0,0 +1,227 @@
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.hoonnew file+26
@@ -0,0 +1,26 @@
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+--
example/journal/lib/skeleton.hoon → example/urbit/lib/skeleton.hoonrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

src/BitWriter.elm+5−5
@@ -14,17 +14,17 @@ import Bytes.Encode as BE
14
14
15empty : BitWriter
15empty : BitWriter
16empty =
16empty =
17− BitWriter { running = Nothing, collected = BE.sequence [], offset = 0 }
17+ BitWriter { running = Nothing, collected = [], offset = 0 }
18
18
19
19
20run : BitWriter -> Bytes
20run : BitWriter -> Bytes
21run (BitWriter { running, collected }) =
21run (BitWriter { running, collected }) =
22 case running of
22 case running of
23 Nothing ->
23 Nothing ->
24− BE.encode collected
24+ BE.encode (collected |> List.reverse |> BE.sequence)
25
25
26 Just { value } ->
26 Just { value } ->
27− BE.sequence [ collected, BE.unsignedInt8 value ] |> BE.encode
27+ BE.sequence (BE.unsignedInt8 value :: collected |> List.reverse) |> BE.encode
28
28
29
29
30type BitWriter
30type BitWriter
@@ -35,7 +35,7 @@ type BitWriter
35 , length : Int
35 , length : Int
36 }
36 }
37 , offset : Int
37 , offset : Int
38− , collected : BE.Encoder
38+ , collected : List BE.Encoder
39 }
39 }
40
40
41
41
@@ -68,7 +68,7 @@ bit b (BitWriter { running, collected, offset }) =
68 if length == 7 then
68 if length == 7 then
69 BitWriter
69 BitWriter
70 { running = Nothing
70 { running = Nothing
71− , collected = BE.sequence [ collected, BE.unsignedInt8 newValue ]
71+ , collected = BE.unsignedInt8 newValue :: collected
72 , offset = newOffset
72 , offset = newOffset
73 }
73 }
74
74
src/Ur.elm+2−2
@@ -77,7 +77,7 @@ scry :
77 , agent : Agent
77 , agent : Agent
78 , path : Path
78 , path : Path
79 , error : msg
79 , error : msg
80− , success : D.Deconstructor (msg -> msg) msg
80+ , success : D.Deconstructor msg
81 }
81 }
82 -> Cmd msg
82 -> Cmd msg
83scry args =
83scry args =
@@ -91,7 +91,7 @@ scryTask :
91 , agent : Agent
91 , agent : Agent
92 , path : Path
92 , path : Path
93 , error : msg
93 , error : msg
94− , success : D.Deconstructor (msg -> msg) msg
94+ , success : D.Deconstructor msg
95 }
95 }
96 -> Task a msg
96 -> Task a msg
97scryTask { url, agent, path, error, success } =
97scryTask { url, agent, path, error, success } =
src/Ur/Constructor.elm+2−2
@@ -89,7 +89,7 @@ signedInt i =
89 )
89 )
90
90
91
91
92−{-| Constructs an `Atom` from `Bytes`
92+{-| Constructs an `Atom` from `Bytes`.
93-}
93-}
94bytes : Bytes -> Noun
94bytes : Bytes -> Noun
95bytes =
95bytes =
@@ -103,7 +103,7 @@ cord s =
103 Atom (BE.encode (BE.string s))
103 Atom (BE.encode (BE.string s))
104
104
105
105
106−{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`
106+{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`.
107-}
107-}
108tape : String -> Noun
108tape : String -> Noun
109tape s =
109tape s =
src/Ur/Deconstructor.elm+211−218
@@ -6,24 +6,16 @@ module Ur.Deconstructor exposing
6 , int, signedInt, bigint
6 , int, signedInt, bigint
7 , float32, float64
7 , float32, float64
8 , cord, tape
8 , cord, tape
9− , bytes, sig, ignore, tar
9+ , bytes, sig, ignore, tar, lazy, debug
10 )
10 )
11
11
12{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
12{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.
13
13
14−The principal (and types) are very similar to `Url.Parser` from `elm/url`.
14+You would parse a `[%edit @ cord]` like this:
15
15
16−You would parse a `[%edit cord @]` like this:
16+ type alias Edit = {id: Int, text : String}
17
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
18+ (D.cell (D.const D.cord "edit") (D.cell D.bigint D.cord)) |> D.map (\( (), ( id, txt ) ) -> Edit id txt)
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
19
28@docs Deconstructor
20@docs Deconstructor
29
21
@@ -63,7 +55,7 @@ that "capture" a value: `D.int` and `D.cord`.
63
55
64# Miscellaneous
56# Miscellaneous
65
57
66−@docs bytes, sig, ignore, tar
58+@docs bytes, sig, ignore, tar, lazy, debug
67
59
68-}
60-}
69
61
@@ -74,139 +66,74 @@ import Bytes exposing (Bytes, Endianness(..))
74import Bytes.Decode as BD
66import Bytes.Decode as BD
75import Bytes.Encode as BE
67import Bytes.Encode as BE
76import Bytes.Extra
68import Bytes.Extra
77−import Ur.Jam exposing (cue)
69+import Ur.Jam exposing (cue, isSig)
78import Ur.Types exposing (..)
70import Ur.Types exposing (..)
79
71
80
72
81{-| A `Noun` deconstructor.
73{-| A `Noun` deconstructor.
82-}
74-}
83−type Deconstructor a b
75+type alias Deconstructor a =
84− = Deconstructor (Noun -> a -> Maybe b)
76+ Noun -> Maybe a
85
77
86
78
87{-| Executes a `Deconstructor` on a `Noun`.
79{-| Executes a `Deconstructor` on a `Noun`.
88-}
80-}
89−run : Deconstructor (a -> a) a -> Noun -> Maybe a
81+run : Deconstructor a -> Noun -> Maybe a
90−run (Deconstructor f) noun =
82+run f noun =
91− f noun identity
83+ f noun
92
84
93
85
94{-| Executes a deconstructor on a `jam`med `Noun`.
86{-| Executes a deconstructor on a `jam`med `Noun`.
95-}
87-}
96−runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a
88+runBytes : Deconstructor a -> Bytes -> Maybe a
97−runBytes (Deconstructor f) bs =
89+runBytes f bs =
98− cue bs
99− |> Maybe.andThen
90+ cue bs |> Maybe.andThen f
100− (\noun -> f noun identity)
101
91
102
92
103−{-| Asserts that the value at the current position should be exactly equal to the second argument.
93+{-| Asserts that the value should be exactly equal to the second argument.
104
94
105−The first argument is a `Deconstructor` for the gven tyoe.
95+The first argument is a `Deconstructor` for the given type.
106
96
107The second argument is the value to compare with.
97The second argument is the value to compare with.
108
98
109This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
99This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
110
100
111-}
101-}
112−const : Deconstructor (a -> a) a -> a -> Deconstructor c c
102+const : Deconstructor a -> a -> Deconstructor ()
113−const (Deconstructor f) value =
103+const f value noun =
114− Deconstructor
104+ case f noun of
115− (\noun c ->
105+ Just a ->
116− case f noun identity of
117− Just a ->
118− if a == value then
106+ if a == value then
119− Just c
107+ Just ()
120
108
121− else
109+ else
122− Nothing
110+ Nothing
123
111
124− Nothing ->
112+ Nothing ->
125− Nothing
113+ Nothing
126− )
127
114
128
115
129−{-| Extracts a `cord` at the current location.
116+{-| Extracts a `BigInt`.
130-}
117-}
131−cord : Deconstructor (String -> a) a
118+bigint : Deconstructor BigInt
132−cord =
119+bigint x =
133− Deconstructor
134− (\x f ->
135− case x of
120+ case x of
136− Atom bs ->
121+ Atom bs ->
137− BD.decode (BD.string (Bytes.width bs)) bs
122+ BigInt.Bytes.decode bs |> Just
138− |> Maybe.map f
139−
140− Cell _ ->
141− Nothing
142− )
143
123
144−
124+ Cell _ ->
145−{-| Extracts a `tape` at the current location.
125+ Nothing
146−-}
147−tape : Deconstructor (String -> a) a
148−tape =
149− list cord |> fmap String.concat
150
126
151
127
152−{-| Extracts a 32-bit unsigned `Int` at the given location.
128+{-| Extracts a 32-bit signed `Int`.
153
129
154−If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.
130+If the `Atom` is larger than 32 bits the the behaviour is undefined.
155
131
156-}
132-}
157−int : Deconstructor (Int -> a) a
158−int =
159− Deconstructor
160− (\x f ->
161− case x of
162− Atom bs ->
163− (case Bytes.width bs of
164− 1 ->
165− BD.decode BD.unsignedInt8 bs
166−
167− 2 ->
168− BD.decode (BD.unsignedInt16 LE) bs
169−
170− 3 ->
171− BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
172−
173− 4 ->
174− BD.decode (BD.unsignedInt32 LE) bs
175−
176− _ ->
177− Nothing
178− )
179− |> Maybe.map f
180−
181− Cell _ ->
182− Nothing
183− )
184−
185−
186−{-| Extracts a `BigInt` at the current location.
187−-}
188−bigint : Deconstructor (BigInt -> a) a
189−bigint =
190− Deconstructor
191− (\x f ->
192− case x of
193− Atom bs ->
194− BigInt.Bytes.decode bs |> f |> Just
195−
196− Cell _ ->
197− Nothing
198− )
199−
200−
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−-}
206−signedInt : Deconstructor (Int -> a) a
133+signedInt : Deconstructor Int
207signedInt =
134signedInt =
208 int
135 int
209− |> fmap
136+ |> map
210 (\i ->
137 (\i ->
211 if Bitwise.and 1 i == 1 then
138 if Bitwise.and 1 i == 1 then
212 -(Bitwise.shiftRightBy 1 (1 + i))
139 -(Bitwise.shiftRightBy 1 (1 + i))
@@ -216,105 +143,85 @@ signedInt =
216 )
143 )
217
144
218
145
219−{-| Extracts a 32-bit `Float` at the given location.
146+{-| Extracts a 32-bit `Float`.
220-}
147-}
221−float32 : Deconstructor (Float -> a) a
148+float32 : Deconstructor Float
222−float32 =
149+float32 x =
223− Deconstructor
224− (\x f ->
225− case x of
150+ case x of
226− Atom bs ->
151+ Atom bs ->
227− BD.decode (BD.float32 LE) bs
152+ BD.decode (BD.float32 LE) bs
228− |> Maybe.map f
153+
229−
230− Cell _ ->
154+ Cell _ ->
231− Nothing
155+ Nothing
232− )
233
156
234
157
235−{-| Extracts a 64-bit `Float` at the given location.
158+{-| Extracts a 64-bit `Float`.
236-}
159-}
237−float64 : Deconstructor (Float -> a) a
160+float64 : Deconstructor Float
238−float64 =
161+float64 x =
239− Deconstructor
240− (\x f ->
241− case x of
162+ case x of
242− Atom bs ->
163+ Atom bs ->
243− BD.decode (BD.float64 LE) bs
164+ BD.decode (BD.float64 LE) bs
244− |> Maybe.map f
165+
245−
246− Cell _ ->
166+ Cell _ ->
247− Nothing
167+ Nothing
248− )
249
168
250
169
251−{-| Extracts the raw `Byte`s of an `Atom` at the current location.
170+{-| Extracts the raw `Byte`s of an `Atom`.
252-}
171-}
253−bytes : Deconstructor (Bytes -> a) a
172+bytes : Deconstructor Bytes
254−bytes =
173+bytes n =
255− Deconstructor
256− (\n f ->
257− case n of
174+ case n of
258− Atom bs ->
175+ Atom bs ->
259− f bs |> Just
176+ Just bs
260
177
261− Cell _ ->
178+ Cell _ ->
262− Nothing
179+ Nothing
263− )
264
180
265
181
266−{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).
182+{-| Asserts the the `Atom` should be exactly `sig` (`~`).
267-}
183-}
268−sig : Deconstructor a a
184+sig : Deconstructor ()
269−sig =
185+sig n =
270− Deconstructor
271− (\n a ->
272− case n of
186+ case n of
273− Atom b ->
187+ Atom b ->
274− if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
188+ if (Bytes.Extra.toByteValues b |> List.filter (\x -> x /= 0)) == [] then
275− Just a
189+ Just ()
276
190
277− else
191+ else
278− Nothing
192+ Nothing
279
193
280− Cell _ ->
194+ Cell _ ->
281− Nothing
195+ Nothing
282− )
283
196
284
197
285−{-| Extracts a sig-terminated list of arbitrary elements at the current position.
198+{-| Extracts a sig-terminated list of arbitrary elements.
286
199
287The first argument is a `Deconstructor` of the elements of the list.
200The first argument is a `Deconstructor` of the elements of the list.
288
201
289-}
202-}
290−list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b
203+list : Deconstructor a -> Deconstructor (List a)
291−list (Deconstructor f) =
204+list f n =
292− Deconstructor
205+ let
293− (\n g ->
206+ go n_ =
294− let
295− go n_ =
296− case n_ of
207+ case n_ of
297− Atom _ ->
208+ Atom _ ->
298− Just []
209+ Just []
299
210
300− Cell ( el, tail ) ->
211+ Cell ( el, tail ) ->
301− Maybe.map2 (\a b -> a :: b) (f el identity) (go tail)
212+ Maybe.map2 (\a b -> a :: b) (f el) (go tail)
302− in
213+ in
303− go n |> Maybe.map g
214+ go n
304− )
305
215
306
216
307−alt : Deconstructor a b -> Deconstructor a b -> Deconstructor a b
217+alt : Deconstructor a -> Deconstructor a -> Deconstructor a
308−alt (Deconstructor f) (Deconstructor g) =
218+alt f g n =
309− Deconstructor
310− (\n a ->
311− case f n a of
219+ case f n of
312− Just x ->
220+ Just x ->
313− Just x
221+ Just x
314
222
315− Nothing ->
223+ Nothing ->
316− g n a
224+ g n
317− )
318
225
319
226
320{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
227{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
@@ -322,34 +229,24 @@ alt (Deconstructor f) (Deconstructor g) =
322This is especially useful for deconstructing head-tagged unions from Hoon.
229This is especially useful for deconstructing head-tagged unions from Hoon.
323
230
324-}
231-}
325−oneOf : List (Deconstructor a b) -> Deconstructor a b
232+oneOf : List (Deconstructor a) -> Deconstructor a
326oneOf l =
233oneOf l =
327 case l of
234 case l of
328 [] ->
235 [] ->
329− Deconstructor (\_ _ -> Nothing)
236+ always Nothing
330
237
331 x :: xs ->
238 x :: xs ->
332 alt x (oneOf xs)
239 alt x (oneOf xs)
333
240
334
241
335−{-| Extract the raw `Noun` at the current position.
336−
337−Always succeeds.
338−
339−-}
340−tar : Deconstructor (Noun -> a) a
341−tar =
342− Deconstructor (\noun f -> Just (f noun))
343−
344−
345−{-| Ignore any value at the current position.
242+{-| Ignore any value.
346
243
347This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
244This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
348
245
349-}
246-}
350−ignore : Deconstructor a a
247+ignore : Deconstructor ()
351ignore =
248ignore =
352− Deconstructor (\_ f -> Just f)
249+ always (Just ())
353
250
354
251
355{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
252{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
@@ -357,17 +254,14 @@ ignore =
357Accepts two arbitrary `Deconstructor`s that form a Cell.
254Accepts two arbitrary `Deconstructor`s that form a Cell.
358
255
359-}
256-}
360−cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c
257+cell : Deconstructor a -> Deconstructor b -> Deconstructor ( a, b )
361−cell (Deconstructor l) (Deconstructor r) =
258+cell l r noun =
362− Deconstructor
363− (\noun a ->
364− case noun of
259+ case noun of
365− Cell ( lhs, rhs ) ->
260+ Cell ( lhs, rhs ) ->
366− l lhs a |> Maybe.andThen (\b -> r rhs b)
261+ l lhs |> Maybe.andThen (\a -> r rhs |> Maybe.map (\b -> ( a, b )))
367
262
368− Atom _ ->
263+ Atom _ ->
369− Nothing
264+ Nothing
370− )
371
265
372
266
373{-| Maps (applies) a function to all of the values deconstructed.
267{-| Maps (applies) a function to all of the values deconstructed.
@@ -375,11 +269,110 @@ cell (Deconstructor l) (Deconstructor r) =
375This is useful when you want to create a data type with extracted values as fields.
269This is useful when you want to create a data type with extracted values as fields.
376
270
377-}
271-}
378−map : a -> Deconstructor a b -> Deconstructor (b -> c) c
272+lazy : (() -> Deconstructor a) -> Deconstructor a
379−map a (Deconstructor f) =
273+lazy f noun =
380− Deconstructor (\noun g -> f noun a |> Maybe.map g)
274+ f () noun
381
275
382
276
277+{-| Maps over the result of the deconstructor.
278+-}
383−fmap : (a -> b) -> Deconstructor (a -> c) c -> Deconstructor (b -> c) c
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+-}
384−fmap f (Deconstructor g) =
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+-}
385− Deconstructor (\noun h -> g noun (f >> h))
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
318+
319+ 3 ->
320+ BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
321+
322+ 4 ->
323+ BD.decode (BD.unsignedInt32 LE) bs
324+
325+ _ ->
326+ Nothing
327+
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
350+
351+ Nothing ->
352+ let
353+ _ =
354+ log (prettyNoun noun)
355+ in
356+ Nothing
357+
358+
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+ "~"
367+
368+ else
369+ "@"
370+
371+ Cell ( lhs, rhs ) ->
372+ if isRhs then
373+ go False lhs ++ " " ++ go True rhs
374+
375+ else
376+ "[" ++ go False lhs ++ " " ++ go True rhs ++ "]"
377+ in
378+ go False noun
src/Ur/NounDiff.elmnew file+115
@@ -0,0 +1,115 @@
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+1−1
@@ -13,7 +13,7 @@ import Urbit.Encoding.Atom exposing (toBigInt)
13import Urbit.Encoding.Phonemic exposing (..)
13import Urbit.Encoding.Phonemic exposing (..)
14
14
15
15
16−{-| Converts a ship name like `~zod` into an Atom.
16+{-| Converts a ship name like `~zod` into an `Atom`.
17-}
17-}
18fromString : Ship -> Atom
18fromString : Ship -> Atom
19fromString s =
19fromString s =
src/Ur/Requests.elm+1−1
@@ -98,7 +98,7 @@ toNoun eventId req =
98 C.cell (C.cord app) (C.listOf C.cord path)
98 C.cell (C.cord app) (C.listOf C.cord path)
99
99
100 Unsubscribe subId ->
100 Unsubscribe subId ->
101− C.cell (C.cord "usubscribe") <|
101+ C.cell (C.cord "unsubscribe") <|
102 C.cell (C.int eventId) (C.int subId)
102 C.cell (C.int eventId) (C.int subId)
103
103
104 Poke { ship, agent, mark, noun } ->
104 Poke { ship, agent, mark, noun } ->
src/Ur/Run.elm+80−23
@@ -18,6 +18,7 @@ import Ur.Cmd
18import Ur.Cmd.Internal
18import Ur.Cmd.Internal
19import Ur.Constructor as C
19import Ur.Constructor as C
20import Ur.Deconstructor as D
20import Ur.Deconstructor as D
21+import Ur.NounDiff exposing (Patch, deconstructPatch)
21import Ur.Requests exposing (..)
22import Ur.Requests exposing (..)
22import Ur.Sub
23import Ur.Sub
23import Ur.Sub.Internal
24import Ur.Sub.Internal
@@ -30,8 +31,9 @@ type alias SubDict msg =
30 Dict
31 Dict
31 -- (ship, agent, path)
32 -- (ship, agent, path)
32 ( String, String, List String )
33 ( String, String, List String )
33− { deconstructor : D.Deconstructor (msg -> msg) msg
34+ { deconstructor : D.Deconstructor msg
34 , number : Int
35 , number : Int
36+ , sink : Bool
35 }
37 }
36
38
37
39
@@ -49,6 +51,7 @@ type alias Model app msg =
49 , eventId : Int
51 , eventId : Int
50 , flags : Flags
52 , flags : Flags
51 , requestsToRetry : List UrbitRequest
53 , requestsToRetry : List UrbitRequest
54+ , sinks : Dict Int Noun
52 }
55 }
53
56
54
57
@@ -171,12 +174,11 @@ update inp msg model =
171 ( appModel, appCmds ) =
174 ( appModel, appCmds ) =
172 inp.update msg_ model.app
175 inp.update msg_ model.app
173
176
174− -- { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =
175 subsResult =
177 subsResult =
176 processUrSubs
178 processUrSubs
177 model.eventId
179 model.eventId
178 model.subscriptions
180 model.subscriptions
179− (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))
181+ (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))
180
182
181 ( eventId_, cmds, urReqs ) =
183 ( eventId_, cmds, urReqs ) =
182 processCmd subsResult.eventId appCmds
184 processCmd subsResult.eventId appCmds
@@ -209,12 +211,10 @@ update inp msg model =
209 Ok string ->
211 Ok string ->
210 case
212 case
211 D.runBytes
213 D.runBytes
212− (D.cell D.int (D.cell D.cord D.tar)
214+ (D.cell D.int (D.cell D.cord D.tar))
213− |> D.map (\a b c -> ( a, b, c ))
214− )
215 (Ur.Uw.decode string)
215 (Ur.Uw.decode string)
216 of
216 of
217− Just ( messageId, messageType, rest ) ->
217+ Just ( messageId, ( messageType, rest ) ) ->
218 let
218 let
219 ( eventId, ackReqs ) =
219 ( eventId, ackReqs ) =
220 tag model.eventId [ Ack messageId ]
220 tag model.eventId [ Ack messageId ]
@@ -244,14 +244,51 @@ update inp msg model =
244 Dict.get messageId model.subscriptionIntMapping
244 Dict.get messageId model.subscriptionIntMapping
245 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
245 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
246 of
246 of
247− Just { deconstructor } ->
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
248− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
285+ case D.run (D.cell D.ignore (D.cell D.ignore deconstructor) |> D.map (\( (), ( (), m ) ) -> m)) rest of
249− Just subMsg ->
286+ Just subMsg ->
250− ( model_, pureCmd (AppMsg subMsg) )
287+ ( model_, pureCmd (AppMsg subMsg) )
251−
288+
252− -- Got gargbage
289+ -- Got gargbage
253− Nothing ->
290+ Nothing ->
254− ( model_, ackCmd )
291+ ( model_, ackCmd )
255
292
256 -- Got a fact for a subscription we do not hold
293 -- Got a fact for a subscription we do not hold
257 Nothing ->
294 Nothing ->
@@ -276,11 +313,11 @@ update inp msg model =
276 NeedsActivation ->
313 NeedsActivation ->
277 let
314 let
278 ( eventId, reqs ) =
315 ( eventId, reqs ) =
279− [ Poke { ship = "~zod", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
316+ [ Poke { ship = "", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
280 |> tag model.eventId
317 |> tag model.eventId
281 in
318 in
282 ( { model | eventId = eventId }
319 ( { model | eventId = eventId }
283− , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }
320+ , send { url = url, requests = reqs, success = OpenConnection, error = Noop }
284 )
321 )
285
322
286 Noop ->
323 Noop ->
@@ -307,6 +344,19 @@ update inp msg model =
307 )
344 )
308
345
309
346
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+
310processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
360processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
311processCmd eventId urCmds =
361processCmd eventId urCmds =
312 let
362 let
@@ -336,10 +386,10 @@ pureCmd msg =
336
386
337processUrSubs :
387processUrSubs :
338 EventId
388 EventId
339− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
389+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
340− -> Dict ( Ship, Agent, Path ) d
390+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }
341 ->
391 ->
342− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
392+ { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
343 , eventId : EventId
393 , eventId : EventId
344 , subscriptionRequests : List ( EventId, UrbitRequest )
394 , subscriptionRequests : List ( EventId, UrbitRequest )
345 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
395 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
@@ -348,7 +398,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
348 let
398 let
349 urbitSubs =
399 urbitSubs =
350 urbitSubs_
400 urbitSubs_
351− |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })
401+ |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })
352
402
353 ( eventId_, newSubscriptionActions ) =
403 ( eventId_, newSubscriptionActions ) =
354 Dict.diff urbitSubs existingSubscriptions
404 Dict.diff urbitSubs existingSubscriptions
@@ -371,10 +421,11 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
371 newSubscriptions =
421 newSubscriptions =
372 Dict.merge
422 Dict.merge
373 (\_ _ x -> x)
423 (\_ _ x -> x)
374− (\key number { deconstructor } ->
424+ (\key number { deconstructor, sink } ->
375 Dict.insert key
425 Dict.insert key
376 { deconstructor = deconstructor
426 { deconstructor = deconstructor
377 , number = number
427 , number = number
428+ , sink = sink
378 }
429 }
379 )
430 )
380 (\_ _ x -> x)
431 (\_ _ x -> x)
@@ -417,6 +468,7 @@ init inp ( app, appCmds ) flags =
417 inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
468 inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
418 in
469 in
419 ( { subscriptions = subsResult.subscriptions
470 ( { subscriptions = subsResult.subscriptions
471+ , sinks = Dict.empty
420 , subscriptionIntMapping = subsResult.subscriptionIntMapping
472 , subscriptionIntMapping = subsResult.subscriptionIntMapping
421 , app = app
473 , app = app
422 , connected = False
474 , connected = False
@@ -439,7 +491,7 @@ init inp ( app, appCmds ) flags =
439
491
440subscriptions :
492subscriptions :
441 { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
493 { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
442− -> { d | app : b, requestsToRetry : List e }
494+ -> { d | app : b, requestsToRetry : List e, connected : Bool }
443 -> Sub (Msg msg)
495 -> Sub (Msg msg)
444subscriptions inp model =
496subscriptions inp model =
445 Sub.batch
497 Sub.batch
@@ -450,4 +502,9 @@ subscriptions inp model =
450
502
451 else
503 else
452 Time.every 1000 (always RetryRequests)
504 Time.every 1000 (always RetryRequests)
505+ , if not model.connected then
506+ Time.every 10000 (always NeedsActivation)
507+
508+ else
509+ Sub.none
453 ]
510 ]
src/Ur/Sub.elm+21−6
@@ -1,8 +1,8 @@
1−module Ur.Sub exposing (Sub, subscribe, none, batch)
1+module Ur.Sub exposing (Sub, subscribe, none, batch, sink)
2
2
3−{-| This module is conceptually similar to `Platform.Sub`, but also you to subscribe to Urbit channels.
3+{-| This module is conceptually similar to `Platform.Sub`, but allows you to subscribe to Urbit channels.
4
4
5−@docs Sub, subscribe, none, batch
5+@docs Sub, subscribe, none, batch, sink
6
6
7-}
7-}
8
8
@@ -11,7 +11,7 @@ import Ur.Deconstructor as D
11import Ur.Sub.Internal
11import Ur.Sub.Internal
12
12
13
13
14−{-| Like `Sub` from `Platform.Sub`, but for Urbit subscriptions.
14+{-| Like `Sub` from `Platform.Sub` but for Urbit subscriptions.
15-}
15-}
16type alias Sub msg =
16type alias Sub msg =
17 Ur.Sub.Internal.Sub msg
17 Ur.Sub.Internal.Sub msg
@@ -27,9 +27,24 @@ type alias Sub msg =
27 }
27 }
28
28
29-}
29-}
30−subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg
30+subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor msg } -> Sub msg
31subscribe { ship, app, path, deconstructor } =
31subscribe { ship, app, path, deconstructor } =
32− Dict.singleton ( ship, app, path ) deconstructor |> Ur.Sub.Internal.Sub
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
33
48
34
49
35{-| A subscription that does exactly nothing. (Does not subscribe to anything)
50{-| A subscription that does exactly nothing. (Does not subscribe to anything)
src/Ur/Sub/Internal.elm+3−1
@@ -10,5 +10,7 @@ type Sub msg
10 (Dict
10 (Dict
11 -- key is (ship, app, path)
11 -- key is (ship, app, path)
12 ( Ship, Agent, Path )
12 ( Ship, Agent, Path )
13− (D.Deconstructor (msg -> msg) msg)
13+ { deconstructor : D.Deconstructor msg
14+ , sink : Bool
15+ }
14 )
16 )
src/Ur/Uw.elm+8−8
@@ -1,6 +1,6 @@
1module Ur.Uw exposing (decode, encode)
1module Ur.Uw exposing (decode, encode)
2
2
3−{-| This module works with Urbit base-64 encoded strings.
3+{-| This module works with Urbit base-64 encoded strings aka `@uw`.
4
4
5@docs decode, encode
5@docs decode, encode
6
6
@@ -29,24 +29,24 @@ decode string =
29 -- 0w
29 -- 0w
30 |> List.drop 2
30 |> List.drop 2
31
31
32− go : List Char -> BW.BitWriter -> BW.BitWriter
32+ go : List Char -> List Int -> BW.BitWriter -> BW.BitWriter
33− go cs writer =
33+ go cs append writer =
34 case cs of
34 case cs of
35 [] ->
35 [] ->
36− writer
36+ BW.bits append writer
37
37
38 '.' :: rest ->
38 '.' :: rest ->
39− go rest writer
39+ go rest append writer
40
40
41 c :: rest ->
41 c :: rest ->
42 case Dict.get c charToBits of
42 case Dict.get c charToBits of
43 Just bits ->
43 Just bits ->
44− go rest writer |> BW.bits bits
44+ go rest (bits ++ append) writer
45
45
46 Nothing ->
46 Nothing ->
47− go rest writer
47+ go rest [] writer
48 in
48 in
49− BW.run (go chars BW.empty)
49+ BW.run (go chars [] BW.empty)
50
50
51
51
52{-| -}
52{-| -}
tests/Test/Urbit.elm+11−11
@@ -77,7 +77,7 @@ tests =
77 Expect.equal
77 Expect.equal
78 (Just ( 1, 2 ))
78 (Just ( 1, 2 ))
79 (D.runBytes
79 (D.runBytes
80− (D.cell D.int D.int |> D.map Tuple.pair)
80+ (D.cell D.int D.int)
81 (Bytes.fromByteValues [ 0x31, 0x12 ])
81 (Bytes.fromByteValues [ 0x31, 0x12 ])
82 )
82 )
83 )
83 )
@@ -96,7 +96,7 @@ tests =
96 Expect.equal
96 Expect.equal
97 (Just ( 4, [ 1, 2, 3 ] ))
97 (Just ( 4, [ 1, 2, 3 ] ))
98 (D.runBytes
98 (D.runBytes
99− (D.cell D.int (D.list D.int) |> D.map Tuple.pair)
99+ (D.cell D.int (D.list D.int))
100 (Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
100 (Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
101 )
101 )
102 )
102 )
@@ -105,7 +105,7 @@ tests =
105 Expect.equal
105 Expect.equal
106 (Just ( 8, 11 ))
106 (Just ( 8, 11 ))
107 (D.runBytes
107 (D.runBytes
108− (D.cell D.float32 D.float32 |> D.map Tuple.pair)
108+ (D.cell D.float32 D.float32)
109 (Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
109 (Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
110 )
110 )
111 )
111 )
@@ -114,7 +114,7 @@ tests =
114 Expect.equal
114 Expect.equal
115 (Just ( 8, "hi" ))
115 (Just ( 8, "hi" ))
116 (D.runBytes
116 (D.runBytes
117− (D.cell D.int D.cord |> D.map Tuple.pair)
117+ (D.cell D.int D.cord)
118 (Bytes.fromByteValues [ 0x41, 0x10, 0x3C, 0x5A, 0x1A ])
118 (Bytes.fromByteValues [ 0x41, 0x10, 0x3C, 0x5A, 0x1A ])
119 )
119 )
120 )
120 )
@@ -123,7 +123,7 @@ tests =
123 Expect.equal
123 Expect.equal
124 (Just ( 8, "hi" ))
124 (Just ( 8, "hi" ))
125 (D.runBytes
125 (D.runBytes
126− (D.cell D.int D.tape |> D.map Tuple.pair)
126+ (D.cell D.int D.tape)
127 (Bytes.fromByteValues [ 0x41, 0x30, 0x38, 0x3A, 0x78, 0x5A ])
127 (Bytes.fromByteValues [ 0x41, 0x30, 0x38, 0x3A, 0x78, 0x5A ])
128 )
128 )
129 )
129 )
@@ -134,8 +134,8 @@ tests =
134 (Just "hi")
134 (Just "hi")
135 (D.runBytes
135 (D.runBytes
136 (D.oneOf
136 (D.oneOf
137− [ D.cell (D.const D.cord "tape") D.tape
137+ [ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
138− , D.cell (D.const D.cord "cord") D.cord
138+ , D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
139 ]
139 ]
140 )
140 )
141 (Bytes.fromByteValues [ 0x01, 0x9F, 0x2E, 0x0C, 0xAE, 0x1C, 0x1C, 0x1D, 0x3C, 0x2D ])
141 (Bytes.fromByteValues [ 0x01, 0x9F, 0x2E, 0x0C, 0xAE, 0x1C, 0x1C, 0x1D, 0x3C, 0x2D ])
@@ -147,8 +147,8 @@ tests =
147 (Just "hi")
147 (Just "hi")
148 (D.runBytes
148 (D.runBytes
149 (D.oneOf
149 (D.oneOf
150− [ D.cell (D.const D.cord "tape") D.tape
150+ [ D.cell (D.const D.cord "tape") D.tape |> D.map (\((), t) -> t)
151− , D.cell (D.const D.cord "cord") D.cord
151+ , D.cell (D.const D.cord "cord") D.cord |> D.map (\((), c) -> c)
152 ]
152 ]
153 )
153 )
154 (Bytes.fromByteValues [ 0x01, 0x7F, 0xEC, 0x4D, 0x8E, 0x0C, 0x1E, 0x2D, 0x0D ])
154 (Bytes.fromByteValues [ 0x01, 0x7F, 0xEC, 0x4D, 0x8E, 0x0C, 0x1E, 0x2D, 0x0D ])
@@ -160,7 +160,7 @@ tests =
160 Expect.equal
160 Expect.equal
161 (Just ( 8, -8 ))
161 (Just ( 8, -8 ))
162 (D.runBytes
162 (D.runBytes
163− (D.cell D.signedInt D.signedInt |> D.map Tuple.pair)
163+ (D.cell D.signedInt D.signedInt)
164 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
164 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
165 )
165 )
166 )
166 )
@@ -190,7 +190,7 @@ tests =
190 (\( f, i, ui ) ->
190 (\( f, i, ui ) ->
191 Expect.equal (Just ( f, i, ui ))
191 Expect.equal (Just ( f, i, ui ))
192 (D.run
192 (D.run
193− (D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\a b c -> ( a, b, c )))
193+ (D.cell D.float64 (D.cell D.signedInt D.int) |> D.map (\(a, (b, c)) -> ( a, b, c )))
194 (C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
194 (C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
195 )
195 )
196 )
196 )