git.iko.soy/airlock
on master help sign in
swap
7e8573725 ahead, 0 behind
55 files changed+3384−638
since splitsnapshots
unifiedsplit
.gitignore+1 LICENSE+7 README.md+43 dev/elm-live.sh → dev/sink-elm-live.sh+1−1 dev/vanilla-elm-live.sh+7 docs/sink.md+101 elm.json+11−2 example/script.js+16−1 example/src/Sink.elm+199 example/src/Main.elm → example/src/Vanilla.elm+36−24 example/urbit/app/journal.hoon+133 example/urbit/desk.bill+2 example/urbit/desk.docket-0+12 example/urbit/gen/journal/add.hoon+37 example/urbit/lib/agentio.hoon+139 example/urbit/lib/dbug.hoon+155 example/urbit/lib/default-agent.hoon+69 example/urbit/lib/docket.hoon+223 example/urbit/lib/journal.hoon+66 example/urbit/lib/noun-diff.hoon+227 example/urbit/lib/sink.hoon+26 example/urbit/lib/skeleton.hoon+51 example/urbit/mar/bill.hoon+34 example/urbit/mar/docket-0.hoon+25 example/urbit/mar/hoon.hoon+49 example/urbit/mar/jam.hoon+17 example/urbit/mar/journal/action.hoon+14 example/urbit/mar/journal/update.hoon+16 example/urbit/mar/json.hoon+26 example/urbit/mar/kelvin.hoon+28 example/urbit/mar/mime.hoon+32 example/urbit/mar/noun.hoon+19 example/urbit/mar/txt-diff.hoon+16 example/urbit/mar/txt.hoon+275 example/urbit/sur/docket.hoon+82 example/urbit/sur/journal.hoon+19 example/urbit/sys.kelvin+1 res/airlock.jpeg src/BitWriter.elm+5−5 src/Ur.elm+94−207 src/Ur/Cmd.elm+27−10 src/Ur/Cmd/Internal.elm+1−2 src/Ur/Constructor.elm+65−16 src/Ur/Da.elm+11−1 src/Ur/Deconstructor.elm+293−198 src/Ur/Jam.elm+193 src/Ur/NounDiff.elm+115 src/Ur/Phonemic.elm+9−12 src/Ur/Requests.elm+7−53 src/Ur/Run.elm+216−81 src/Ur/Sub.elm+41−4 src/Ur/Sub/Internal.elm+4−3 src/Ur/Types.elm+60 src/Ur/Uw.elm+15−7 tests/Test/Urbit.elm+13−11
.gitignore+1
@@ -1,2 +1,3 @@
11elm-stuff
22elm.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.mdnew file+43
@@ -0,0 +1,43 @@
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/elm-live.sh → dev/sink-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/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 @@
33 "name": "ilyakooo0/airlock",
44 "summary": "Urbit airlock",
55 "license": "MIT",
6− "version": "1.0.0",
6+ "version": "1.1.1",
77 "exposed-modules": [
8− "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run"
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"
918 ],
1019 "elm-version": "0.19.0 <= v < 0.20.0",
1120 "dependencies": {
example/script.js+16−1
@@ -2,7 +2,22 @@ import { fetchEventSource } from "/fetch-event-source.js"
22
33const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;
44
5−let app = Elm.Main.init({ node: document.getElementById("elm"), flags: { uid } });
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 } });
621
722app.ports.createEventSource.subscribe((url) => {
823 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+36−24
@@ -1,4 +1,4 @@
1−port module Main exposing (main)
1+port module Vanilla exposing (main)
22
33import BigInt exposing (BigInt)
44import Browser exposing (Document)
@@ -11,9 +11,7 @@ import Time
1111import Ur
1212import Ur.Cmd
1313import Ur.Constructor as C
14−import Ur.Da
1514import Ur.Deconstructor as D
16−import Ur.Requests
1715import Ur.Run
1816import Ur.Sub
1917import Widget
@@ -21,6 +19,12 @@ import Widget.Icon as Icon
2119import Widget.Material as Material
2220
2321
22+url : String
23+url =
24+ "http://localhost:8080"
25+
26+
27+main : Ur.Run.Program Model Msg
2428main =
2529 Ur.Run.application
2630 { init =
@@ -28,21 +32,23 @@ main =
2832 ( { error = ""
2933 , entries = Nothing
3034 , newEntry = ""
35+ , shipName = Nothing
3136 }
3237 , Cmd.batch
33− [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
38+ [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"
3439 |> Cmd.map (result (Debug.toString >> Error) (always Noop))
35− , Ur.Requests.scry
36− { url = "http://localhost:8080"
40+ , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)
41+ , Ur.scry
42+ { url = url
3743 , agent = "journal"
3844 , path = [ "entries", "all" ]
3945 , error = Noop
4046 , success =
4147 D.cell D.ignore
4248 (D.cell (D.const D.cord "jrnl")
43− (D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
44− |> D.map GotListings
49+ (D.list (D.cell D.bigint D.cord))
4550 )
51+ |> D.map (\( (), ( (), listings ) ) -> GotListings listings)
4652 }
4753 ]
4854 |> Ur.Cmd.cmd
@@ -52,22 +58,22 @@ main =
5258 , subscriptions = always Sub.none
5359 , createEventSource = createEventSource
5460 , urbitSubscriptions =
55− \{ entries } ->
56− case entries of
57− Nothing ->
58− Ur.Sub.none
59−
60− Just _ ->
61+ \{ entries, shipName } ->
62+ case ( entries, shipName ) of
63+ ( Just _, Just ship ) ->
6164 Ur.Sub.subscribe
62− { ship = "~zod"
65+ { ship = ship
6366 , app = "journal"
6467 , path = [ "updates" ]
6568 , deconstructor = decodeJournalUpdate |> D.map GotUpdate
6669 }
70+
71+ _ ->
72+ Ur.Sub.none
6773 , onEventSourceMsg = onEventSourceMessage
6874 , onUrlChange = \_ -> Noop
6975 , onUrlRequest = \_ -> Noop
70− , urbitUrl = \_ -> "http://localhost:8080"
76+ , urbitUrl = \_ -> url
7177 }
7278
7379
@@ -75,6 +81,7 @@ type alias Model =
7581 { error : String
7682 , entries : Maybe (List ( BigInt, String ))
7783 , newEntry : String
84+ , shipName : Maybe String
7885 }
7986
8087
@@ -87,6 +94,7 @@ type Msg
8794 | DeleteEntry BigInt
8895 | AddEntry String
8996 | RunCmd (Ur.Cmd.Cmd Msg)
97+ | GotShipName String
9098
9199
92100update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )
@@ -149,7 +157,7 @@ update msg model =
149157 { ship = "~zod"
150158 , agent = "journal"
151159 , mark = "journal-action"
152− , noun = C.cell (C.cord "add") (C.cell (Ur.Da.posixToDa time |> C.bigint) (C.cord txt))
160+ , noun = C.cell (C.cord "add") (C.cell (time |> Time.posixToMillis |> BigInt.fromInt |> C.bigint) (C.cord txt))
153161 }
154162 |> RunCmd
155163 )
@@ -159,6 +167,9 @@ update msg model =
159167 RunCmd cmd ->
160168 ( model, cmd )
161169
170+ GotShipName name ->
171+ ( { model | shipName = Just name }, Ur.Cmd.none )
172+
162173
163174type JournalUpdate
164175 = Add BigInt String
@@ -166,14 +177,15 @@ type JournalUpdate
166177 | Delete BigInt
167178
168179
169−decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a
180+decodeJournalUpdate : D.Deconstructor JournalUpdate
170181decodeJournalUpdate =
171− D.cell D.ignore <|
172− D.oneOf
173− [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add
174− , (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit
175− , D.cell (D.const D.cord "del") D.bigint |> D.map Delete
176− ]
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)
177189
178190
179191view : Model -> Document Msg
example/urbit/app/journal.hoonnew file+133
@@ -0,0 +1,133 @@
1+/- *journal
2+/+ default-agent, dbug, agentio, *sink
3+|%
4++$ versioned-state
5+ $% state-0
6+ ==
7++$ state-0 [%0 =journal =log]
8++$ card card:agent:gall
9+++ j-orm ((on id txt) gth)
10+++ log-orm ((on @ action) lth)
11+++ unique-time
12+ |= [=time =log]
13+ ^- @
14+ =/ unix-ms=@
15+ (unm:chrono:userlib time)
16+ |-
17+ ?. (has:log-orm log unix-ms)
18+ unix-ms
19+ $(time (add unix-ms 1))
20+--
21+
22+%- agent:dbug
23+=/ state *state-0
24+=* entries (tap:j-orm journal.state)
25+=/ snik (sink ~[/sync])
26+=/ sink (snik entries)
27+^- agent:gall
28+::
29+|_ =bowl:gall
30++* this .
31+ def ~(. (default-agent this %|) bowl)
32+ io ~(. agentio bowl)
33+++ on-init on-init:def
34+++ on-save
35+ ^- vase
36+ !>(state)
37+::
38+++ on-load
39+ |= old-vase=vase
40+ ^- (quip card _this)
41+ =/ state !<(versioned-state old-vase)
42+ `this(state state, sink (snik entries))
43+::
44+++ on-poke
45+ |= [=mark =vase]
46+ ^- (quip card _this)
47+ |^
48+ ?> (team:title our.bowl src.bowl)
49+ ?. ?=(%journal-action mark) (on-poke:def mark vase)
50+ =/ now=@ (unique-time now.bowl log.state)
51+ =/ act !<(action vase)
52+ =. 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]
56+ ::
57+ ++ poke-action
58+ |= act=action
59+ ^- _state
60+ ?- -.act
61+ %add
62+ ?< (has:j-orm journal.state id.act)
63+ state(journal (put:j-orm journal.state id.act txt.act))
64+ ::
65+ %edit
66+ ?> (has:j-orm journal.state id.act)
67+ state(journal (put:j-orm journal.state id.act txt.act))
68+ ::
69+ %del
70+ ?> (has:j-orm journal.state id.act)
71+ state(journal +:(del:j-orm journal.state id.act))
72+ ==
73+ --
74+::
75+++ on-watch
76+ |= =path
77+ ^- (quip card _this)
78+ ?> (team:title our.bowl src.bowl)
79+ ?+ path (on-watch:def path)
80+ [%updates ~] `this
81+ [%sync ~] [~[flush:sink] this]
82+ ==
83+::
84+++ on-peek
85+ |= =path
86+ ^- (unit (unit cage))
87+ ?> (team:title our.bowl src.bowl)
88+ =/ now=@ (unm:chrono:userlib now.bowl)
89+ ?+ path (on-peek:def path)
90+ [%x %entries *]
91+ ?+ t.t.path (on-peek:def path)
92+ [%all ~]
93+ :^ ~ ~ %journal-update
94+ !> ^- update
95+ [now %jrnl entries]
96+ ::
97+ [%before @ @ ~]
98+ =/ before=@ (rash i.t.t.t.path dem)
99+ =/ max=@ (rash i.t.t.t.t.path dem)
100+ :^ ~ ~ %journal-update
101+ !> ^- update
102+ [now %jrnl (tab:j-orm journal.state `before max)]
103+ ::
104+ [%between @ @ ~]
105+ =/ start=@
106+ =+ (rash i.t.t.t.path dem)
107+ ?:(=(0 -) - (sub - 1))
108+ =/ end=@ (add 1 (rash i.t.t.t.t.path dem))
109+ :^ ~ ~ %journal-update
110+ !> ^- update
111+ [now %jrnl (tap:j-orm (lot:j-orm journal.state `end `start))]
112+ ==
113+ ::
114+ [%x %updates *]
115+ ?+ t.t.path (on-peek:def path)
116+ [%all ~]
117+ :^ ~ ~ %journal-update
118+ !> ^- update
119+ [now %logs (tap:log-orm log.state)]
120+ ::
121+ [%since @ ~]
122+ =/ since=@ (rash i.t.t.t.path dem)
123+ :^ ~ ~ %journal-update
124+ !> ^- update
125+ [now %logs (tap:log-orm (lot:log-orm log.state `since ~))]
126+ ==
127+ ==
128+::
129+++ on-leave on-leave:def
130+++ on-agent on-agent:def
131+++ on-arvo on-arvo:def
132+++ on-fail on-fail:def
133+--
example/urbit/desk.billnew file+2
@@ -0,0 +1,2 @@
1+:~ %journal
2+==
example/urbit/desk.docket-0new file+12
@@ -0,0 +1,12 @@
1+:~
2+ title+'Journal'
3+ info+'Dear diary...'
4+ color+0xd9.b06d
5+ version+[0 1 1]
6+ website+'https://urbit.org'
7+ license+'MIT'
8+ base+'journal'
9+ :+ %glob-http
10+ 'https://m.tinnus-napbus.xyz/pub/journal-glob-0v3.gjphm.jp4u3.59f0f.a67bf.446k4.glob'
11+ 0v3.gjphm.jp4u3.59f0f.a67bf.446k4
12+==
example/urbit/gen/journal/add.hoonnew file+37
@@ -0,0 +1,37 @@
1+/- *journal, *sole
2+/+ *generators
3+:- %ask
4+|= [[now=@da * bek=beak] *]
5+^- (sole-product (cask action))
6+=| acc=wain
7+=/ off=tape
8+ =/ blit
9+ =+ [our=(scot %p p.bek) now=(scot %da p.r.bek)]
10+ .^(blit:dill %dx /[our]//[now]/sessions//line)
11+ ?. ?=(%lin -.blit) !!
12+ %+ scan (tufa p.blit)
13+ ;~ sfix
14+ %+ cook
15+ |=(t=tape (reap (add 2 (lent t)) ' '))
16+ (star ;~(less gar next))
17+ (star next)
18+ ==
19+|^
20+%+ print leaf+"{off}-------------------------------------\0a"
21+%+ print leaf+"{off}| |"
22+%+ print leaf+"{off}| (\\\\\\ to submit, <BKSP> to cancel) |"
23+%+ print leaf+"{off}| New Journal Entry |"
24+%+ print leaf+"{off}| |"
25+%+ print leaf+"\0a{off}-------------------------------------"
26+line
27+++ line
28+ %+ prompt [%& %prompt ""]
29+ |= t=tape
30+ ?: =(t "\\\\\\")
31+ %+ produce %journal-action
32+ :+ %add
33+ (unm:chrono:userlib now)
34+ (of-wain:format (flop acc))
35+ %+ print leaf+"{off}{t}"
36+ line(acc [(crip t) acc])
37+--
example/urbit/lib/agentio.hoonnew file+139
@@ -0,0 +1,139 @@
1+=>
2+ |%
3+ ++ card card:agent:gall
4+ --
5+::
6+|_ =bowl:gall
7+++ scry
8+ |= [desk=@tas =path]
9+ %+ weld
10+ /(scot %p our.bowl)/[desk]/(scot %da now.bowl)
11+ path
12+::
13+++ pass
14+ |_ =wire
15+ ++ poke
16+ |= [=dock =cage]
17+ [%pass wire %agent dock %poke cage]
18+ ::
19+ ++ poke-our
20+ |= [app=term =cage]
21+ ^- card
22+ (poke [our.bowl app] cage)
23+ ::
24+ ++ poke-self
25+ |= =cage
26+ ^- card
27+ (poke-our dap.bowl cage)
28+ ::
29+ ++ arvo
30+ |= =note-arvo
31+ ^- card
32+ [%pass wire %arvo note-arvo]
33+ ::
34+ ++ watch
35+ |= [=dock =path]
36+ [%pass (watch-wire path) %agent dock %watch path]
37+ ::
38+ ++ watch-our
39+ |= [app=term =path]
40+ (watch [our.bowl app] path)
41+ ::
42+ ++ watch-wire
43+ |= =path
44+ ^+ wire
45+ ?. ?=(~ wire)
46+ wire
47+ agentio-watch+path
48+ ::
49+ ++ leave
50+ |= =dock
51+ [%pass wire %agent dock %leave ~]
52+ ::
53+ ++ leave-our
54+ |= app=term
55+ (leave our.bowl app)
56+ ::
57+ ++ leave-path
58+ |= [=dock =path]
59+ =. wire
60+ (watch-wire path)
61+ (leave dock)
62+ ::
63+ ++ wait
64+ |= p=@da
65+ (arvo %b %wait p)
66+ ::
67+ ++ rest
68+ |= p=@da
69+ (arvo %b %wait p)
70+ ::
71+ ++ warp
72+ |= [wer=ship =riff:clay]
73+ (arvo %c %warp wer riff)
74+ ::
75+ ++ warp-our
76+ |= =riff:clay
77+ (warp our.bowl riff)
78+ ::
79+ :: right here, right now
80+ ++ warp-slim
81+ |= [genre=?(%sing %next) =care:clay =path]
82+ =/ =mood:clay
83+ [care r.byk.bowl path]
84+ =/ =rave:clay
85+ ?:(?=(%sing genre) [genre mood] [genre mood])
86+ (warp-our q.byk.bowl `rave)
87+ ::
88+ ++ connect
89+ |= [=binding:eyre app=term]
90+ (arvo %e %connect binding app)
91+ --
92+::
93+++ fact-curry
94+ |* [=mark =mold]
95+ |= [paths=(list path) fac=mold]
96+ (fact mark^!>(fac) paths)
97+::
98+++ fact-kick
99+ |= [=path =cage]
100+ ^- (list card)
101+ :~ (fact cage ~[path])
102+ (kick ~[path])
103+ ==
104+::
105+++ fact-init
106+ |= =cage
107+ ^- card
108+ [%give %fact ~ cage]
109+::
110+++ fact-init-kick
111+ |= =cage
112+ ^- (list card)
113+ :~ (fact cage ~)
114+ (kick ~)
115+ ==
116+::
117+++ fact
118+ |= [=cage paths=(list path)]
119+ ^- card
120+ [%give %fact paths cage]
121+::
122+++ fact-all
123+ |= =cage
124+ ^- (unit card)
125+ =/ paths=(set path)
126+ %- ~(gas in *(set path))
127+ %+ turn ~(tap by sup.bowl)
128+ |=([duct ship =path] path)
129+ ?: =(~ paths) ~
130+ `(fact cage ~(tap in paths))
131+::
132+++ kick
133+ |= paths=(list path)
134+ [%give %kick paths ~]
135+::
136+++ kick-only
137+ |= [=ship paths=(list path)]
138+ [%give %kick paths `ship]
139+--
example/urbit/lib/dbug.hoonnew file+155
@@ -0,0 +1,155 @@
1+:: dbug: agent wrapper for generic debugging tools
2+::
3+:: usage: %-(agent:dbug your-agent)
4+::
5+|%
6++$ poke
7+ $% [%bowl ~]
8+ [%state grab=cord]
9+ [%incoming =about]
10+ [%outgoing =about]
11+ ==
12+::
13++$ about
14+ $@ ~
15+ $% [%ship =ship]
16+ [%path =path]
17+ [%wire =wire]
18+ [%term =term]
19+ ==
20+::
21+++ agent
22+ |= =agent:gall
23+ ^- agent:gall
24+ !.
25+ |_ =bowl:gall
26+ +* this .
27+ ag ~(. agent bowl)
28+ ::
29+ ++ on-poke
30+ |= [=mark =vase]
31+ ^- (quip card:agent:gall agent:gall)
32+ ?. ?=(%dbug mark)
33+ =^ cards agent (on-poke:ag mark vase)
34+ [cards this]
35+ =/ dbug
36+ !<(poke vase)
37+ =; =tang
38+ ((%*(. slog pri 1) tang) [~ this])
39+ ?- -.dbug
40+ %bowl [(sell !>(bowl))]~
41+ ::
42+ %state
43+ =? grab.dbug =('' grab.dbug) '-'
44+ =; product=^vase
45+ [(sell product)]~
46+ =/ state=^vase
47+ :: if the underlying app has implemented a /dbug/state scry endpoint,
48+ :: use that vase in place of +on-save's.
49+ ::
50+ =/ result=(each ^vase tang)
51+ (mule |.(q:(need (need (on-peek:ag /x/dbug/state)))))
52+ ?:(?=(%& -.result) p.result on-save:ag)
53+ %+ slap
54+ (slop state !>([bowl=bowl ..zuse]))
55+ (ream grab.dbug)
56+ ::
57+ %incoming
58+ =; =tang
59+ ?^ tang tang
60+ [%leaf "no matching subscriptions"]~
61+ %+ murn
62+ %+ sort ~(tap by sup.bowl)
63+ |= [[* a=[=ship =path]] [* b=[=ship =path]]]
64+ (aor [path ship]:a [path ship]:b)
65+ |= [=duct [=ship =path]]
66+ ^- (unit tank)
67+ =; relevant=?
68+ ?. relevant ~
69+ `>[path=path from=ship duct=duct]<
70+ ?: ?=(~ about.dbug) &
71+ ?- -.about.dbug
72+ %ship =(ship ship.about.dbug)
73+ %path ?=(^ (find path.about.dbug path))
74+ %wire %+ lien duct
75+ |=(=wire ?=(^ (find wire.about.dbug wire)))
76+ %term !!
77+ ==
78+ ::
79+ %outgoing
80+ =; =tang
81+ ?^ tang tang
82+ [%leaf "no matching subscriptions"]~
83+ %+ murn
84+ %+ sort ~(tap by wex.bowl)
85+ |= [[[a=wire *] *] [[b=wire *] *]]
86+ (aor a b)
87+ |= [[=wire =ship =term] [acked=? =path]]
88+ ^- (unit tank)
89+ =; relevant=?
90+ ?. relevant ~
91+ `>[wire=wire agnt=[ship term] path=path ackd=acked]<
92+ ?: ?=(~ about.dbug) &
93+ ?- -.about.dbug
94+ %ship =(ship ship.about.dbug)
95+ %path ?=(^ (find path.about.dbug path))
96+ %wire ?=(^ (find wire.about.dbug wire))
97+ %term =(term term.about.dbug)
98+ ==
99+ ==
100+ ::
101+ ++ on-peek
102+ |= =path
103+ ^- (unit (unit cage))
104+ ?. ?=([@ %dbug *] path)
105+ (on-peek:ag path)
106+ ?+ path [~ ~]
107+ [%u %dbug ~] ``noun+!>(&)
108+ [%x %dbug %state ~] ``noun+!>(on-save:ag)
109+ [%x %dbug %subscriptions ~] ``noun+!>([wex sup]:bowl)
110+ ==
111+ ::
112+ ++ on-init
113+ ^- (quip card:agent:gall agent:gall)
114+ =^ cards agent on-init:ag
115+ [cards this]
116+ ::
117+ ++ on-save on-save:ag
118+ ::
119+ ++ on-load
120+ |= old-state=vase
121+ ^- (quip card:agent:gall agent:gall)
122+ =^ cards agent (on-load:ag old-state)
123+ [cards this]
124+ ::
125+ ++ on-watch
126+ |= =path
127+ ^- (quip card:agent:gall agent:gall)
128+ =^ cards agent (on-watch:ag path)
129+ [cards this]
130+ ::
131+ ++ on-leave
132+ |= =path
133+ ^- (quip card:agent:gall agent:gall)
134+ =^ cards agent (on-leave:ag path)
135+ [cards this]
136+ ::
137+ ++ on-agent
138+ |= [=wire =sign:agent:gall]
139+ ^- (quip card:agent:gall agent:gall)
140+ =^ cards agent (on-agent:ag wire sign)
141+ [cards this]
142+ ::
143+ ++ on-arvo
144+ |= [=wire =sign-arvo]
145+ ^- (quip card:agent:gall agent:gall)
146+ =^ cards agent (on-arvo:ag wire sign-arvo)
147+ [cards this]
148+ ::
149+ ++ on-fail
150+ |= [=term =tang]
151+ ^- (quip card:agent:gall agent:gall)
152+ =^ cards agent (on-fail:ag term tang)
153+ [cards this]
154+ --
155+--
example/urbit/lib/default-agent.hoonnew file+69
@@ -0,0 +1,69 @@
1+/+ skeleton
2+|* [agent=* help=*]
3+?: ?=(%& help)
4+ ~| %default-agent-helpfully-crashing
5+ skeleton
6+|_ =bowl:gall
7+++ on-init
8+ `agent
9+::
10+++ on-save
11+ !>(~)
12+::
13+++ on-load
14+ |= old-state=vase
15+ `agent
16+::
17+++ on-poke
18+ |= =cage
19+ ~| "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
20+ !!
21+::
22+++ on-watch
23+ |= =path
24+ ~| "unexpected subscription to {<dap.bowl>} on path {<path>}"
25+ !!
26+::
27+++ on-leave
28+ |= path
29+ `agent
30+::
31+++ on-peek
32+ |= =path
33+ ~| "unexpected scry into {<dap.bowl>} on path {<path>}"
34+ !!
35+::
36+++ on-agent
37+ |= [=wire =sign:agent:gall]
38+ ^- (quip card:agent:gall _agent)
39+ ?- -.sign
40+ %poke-ack
41+ ?~ p.sign
42+ `agent
43+ %- (slog leaf+"poke failed from {<dap.bowl>} on wire {<wire>}" u.p.sign)
44+ `agent
45+ ::
46+ %watch-ack
47+ ?~ p.sign
48+ `agent
49+ =/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
50+ %- (slog tank u.p.sign)
51+ `agent
52+ ::
53+ %kick `agent
54+ %fact
55+ ~| "unexpected subscription update to {<dap.bowl>} on wire {<wire>}"
56+ ~| "with mark {<p.cage.sign>}"
57+ !!
58+ ==
59+::
60+++ on-arvo
61+ |= [=wire =sign-arvo]
62+ ~| "unexpected system response {<-.sign-arvo>} to {<dap.bowl>} on wire {<wire>}"
63+ !!
64+::
65+++ on-fail
66+ |= [=term =tang]
67+ %- (slog leaf+"error in {<dap.bowl>}" >term< tang)
68+ `agent
69+--
example/urbit/lib/docket.hoonnew file+223
@@ -0,0 +1,223 @@
1+/- *docket
2+|%
3+::
4+++ mime
5+ |%
6+ +$ draft
7+ $: title=(unit @t)
8+ info=(unit @t)
9+ color=(unit @ux)
10+ glob-http=(unit [=url hash=@uvH])
11+ glob-ames=(unit [=ship hash=@uvH])
12+ base=(unit term)
13+ site=(unit path)
14+ image=(unit url)
15+ version=(unit version)
16+ website=(unit url)
17+ license=(unit cord)
18+ ==
19+ ::
20+ ++ finalize
21+ |= =draft
22+ ^- (unit docket)
23+ ?~ title.draft ~
24+ ?~ info.draft ~
25+ ?~ color.draft ~
26+ ?~ version.draft ~
27+ ?~ website.draft ~
28+ ?~ license.draft ~
29+ =/ href=(unit href)
30+ ?^ site.draft `[%site u.site.draft]
31+ ?~ base.draft ~
32+ ?^ glob-http.draft
33+ `[%glob u.base hash.u.glob-http %http url.u.glob-http]:draft
34+ ?~ glob-ames.draft
35+ ~
36+ `[%glob u.base hash.u.glob-ames %ames ship.u.glob-ames]:draft
37+ ?~ href ~
38+ =, draft
39+ :- ~
40+ :* %1
41+ u.title
42+ u.info
43+ u.color
44+ u.href
45+ image
46+ u.version
47+ u.website
48+ u.license
49+ ==
50+ ::
51+ ++ from-clauses
52+ =| =draft
53+ |= cls=(list clause)
54+ ^- (unit docket)
55+ =* loop $
56+ ?~ cls (finalize draft)
57+ =* clause i.cls
58+ =. draft
59+ ?- -.clause
60+ %title draft(title `title.clause)
61+ %info draft(info `info.clause)
62+ %color draft(color `color.clause)
63+ %glob-http draft(glob-http `[url hash]:clause)
64+ %glob-ames draft(glob-ames `[ship hash]:clause)
65+ %base draft(base `base.clause)
66+ %site draft(site `path.clause)
67+ %image draft(image `url.clause)
68+ %version draft(version `version.clause)
69+ %website draft(website `website.clause)
70+ %license draft(license `license.clause)
71+ ==
72+ loop(cls t.cls)
73+ ::
74+ ++ to-clauses
75+ |= d=docket
76+ ^- (list clause)
77+ %- zing
78+ :~ :~ title+title.d
79+ info+info.d
80+ color+color.d
81+ version+version.d
82+ website+website.d
83+ license+license.d
84+ ==
85+ ?~ image.d ~ ~[image+u.image.d]
86+ ?: ?=(%site -.href.d) ~[site+path.href.d]
87+ =/ ref=glob-reference glob-reference.href.d
88+ :~ base+base.href.d
89+ ?- -.location.ref
90+ %http [%glob-http url.location.ref hash.ref]
91+ %ames [%glob-ames ship.location.ref hash.ref]
92+ == == ==
93+ ::
94+ ++ spit-clause
95+ |= =clause
96+ ^- tape
97+ %+ weld " {(trip -.clause)}+"
98+ ?+ -.clause "'{(trip +.clause)}'"
99+ %color (scow %ux color.clause)
100+ %site (spud path.clause)
101+ ::
102+ %glob-http
103+ "['{(trip url.clause)}' {(scow %uv hash.clause)}]"
104+ ::
105+ %glob-ames
106+ "[{(scow %p ship.clause)} {(scow %uv hash.clause)}]"
107+ ::
108+ %version
109+ =, version.clause
110+ "[{(scow %ud major)} {(scow %ud minor)} {(scow %ud patch)}]"
111+ ==
112+ ::
113+ ++ spit-docket
114+ |= dock=docket
115+ ^- tape
116+ ;: welp
117+ ":~\0a"
118+ `tape`(zing (join "\0a" (turn (to-clauses dock) spit-clause)))
119+ "\0a=="
120+ ==
121+ --
122+::
123+++ enjs
124+ =, enjs:format
125+ |%
126+ ::
127+ ++ charge-update
128+ |= u=^charge-update
129+ ^- json
130+ %+ frond -.u
131+ ^- json
132+ ?- -.u
133+ %del-charge s+desk.u
134+ ::
135+ %initial
136+ %- pairs
137+ %+ turn ~(tap by initial.u)
138+ |=([=desk c=^charge] [desk (charge c)])
139+ ::
140+ %add-charge
141+ %- pairs
142+ :~ desk+s+desk.u
143+ charge+(charge charge.u)
144+ ==
145+ ==
146+ ::
147+ ++ num
148+ |= a=@u
149+ ^- ^tape
150+ =/ p=json (numb a)
151+ ?> ?=(%n -.p)
152+ (trip p.p)
153+ ::
154+ ++ version
155+ |= v=^version
156+ ^- json
157+ :- %s
158+ %- crip
159+ "{(num major.v)}.{(num minor.v)}.{(num patch.v)}"
160+ ::
161+ ++ merge
162+ |= [a=json b=json]
163+ ^- json
164+ ?> &(?=(%o -.a) ?=(%o -.b))
165+ [%o (~(uni by p.a) p.b)]
166+ ::
167+ ++ href
168+ |= h=^href
169+ %+ frond -.h
170+ ?- -.h
171+ %site s+(spat path.h)
172+ %glob
173+ %- pairs
174+ :~ base+s+base.h
175+ glob-reference+(glob-reference glob-reference.h)
176+ ==
177+ ==
178+ ::
179+ ++ glob-reference
180+ |= ref=^glob-reference
181+ %- pairs
182+ :~ hash+s+(scot %uv hash.ref)
183+ location+(glob-location location.ref)
184+ ==
185+ ::
186+ ++ glob-location
187+ |= loc=^glob-location
188+ ^- json
189+ %+ frond -.loc
190+ ?- -.loc
191+ %http s+url.loc
192+ %ames s+(scot %p ship.loc)
193+ ==
194+ ::
195+ ++ charge
196+ |= c=^charge
197+ %+ merge (docket docket.c)
198+ %- pairs
199+ :~ chad+(chad chad.c)
200+ ==
201+ ::
202+ ++ docket
203+ |= d=^docket
204+ ^- json
205+ %- pairs
206+ :~ title+s+title.d
207+ info+s+info.d
208+ color+s+(scot %ux color.d)
209+ href+(href href.d)
210+ image+?~(image.d ~ s+u.image.d)
211+ version+(version version.d)
212+ license+s+license.d
213+ website+s+website.d
214+ ==
215+ ::
216+ ++ chad
217+ |= c=^chad
218+ %+ frond -.c
219+ ?+ -.c ~
220+ %hung s+err.c
221+ ==
222+ --
223+--
example/urbit/lib/journal.hoonnew file+66
@@ -0,0 +1,66 @@
1+/- *journal
2+|%
3+++ dejs-action
4+ =, dejs:format
5+ |= jon=json
6+ ^- action
7+ %. jon
8+ %- of
9+ :~ [%add (ot ~[id+ni txt+so])]
10+ [%edit (ot ~[id+ni txt+so])]
11+ [%del (ot ~[id+ni])]
12+ ==
13+++ enjs-update
14+ =, enjs:format
15+ |= upd=update
16+ ^- json
17+ |^
18+ ?+ -.q.upd (logged upd)
19+ %jrnl
20+ %- pairs
21+ :~ ['time' (numb p.upd)]
22+ ['entries' a+(turn list.q.upd entry)]
23+ ==
24+ ::
25+ %logs
26+ %- pairs
27+ :~ ['time' (numb p.upd)]
28+ ['logs' a+(turn list.q.upd logged)]
29+ ==
30+ ==
31+ ++ entry
32+ |= ent=^entry
33+ ^- json
34+ %- pairs
35+ :~ ['id' (numb id.ent)]
36+ ['txt' s+txt.ent]
37+ ==
38+ ++ logged
39+ |= lgd=^logged
40+ ^- json
41+ ?- -.q.lgd
42+ %add
43+ %- pairs
44+ :~ ['time' (numb p.lgd)]
45+ :- 'add'
46+ %- pairs
47+ :~ ['id' (numb id.q.lgd)]
48+ ['txt' s+txt.q.lgd]
49+ == ==
50+ %edit
51+ %- pairs
52+ :~ ['time' (numb p.lgd)]
53+ :- 'edit'
54+ %- pairs
55+ :~ ['id' (numb id.q.lgd)]
56+ ['txt' s+txt.q.lgd]
57+ == ==
58+ %del
59+ %- pairs
60+ :~ ['time' (numb p.lgd)]
61+ :- 'del'
62+ (frond 'id' (numb id.q.lgd))
63+ ==
64+ ==
65+ --
66+--
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/urbit/lib/skeleton.hoonnew file+51
@@ -0,0 +1,51 @@
1+:: Similar to default-agent except crashes everywhere
2+^- agent:gall
3+|_ bowl:gall
4+++ on-init
5+ ^- (quip card:agent:gall agent:gall)
6+ !!
7+::
8+++ on-save
9+ ^- vase
10+ !!
11+::
12+++ on-load
13+ |~ old-state=vase
14+ ^- (quip card:agent:gall agent:gall)
15+ !!
16+::
17+++ on-poke
18+ |~ in-poke-data=cage
19+ ^- (quip card:agent:gall agent:gall)
20+ !!
21+::
22+++ on-watch
23+ |~ path
24+ ^- (quip card:agent:gall agent:gall)
25+ !!
26+::
27+++ on-leave
28+ |~ path
29+ ^- (quip card:agent:gall agent:gall)
30+ !!
31+::
32+++ on-peek
33+ |~ path
34+ ^- (unit (unit cage))
35+ !!
36+::
37+++ on-agent
38+ |~ [wire sign:agent:gall]
39+ ^- (quip card:agent:gall agent:gall)
40+ !!
41+::
42+++ on-arvo
43+ |~ [wire =sign-arvo]
44+ ^- (quip card:agent:gall agent:gall)
45+ !!
46+::
47+++ on-fail
48+ |~ [term tang]
49+ ^- (quip card:agent:gall agent:gall)
50+ !!
51+--
example/urbit/mar/bill.hoonnew file+34
@@ -0,0 +1,34 @@
1+|_ bil=(list dude:gall)
2+++ grow
3+ |%
4+ ++ mime `^mime`[/text/x-bill (as-octs:mimes:html hoon)]
5+ ++ noun bil
6+ ++ hoon
7+ ^- @t
8+ |^ (crip (of-wall:format (wrap-lines (spit-duz bil))))
9+ ::
10+ ++ wrap-lines
11+ |= taz=wall
12+ ^- wall
13+ ?~ taz ["~"]~
14+ :- (weld ":~ " i.taz)
15+ %- snoc :_ "=="
16+ (turn t.taz |=(t=tape (weld " " t)))
17+ ::
18+ ++ spit-duz
19+ |= duz=(list dude:gall)
20+ ^- wall
21+ (turn duz |=(=dude:gall ['%' (trip dude)]))
22+ --
23+ ++ txt (to-wain:format hoon)
24+ --
25+++ grab
26+ |%
27+ ++ noun (list dude:gall)
28+ ++ mime
29+ |= [=mite len=@ud tex=@]
30+ ~_ tex
31+ !<((list dude:gall) (slap !>(~) (ream tex)))
32+ --
33+++ grad %noun
34+--
example/urbit/mar/docket-0.hoonnew file+25
@@ -0,0 +1,25 @@
1+/+ dock=docket
2+|_ =docket:dock
3+++ grow
4+ |%
5+ ++ mime
6+ ^- ^mime
7+ [/text/x-docket (as-octt:mimes:html (spit-docket:mime:dock docket))]
8+ ++ noun docket
9+ ++ json (docket:enjs:dock docket)
10+ --
11+++ grab
12+ |%
13+ ::
14+ ++ mime
15+ |= [=mite len=@ud tex=@]
16+ ^- docket:dock
17+ %- need
18+ %- from-clauses:mime:dock
19+ !<((list clause:dock) (slap !>(~) (ream tex)))
20+
21+ ::
22+ ++ noun docket:dock
23+ --
24+++ grad %noun
25+--
example/urbit/mar/hoon.hoonnew file+49
@@ -0,0 +1,49 @@
1+:::: /hoon/hoon/mar
2+ ::
3+/? 310
4+::
5+=, eyre
6+|_ own=@t
7+::
8+++ grow :: convert to
9+ |%
10+ ++ mime `^mime`[/text/x-hoon (as-octs:mimes:html own)] :: convert to %mime
11+ ++ elem :: convert to %html
12+ ;div:pre(urb_codemirror "", mode "hoon"):"{(trip own)}"
13+ :: =+ gen-id="src-{<`@ui`(mug own)>}"
14+ :: ;div
15+ :: ;textarea(id "{gen-id}"):"{(trip own)}"
16+ :: ;script:"""
17+ :: CodeMirror.fromTextArea(
18+ :: window[{<gen-id>}],
19+ :: \{lineNumbers:true, readOnly:true}
20+ :: )
21+ :: """
22+ :: ==
23+ ++ hymn
24+ :: ;html:(head:title:"Source" "+{elem}")
25+ ;html
26+ ;head
27+ ;title:"Source"
28+ ;script@"//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js";
29+ ;script@"/lib/syntax/hoon.js";
30+ ;link(rel "stylesheet", href "//cdnjs.cloudflare.com/ajax/libs/".
31+ "codemirror/4.3.0/codemirror.min.css");
32+ ;link/"/lib/syntax/codemirror.css"(rel "stylesheet");
33+ ==
34+ ;body
35+ ;textarea#src:"{(trip own)}"
36+ ;script:'CodeMirror.fromTextArea(src, {lineNumbers:true, readOnly:true})'
37+ ==
38+ ==
39+ ++ txt
40+ (to-wain:format own)
41+ --
42+++ grab
43+ |% :: convert from
44+ ++ mime |=([p=mite q=octs] q.q)
45+ ++ noun @t :: clam from %noun
46+ ++ txt of-wain:format
47+ --
48+++ grad %txt
49+--
example/urbit/mar/jam.hoonnew file+17
@@ -0,0 +1,17 @@
1+::
2+:::: /hoon/jam/mar
3+ ::
4+/? 310
5+::
6+=, mimes:html
7+|_ mud=@
8+++ grow
9+ |%
10+ ++ mime [/application/octet-stream (as-octs mud)]
11+ --
12+++ grab
13+ |% :: convert from
14+ ++ noun @ :: clam from %noun
15+ --
16+++ grad %mime
17+--
example/urbit/mar/journal/action.hoonnew file+14
@@ -0,0 +1,14 @@
1+/- *journal
2+/+ *journal
3+|_ act=action
4+++ grow
5+ |%
6+ ++ noun act
7+ --
8+++ grab
9+ |%
10+ ++ noun action
11+ ++ json dejs-action
12+ --
13+++ grad %noun
14+--
example/urbit/mar/journal/update.hoonnew file+16
@@ -0,0 +1,16 @@
1+/- *journal
2+/+ *journal
3+|_ upd=update
4+++ grow
5+ |%
6+ ++ noun upd
7+ ++ json (enjs-update upd)
8+ ++ jam (^jam upd)
9+ --
10+++ grab
11+ |%
12+ ++ noun update
13+ ++ jam cue
14+ --
15+++ grad %noun
16+--
example/urbit/mar/json.hoonnew file+26
@@ -0,0 +1,26 @@
1+::
2+:::: /hoon/json/mar
3+ ::
4+/? 310
5+ ::
6+:::: compute
7+ ::
8+=, eyre
9+=, format
10+=, html
11+|_ jon=^json
12+::
13+++ grow :: convert to
14+ |%
15+ ++ mime [/application/json (as-octs:mimes -:txt)] :: convert to %mime
16+ ++ txt [(en:json jon)]~
17+ --
18+++ grab
19+ |% :: convert from
20+ ++ mime |=([p=mite q=octs] (fall (de:json (@t q.q)) *^json))
21+ ++ noun ^json :: clam from %noun
22+ ++ numb numb:enjs
23+ ++ time time:enjs
24+ --
25+++ grad %mime
26+--
example/urbit/mar/kelvin.hoonnew file+28
@@ -0,0 +1,28 @@
1+|_ kal=waft:clay
2+++ grow
3+ |%
4+ ++ mime `^mime`[/text/x-kelvin (as-octs:mimes:html hoon)]
5+ ++ noun kal
6+ ++ hoon
7+ %+ rap 3
8+ %+ turn
9+ %+ sort
10+ ~(tap in (waft-to-wefts:clay kal))
11+ |= [a=weft b=weft]
12+ ?: =(lal.a lal.b)
13+ (gte num.a num.b)
14+ (gte lal.a lal.b)
15+ |= =weft
16+ (rap 3 '[%' (scot %tas lal.weft) ' ' (scot %ud num.weft) ']\0a' ~)
17+ ::
18+ ++ txt (to-wain:format hoon)
19+ --
20+++ grab
21+ |%
22+ ++ noun waft:clay
23+ ++ mime
24+ |= [=mite len=@ud tex=@]
25+ (cord-to-waft:clay tex)
26+ --
27+++ grad %noun
28+--
example/urbit/mar/mime.hoonnew file+32
@@ -0,0 +1,32 @@
1+::
2+:::: /hoon/mime/mar
3+ ::
4+/? 310
5+::
6+|_ own=mime
7+++ grow
8+ ^?
9+ |%
10+ ++ jam `@`q.q.own
11+ --
12+::
13+++ grab :: convert from
14+ ^?
15+ |%
16+ ++ noun mime :: clam from %noun
17+ ++ tape
18+ |=(a=_"" [/application/x-urb-unknown (as-octt:mimes:html a)])
19+ --
20+++ grad
21+ ^?
22+ |%
23+ ++ form %mime
24+ ++ diff |=(mime +<)
25+ ++ pact |=(mime +<)
26+ ++ join |=([mime mime] `(unit mime)`~)
27+ ++ mash
28+ |= [[ship desk mime] [ship desk mime]]
29+ ^- mime
30+ ~|(%mime-mash !!)
31+ --
32+--
example/urbit/mar/noun.hoonnew file+19
@@ -0,0 +1,19 @@
1+::
2+:::: /hoon/noun/mar
3+ ::
4+/? 310
5+!:
6+:::: A minimal noun mark
7+|_ non=*
8+++ grab |%
9+ ++ noun *
10+ --
11+++ grad
12+ |%
13+ ++ form %noun
14+ ++ diff |=(* +<)
15+ ++ pact |=(* +<)
16+ ++ join |=([* *] *(unit *))
17+ ++ mash |=([[ship desk *] [ship desk *]] `*`~|(%noun-mash !!))
18+ --
19+--
example/urbit/mar/txt-diff.hoonnew file+16
@@ -0,0 +1,16 @@
1+::
2+:::: /hoon/txt-diff/mar
3+ ::
4+/? 310
5+|_ txt-diff=(urge:clay cord)
6+::
7+++ grad %noun
8+++ grow
9+ |%
10+ ++ noun txt-diff
11+ --
12+++ grab :: convert from
13+ |%
14+ ++ noun (urge:clay cord) :: make from %noun
15+ --
16+--
example/urbit/mar/txt.hoonnew file+275
@@ -0,0 +1,275 @@
1+::
2+:::: /hoon/txt/mar
3+ ::
4+/? 310
5+::
6+=, clay
7+=, differ
8+=, format
9+=, mimes:html
10+|_ txt=wain
11+::
12+++ grab :: convert from
13+ |%
14+ ++ mime |=((pair mite octs) (to-wain q.q))
15+ ++ noun wain :: clam from %noun
16+ --
17+++ grow
18+ => v=.
19+ |%
20+ ++ mime => v [/text/plain (as-octs (of-wain txt))]
21+ ++ elem => v ;pre: {(trip (of-wain txt))}
22+ --
23+++ grad
24+ |%
25+ ++ form %txt-diff
26+ ++ diff
27+ |= tyt=wain
28+ ^- (urge cord)
29+ (lusk txt tyt (loss txt tyt))
30+ ::
31+ ++ pact
32+ |= dif=(urge cord)
33+ ~| [%pacting dif]
34+ ^- wain
35+ (lurk txt dif)
36+ ::
37+ ++ join
38+ |= [ali=(urge cord) bob=(urge cord)]
39+ ^- (unit (urge cord))
40+ |^
41+ =. ali (clean ali)
42+ =. bob (clean bob)
43+ |- ^- (unit (urge cord))
44+ ?~ ali `bob
45+ ?~ bob `ali
46+ ?- -.i.ali
47+ %&
48+ ?- -.i.bob
49+ %&
50+ ?: =(p.i.ali p.i.bob)
51+ %+ bind $(ali t.ali, bob t.bob)
52+ |=(cud=(urge cord) [i.ali cud])
53+ ?: (gth p.i.ali p.i.bob)
54+ %+ bind $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob)
55+ |=(cud=(urge cord) [i.bob cud])
56+ %+ bind $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali))
57+ |=(cud=(urge cord) [i.ali cud])
58+ ::
59+ %|
60+ ?: =(p.i.ali (lent p.i.bob))
61+ %+ bind $(ali t.ali, bob t.bob)
62+ |=(cud=(urge cord) [i.bob cud])
63+ ?: (gth p.i.ali (lent p.i.bob))
64+ %+ bind $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob)
65+ |=(cud=(urge cord) [i.bob cud])
66+ ~
67+ ==
68+ ::
69+ %|
70+ ?- -.i.bob
71+ %|
72+ ?. =(i.ali i.bob)
73+ ~
74+ %+ bind $(ali t.ali, bob t.bob)
75+ |=(cud=(urge cord) [i.ali cud])
76+ ::
77+ %&
78+ ?: =(p.i.bob (lent p.i.ali))
79+ %+ bind $(ali t.ali, bob t.bob)
80+ |=(cud=(urge cord) [i.ali cud])
81+ ?: (gth p.i.bob (lent p.i.ali))
82+ %+ bind $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali)))
83+ |=(cud=(urge cord) [i.ali cud])
84+ ~
85+ ==
86+ ==
87+ ++ clean :: clean
88+ |= wig=(urge cord)
89+ ^- (urge cord)
90+ ?~ wig ~
91+ ?~ t.wig wig
92+ ?: ?=(%& -.i.wig)
93+ ?: ?=(%& -.i.t.wig)
94+ $(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig])
95+ [i.wig $(wig t.wig)]
96+ ?: ?=(%| -.i.t.wig)
97+ $(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig])
98+ [i.wig $(wig t.wig)]
99+ --
100+ ::
101+ ++ mash
102+ |= $: [als=ship ald=desk ali=(urge cord)]
103+ [bos=ship bod=desk bob=(urge cord)]
104+ ==
105+ ^- (urge cord)
106+ |^
107+ =. ali (clean ali)
108+ =. bob (clean bob)
109+ |- ^- (urge cord)
110+ ?~ ali bob
111+ ?~ bob ali
112+ ?- -.i.ali
113+ %&
114+ ?- -.i.bob
115+ %&
116+ ?: =(p.i.ali p.i.bob)
117+ [i.ali $(ali t.ali, bob t.bob)]
118+ ?: (gth p.i.ali p.i.bob)
119+ [i.bob $(p.i.ali (sub p.i.ali p.i.bob), bob t.bob)]
120+ [i.ali $(ali t.ali, p.i.bob (sub p.i.bob p.i.ali))]
121+ ::
122+ %|
123+ ?: =(p.i.ali (lent p.i.bob))
124+ [i.bob $(ali t.ali, bob t.bob)]
125+ ?: (gth p.i.ali (lent p.i.bob))
126+ [i.bob $(p.i.ali (sub p.i.ali (lent p.i.bob)), bob t.bob)]
127+ =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
128+ (resolve ali bob)
129+ [fic $(ali ali, bob bob)]
130+ :: ~ :: here, alice is good for a while, but not for the whole
131+ == :: length of bob's changes
132+ ::
133+ %|
134+ ?- -.i.bob
135+ %|
136+ =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
137+ (resolve ali bob)
138+ [fic $(ali ali, bob bob)]
139+ ::
140+ %&
141+ ?: =(p.i.bob (lent p.i.ali))
142+ [i.ali $(ali t.ali, bob t.bob)]
143+ ?: (gth p.i.bob (lent p.i.ali))
144+ [i.ali $(ali t.ali, p.i.bob (sub p.i.bob (lent p.i.ali)))]
145+ =/ [fic=(unce cord) ali=(urge cord) bob=(urge cord)]
146+ (resolve ali bob)
147+ [fic $(ali ali, bob bob)]
148+ ==
149+ ==
150+ ::
151+ ++ annotate :: annotate conflict
152+ |= $: ali=(list @t)
153+ bob=(list @t)
154+ bas=(list @t)
155+ ==
156+ ^- (list @t)
157+ %- zing
158+ ^- (list (list @t))
159+ %- flop
160+ ^- (list (list @t))
161+ :- :_ ~
162+ %^ cat 3 '<<<<<<<<<<<<'
163+ %^ cat 3 ' '
164+ %^ cat 3 `@t`(scot %p bos)
165+ %^ cat 3 '/'
166+ bod
167+
168+ :- bob
169+ :- ~['------------']
170+ :- bas
171+ :- ~['++++++++++++']
172+ :- ali
173+ :- :_ ~
174+ %^ cat 3 '>>>>>>>>>>>>'
175+ %^ cat 3 ' '
176+ %^ cat 3 `@t`(scot %p als)
177+ %^ cat 3 '/'
178+ ald
179+ ~
180+ ::
181+ ++ clean :: clean
182+ |= wig=(urge cord)
183+ ^- (urge cord)
184+ ?~ wig ~
185+ ?~ t.wig wig
186+ ?: ?=(%& -.i.wig)
187+ ?: ?=(%& -.i.t.wig)
188+ $(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig])
189+ [i.wig $(wig t.wig)]
190+ ?: ?=(%| -.i.t.wig)
191+ $(wig [[%| (welp p.i.wig p.i.t.wig) (welp q.i.wig q.i.t.wig)] t.t.wig])
192+ [i.wig $(wig t.wig)]
193+ ::
194+ ++ resolve
195+ |= [ali=(urge cord) bob=(urge cord)]
196+ ^- [fic=[%| p=(list cord) q=(list cord)] ali=(urge cord) bob=(urge cord)]
197+ =- [[%| bac (annotate alc boc bac)] ali bob]
198+ |- ^- $: $: bac=(list cord)
199+ alc=(list cord)
200+ boc=(list cord)
201+ ==
202+ ali=(urge cord)
203+ bob=(urge cord)
204+ ==
205+ ?~ ali [[~ ~ ~] ali bob]
206+ ?~ bob [[~ ~ ~] ali bob]
207+ ?- -.i.ali
208+ %&
209+ ?- -.i.bob
210+ %& [[~ ~ ~] ali bob] :: no conflict
211+ %|
212+ =+ lob=(lent p.i.bob)
213+ ?: =(lob p.i.ali)
214+ [[p.i.bob p.i.bob q.i.bob] t.ali t.bob]
215+ ?: (lth lob p.i.ali)
216+ [[p.i.bob p.i.bob q.i.bob] [[%& (sub p.i.ali lob)] t.ali] t.bob]
217+ =+ wat=(scag (sub lob p.i.ali) p.i.bob)
218+ =+ ^= res
219+ %= $
220+ ali t.ali
221+ bob [[%| (scag (sub lob p.i.ali) p.i.bob) ~] t.bob]
222+ ==
223+ :* :* (welp bac.res wat)
224+ (welp alc.res wat)
225+ (welp boc.res q.i.bob)
226+ ==
227+ ali.res
228+ bob.res
229+ ==
230+ ==
231+ ::
232+ %|
233+ ?- -.i.bob
234+ %&
235+ =+ loa=(lent p.i.ali)
236+ ?: =(loa p.i.bob)
237+ [[p.i.ali q.i.ali p.i.ali] t.ali t.bob]
238+ ?: (lth loa p.i.bob)
239+ [[p.i.ali q.i.ali p.i.ali] t.ali [[%& (sub p.i.bob loa)] t.bob]]
240+ =+ wat=(slag (sub loa p.i.bob) p.i.ali)
241+ =+ ^= res
242+ %= $
243+ ali [[%| (scag (sub loa p.i.bob) p.i.ali) ~] t.ali]
244+ bob t.bob
245+ ==
246+ :* :* (welp bac.res wat)
247+ (welp alc.res q.i.ali)
248+ (welp boc.res wat)
249+ ==
250+ ali.res
251+ bob.res
252+ ==
253+ ::
254+ %|
255+ =+ loa=(lent p.i.ali)
256+ =+ lob=(lent p.i.bob)
257+ ?: =(loa lob)
258+ [[p.i.ali q.i.ali q.i.bob] t.ali t.bob]
259+ =+ ^= res
260+ ?: (gth loa lob)
261+ $(ali [[%| (scag (sub loa lob) p.i.ali) ~] t.ali], bob t.bob)
262+ ~& [%scagging loa=loa pibob=p.i.bob slag=(scag loa p.i.bob)]
263+ $(ali t.ali, bob [[%| (scag (sub lob loa) p.i.bob) ~] t.bob])
264+ :* :* (welp bac.res ?:((gth loa lob) p.i.bob p.i.ali))
265+ (welp alc.res q.i.ali)
266+ (welp boc.res q.i.bob)
267+ ==
268+ ali.res
269+ bob.res
270+ ==
271+ ==
272+ ==
273+ --
274+ --
275+--
example/urbit/sur/docket.hoonnew file+82
@@ -0,0 +1,82 @@
1+|%
2+::
3++$ version
4+ [major=@ud minor=@ud patch=@ud]
5+::
6++$ glob (map path mime)
7+::
8++$ url cord
9+:: $glob-location: How to retrieve a glob
10+::
11++$ glob-reference
12+ [hash=@uvH location=glob-location]
13+::
14++$ glob-location
15+ $% [%http =url]
16+ [%ames =ship]
17+ ==
18+:: $href: Where a tile links to
19+::
20++$ href
21+ $% [%glob base=term =glob-reference]
22+ [%site =path]
23+ ==
24+:: $chad: State of a docket
25+::
26++$ chad
27+ $~ [%install ~]
28+ $% :: Done
29+ [%glob =glob]
30+ [%site ~]
31+ :: Waiting
32+ [%install ~]
33+ [%suspend glob=(unit glob)]
34+ :: Error
35+ [%hung err=cord]
36+ ==
37+::
38+:: $charge: A realized $docket
39+::
40++$ charge
41+ $: =docket
42+ =chad
43+ ==
44+::
45+:: $clause: A key and value, as part of a docket
46+::
47+:: Only used to parse $docket
48+::
49++$ clause
50+ $% [%title title=@t]
51+ [%info info=@t]
52+ [%color color=@ux]
53+ [%glob-http url=cord hash=@uvH]
54+ [%glob-ames =ship hash=@uvH]
55+ [%image =url]
56+ [%site =path]
57+ [%base base=term]
58+ [%version =version]
59+ [%website website=url]
60+ [%license license=cord]
61+ ==
62+::
63+:: $docket: A description of JS bundles for a desk
64+::
65++$ docket
66+ $: %1
67+ title=@t
68+ info=@t
69+ color=@ux
70+ =href
71+ image=(unit url)
72+ =version
73+ website=url
74+ license=cord
75+ ==
76+::
77++$ charge-update
78+ $% [%initial initial=(map desk charge)]
79+ [%add-charge =desk =charge]
80+ [%del-charge =desk]
81+ ==
82+--
example/urbit/sur/journal.hoonnew file+19
@@ -0,0 +1,19 @@
1+|%
2++$ id @
3++$ txt @t
4++$ action
5+ $% [%add =id =txt]
6+ [%edit =id =txt]
7+ [%del =id]
8+ ==
9++$ entry [=id =txt]
10++$ logged (pair @ action)
11++$ update
12+ %+ pair @
13+ $% action
14+ [%jrnl list=(list entry)]
15+ [%logs list=(list logged)]
16+ ==
17++$ journal ((mop id txt) gth)
18++$ log ((mop @ action) lth)
19+--
example/urbit/sys.kelvinnew file+1
@@ -0,0 +1 @@
1+[%zuse 413]
res/airlock.jpegnew file

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 = BE.sequence [], offset = 0 }
17+ BitWriter { running = Nothing, collected = [], offset = 0 }
1818
1919
2020run : BitWriter -> Bytes
2121run (BitWriter { running, collected }) =
2222 case running of
2323 Nothing ->
24− BE.encode collected
24+ BE.encode (collected |> List.reverse |> BE.sequence)
2525
2626 Just { value } ->
27− BE.sequence [ collected, BE.unsignedInt8 value ] |> BE.encode
27+ BE.sequence (BE.unsignedInt8 value :: collected |> List.reverse) |> BE.encode
2828
2929
3030type BitWriter
@@ -35,7 +35,7 @@ type BitWriter
3535 , length : Int
3636 }
3737 , offset : Int
38− , collected : BE.Encoder
38+ , collected : List 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.sequence [ collected, BE.unsignedInt8 newValue ]
71+ , collected = BE.unsignedInt8 newValue :: collected
7272 , offset = newOffset
7373 }
7474
src/Ur.elm+94−207
@@ -1,42 +1,26 @@
1−module Ur exposing
2− ( Agent
3− , Atom
4− , Mark
5− , Noun(..)
6− , Path
7− , cue
8− , jam
9− , logIn
10− , mat
11− , rub
12− )
13−
14−import BitParser as BP exposing (BitParser)
15−import BitWriter as BW exposing (BitWriter)
16−import Bitwise
17−import Bytes exposing (Bytes)
18−import Bytes.Extra as Bytes
19−import Dict exposing (Dict)
20−import Http
21−import List.Extra as List
1+module Ur exposing (logIn, getShipName, scry, scryTask)
222
3+{-|
234
24−{-| An Urbit agent (app) name like `journal` or 'groups'.
25−-}
26−type alias Agent =
27− String
285
6+# Simple requests
7+
8+@docs logIn, getShipName, scry, scryTask
299
30−{-| An Urbit subscription path.
3110-}
32−type alias Path =
33− List String
11+
12+import Http
13+import Platform exposing (Task)
14+import Task
15+import Ur.Deconstructor as D
16+import Ur.Types exposing (..)
3417
3518
36−type alias Mark =
37− String
19+{-| Logs into your Urbit at the given root path and password.
3820
21+ logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
3922
23+-}
4024logIn : String -> String -> Cmd (Result Http.Error ())
4125logIn root password =
4226 Http.riskyRequest
@@ -53,180 +37,83 @@ logIn root password =
5337 }
5438
5539
56−type Noun
57− = Cell ( Noun, Noun )
58− | Atom Atom
59−
60−
61−type alias Atom =
62− Bytes
63−
64−
65−jam : Noun -> Bytes
66−jam n =
67− BW.run (jamWriter n BW.empty)
68−
69−
70−
71−-- Does not use references because it is complex to implement in Elm and would probably lead
72−-- to poor performance
73−
74−
75−jamWriter : Noun -> BitWriter -> BitWriter
76−jamWriter noun writer =
77− case noun of
78− Atom atom ->
79− writer
80− |> BW.bit 0
81− |> mat atom
82−
83− Cell ( a, b ) ->
84− writer
85− |> BW.bit 1
86− |> BW.bit 0
87− |> jamWriter a
88− |> jamWriter b
89−
90−
91−cue : Bytes -> Maybe Noun
92−cue =
93− BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second
94−
95−
96−cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )
97−cueParser refs =
98− BP.getOffset
99− |> BP.andThen
100− (\offset ->
101− BP.bit
102− |> BP.andThen
103− (\isAtom ->
104− if isAtom == 0 then
105− rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))
106−
107− else
108− BP.bit
109− |> BP.andThen
110− (\isRef ->
111− if isRef == 0 then
112− cueParser refs
113− |> BP.andThen
114− (\( refs_, a ) ->
115− cueParser refs_
116− |> BP.andThen
117− (\( refs__, b ) ->
118− let
119− c =
120− Cell ( a, b )
121− in
122− ( Dict.insert offset c refs__, c )
123− |> BP.succeed
124− )
125− )
126−
127− else
128− rub
129− |> BP.andThen
130− (\ref ->
131− case
132− Dict.get
133− (Bytes.toByteValues ref
134− |> List.foldr
135− (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
136− 0
137− )
138− refs
139− of
140− Just n ->
141− BP.succeed ( refs, n )
142−
143− _ ->
144− BP.fail
145− )
146− )
147− )
148− )
149−
150−
151−isSig : Bytes -> Bool
152−isSig bytes =
153− Bytes.toByteValues bytes |> List.all (\x -> x == 0)
154−
155−
156−mat : Bytes -> BitWriter -> BitWriter
157−mat bytes writer =
158− if isSig bytes then
159− writer |> BW.bit 1
160−
161− else
162− let
163− bits =
164− bytesToBits bytes |> List.dropWhileRight (\x -> x == 0)
165−
166− lengthBits =
167− bits |> List.length |> intToBits |> List.reverse |> List.drop 1 |> List.reverse
168− in
169− writer
170− |> BW.bit 0
171− |> BW.bits (List.repeat (List.length lengthBits) 0)
172− |> BW.bit 1
173− |> BW.bits lengthBits
174− |> BW.bits bits
175−
176−
177−rub : BitParser Bytes
178−rub =
179− BP.bit
180− |> BP.andThen
181− (\zeroBit ->
182− if zeroBit == 1 then
183− BP.succeed Bytes.empty
184−
185− else
186− let
187− countZeros n =
188− BP.bit
189− |> BP.andThen
190− (\b ->
191− if b == 0 then
192− countZeros (n + 1)
193−
194− else
195− BP.succeed n
196− )
197− in
198− countZeros 0
199− |> BP.andThen
200− (\lengthOfLength ->
201− BP.rawBits lengthOfLength
202− |> BP.andThen
203− (\preLengthRawBits ->
204− let
205− length =
206− BP.bitsToInt (preLengthRawBits ++ [ 1 ])
207− in
208− BP.bits length
209− )
210− )
211− )
212−
213−
214−bytesToBits : Bytes -> List Int
215−bytesToBits bytes =
216− case
217− BP.run (BP.rawBits (Bytes.width bytes * 8)) bytes
218− of
219− Nothing ->
220− []
221−
222− Just bits ->
223− bits
224−
225−
226−intToBits : Int -> List Int
227−intToBits n =
228− if n <= 0 then
229− []
230−
231− else
232− Bitwise.and 1 n :: intToBits (Bitwise.shiftRightBy 1 n)
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)
47+getShipName root =
48+ Http.riskyRequest
49+ { url = root ++ "/~/name"
50+ , method = "GET"
51+ , headers = []
52+ , timeout = Nothing
53+ , tracker = Nothing
54+ , body = Http.emptyBody
55+ , expect = Http.expectString identity
56+ }
57+
58+
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+ }
src/Ur/Cmd.elm+27−10
@@ -1,35 +1,52 @@
1−module Ur.Cmd exposing
2− ( Cmd
3− , batch
4− , cmd
5− , none
6− , poke
7− )
8−
9−import Ur exposing (Agent, Mark, Noun)
1+module Ur.Cmd exposing (Cmd, poke, cmd, none, batch)
2+
3+{-| This module is conceptually similar to `Platform.Cmd`, but also allows you to send Urbit requests.
4+
5+@docs Cmd, poke, cmd, none, batch
6+
7+-}
8+
109import Ur.Cmd.Internal
11−import Ur.Phonemic exposing (Ship)
10+import Ur.Types exposing (Agent, Mark, Noun, Ship)
1211
1312
13+{-| Like `Cmd` from `Platform.Cmd`, but for Urbit commands.
14+-}
1415type alias Cmd msg =
1516 List (Ur.Cmd.Internal.Cmd msg)
1617
1718
19+{-| A command that does exactly nothing.
20+-}
1821none : Cmd msg
1922none =
2023 []
2124
2225
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+-}
2336poke : { ship : Ship, agent : Agent, mark : Mark, noun : Noun } -> Cmd msg
2437poke p =
2538 [ Ur.Cmd.Internal.Poke p ]
2639
2740
41+{-| Turns a `Platform.Cmd` command into a `Ur.Cmd` command.
42+-}
2843cmd : Cmd.Cmd msg -> Cmd msg
2944cmd c =
3045 [ Ur.Cmd.Internal.Cmd c ]
3146
3247
48+{-| Batches multiple commands into one. Similar to `Platform.Cmd.batch`.
49+-}
3350batch : List (Cmd msg) -> Cmd msg
3451batch =
3552 List.concat
src/Ur/Cmd/Internal.elm+1−2
@@ -1,7 +1,6 @@
11module Ur.Cmd.Internal exposing (Cmd(..))
22
3−import Ur exposing (Agent, Mark, Noun)
4−import Ur.Phonemic exposing (Ship)
3+import Ur.Types exposing (Agent, Mark, Noun, Ship)
54
65
76type Cmd msg
src/Ur/Constructor.elm+65−16
@@ -1,35 +1,58 @@
11module Ur.Constructor exposing
2− ( Constructor
3− , bigint
4− , bytes
5− , cell
6− , cord
7− , float32
8− , float64
9− , int
2+ ( cell, sig, bytes
3+ , int, signedInt, bigint
4+ , float32, float64
5+ , cord, tape
106 , listOf
11− , sig
12− , signedInt
13− , tape
147 )
158
9+{-| Different ways of constructing `Noun` from Elm types.
10+
11+
12+# Primitive constructors
13+
14+@docs cell, sig, bytes
15+
16+
17+# Integers
18+
19+@docs int, signedInt, bigint
20+
21+
22+# Floats
23+
24+@docs float32, float64
25+
26+
27+# String
28+
29+@docs cord, tape
30+
31+
32+# Higher-order constructors
33+
34+@docs listOf
35+
36+-}
37+
1638import BigInt exposing (BigInt)
1739import BigInt.Bytes
1840import Bitwise
1941import Bytes exposing (Bytes, Endianness(..))
2042import Bytes.Encode as BE
21−import Ur exposing (..)
22−
23−
24−type alias Constructor a =
25− a -> Noun
43+import Ur.Types exposing (..)
2644
2745
46+{-| Constructs a [Cell](https://developers.urbit.org/reference/glossary/cell) from two Nouns.
47+-}
2848cell : Noun -> Noun -> Noun
2949cell a b =
3050 Cell ( a, b )
3151
3252
53+{-| Constructs an `Atom` from an unsigned 32-bit `Int`.
54+If you pass something other than an unsigned 32-bit integer the behaviour is undefined.
55+-}
3356int : Int -> Noun
3457int i =
3558 Atom
@@ -46,11 +69,15 @@ int i =
4669 )
4770
4871
72+{-| Constructs an `Atom` from a `BigInt`.
73+-}
4974bigint : BigInt -> Noun
5075bigint x =
5176 Atom (BigInt.Bytes.encode x)
5277
5378
79+{-| Constructs an `Atom` from a signed `Int`.
80+-}
5481signedInt : Int -> Noun
5582signedInt i =
5683 int
@@ -62,21 +89,34 @@ signedInt i =
6289 )
6390
6491
92+{-| Constructs an `Atom` from `Bytes`.
93+-}
6594bytes : Bytes -> Noun
6695bytes =
6796 Atom
6897
6998
99+{-| Constructs a [`cord`](https://developers.urbit.org/reference/glossary/cord), [`knot`](https://developers.urbit.org/guides/additional/strings#knot) or a [`term`](https://developers.urbit.org/guides/additional/strings#term) from a String.
100+-}
70101cord : String -> Noun
71102cord s =
72103 Atom (BE.encode (BE.string s))
73104
74105
106+{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`.
107+-}
75108tape : String -> Noun
76109tape s =
77110 String.toList s |> List.map String.fromChar |> listOf cord
78111
79112
113+{-| Constructs a `sig`-terminated list.
114+
115+The first argument is a constructor for the elements of the list.
116+
117+The second argument is the list of values to encode.
118+
119+-}
80120listOf : (a -> Noun) -> List a -> Noun
81121listOf encEl list =
82122 case list of
@@ -87,16 +127,25 @@ listOf encEl list =
87127 cell (encEl x) (listOf encEl xs)
88128
89129
130+{-| The [`sig`](https://developers.urbit.org/reference/glossary/tape) value. Also known as `~`.
131+
132+It is equivalent to `0`.
133+
134+-}
90135sig : Noun
91136sig =
92137 Atom (BE.encode (BE.sequence []))
93138
94139
140+{-| Constructs an `Atom` from a 32-bit float.
141+-}
95142float32 : Float -> Noun
96143float32 f =
97144 Atom (BE.encode (BE.float32 LE f))
98145
99146
147+{-| Constructs an `Atom` from a 64-bit float.
148+-}
100149float64 : Float -> Noun
101150float64 f =
102151 Atom (BE.encode (BE.float64 LE f))
src/Ur/Da.elm+11−1
@@ -1,9 +1,17 @@
11module Ur.Da exposing (Da, posixToDa)
22
3+{-|
4+
5+@docs Da, posixToDa
6+
7+-}
8+
39import BigInt exposing (BigInt)
410import Time exposing (Posix)
511
612
13+{-| Represents a `@da`.
14+-}
715type alias Da =
816 BigInt
917
@@ -18,6 +26,8 @@ second =
1826 BigInt.fromIntString "18446744073709551616" |> Maybe.withDefault (BigInt.fromInt 0)
1927
2028
29+{-| Converts `Posix` to a `@da`.
30+-}
2131posixToDa : Posix -> Da
2232posixToDa p =
23− BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000)) unixEpochStart
33+ BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000000)) unixEpochStart
src/Ur/Deconstructor.elm+293−198
@@ -1,27 +1,64 @@
11module Ur.Deconstructor exposing
22 ( Deconstructor
3− , alt
4− , bigint
5− , bytes
6− , cell
7− , const
8− , cord
9− , float32
10− , float64
11− , ignore
12− , int
13− , list
14− , llec
3+ , run, runBytes
4+ , cell, list, oneOf, const
155 , map
16− , oneOf
17− , run
18− , runBytes
19− , sig
20− , signedInt
21− , tape
22− , tar
6+ , int, signedInt, bigint
7+ , float32, float64
8+ , cord, tape
9+ , bytes, sig, ignore, tar, lazy, debug
2310 )
2411
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+
2562import BigInt exposing (BigInt)
2663import BigInt.Bytes
2764import Bitwise
@@ -29,107 +66,74 @@ import Bytes exposing (Bytes, Endianness(..))
2966import Bytes.Decode as BD
3067import Bytes.Encode as BE
3168import Bytes.Extra
32−import Ur exposing (..)
33−
69+import Ur.Jam exposing (cue, isSig)
70+import Ur.Types exposing (..)
3471
35−type Deconstructor a b
36− = Deconstructor (Noun -> a -> Maybe b)
3772
73+{-| A `Noun` deconstructor.
74+-}
75+type alias Deconstructor a =
76+ Noun -> Maybe a
3877
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
6278
63− Nothing ->
64− Nothing
65− )
79+{-| Executes a `Deconstructor` on a `Noun`.
80+-}
81+run : Deconstructor a -> Noun -> Maybe a
82+run f noun =
83+ f noun
6684
6785
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
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
7691
77− Cell _ ->
78− Nothing
79− )
8092
93+{-| Asserts that the value should be exactly equal to the second argument.
8194
82−tape : Deconstructor (String -> a) a
83−tape =
84− list cord |> fmap String.concat
95+The first argument is a `Deconstructor` for the given type.
8596
97+The second argument is the value to compare with.
8698
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
99+This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.
96100
97− 2 ->
98− BD.decode (BD.unsignedInt16 LE) bs
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 ()
99108
100− 3 ->
101− BD.decode (BD.unsignedInt32 LE) (BE.encode (BE.sequence [ BE.bytes bs, BE.unsignedInt8 0 ]))
109+ else
110+ Nothing
102111
103− 4 ->
104− BD.decode (BD.unsignedInt32 LE) bs
112+ Nothing ->
113+ Nothing
105114
106− _ ->
107− Nothing
108− )
109− |> Maybe.map f
110115
111− Cell _ ->
112− Nothing
113− )
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
114123
124+ Cell _ ->
125+ Nothing
115126
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
123127
124− Cell _ ->
125− Nothing
126− )
128+{-| Extracts a 32-bit signed `Int`.
127129
130+If the `Atom` is larger than 32 bits the the behaviour is undefined.
128131
129−signedInt : Deconstructor (Int -> a) a
132+-}
133+signedInt : Deconstructor Int
130134signedInt =
131135 int
132− |> fmap
136+ |> map
133137 (\i ->
134138 if Bitwise.and 1 i == 1 then
135139 -(Bitwise.shiftRightBy 1 (1 + i))
@@ -139,145 +143,236 @@ signedInt =
139143 )
140144
141145
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
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
150153
151− Cell _ ->
152− Nothing
153− )
154+ Cell _ ->
155+ Nothing
154156
155157
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
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
164165
165− Cell _ ->
166− Nothing
167− )
166+ Cell _ ->
167+ Nothing
168168
169169
170−bytes : Deconstructor (Bytes -> a) a
171−bytes =
172− Deconstructor
173− (\n f ->
174− case n of
175− Atom bs ->
176− f bs |> Just
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
177177
178− Cell _ ->
179− Nothing
180− )
178+ Cell _ ->
179+ Nothing
181180
182181
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
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 ()
191190
192− else
193− Nothing
191+ else
192+ Nothing
194193
195− Cell _ ->
196− Nothing
197− )
194+ Cell _ ->
195+ Nothing
198196
199197
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 []
198+{-| Extracts a sig-terminated list of arbitrary elements.
199+
200+The first argument is a `Deconstructor` of the elements of the list.
201+
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 []
210+
211+ Cell ( el, tail ) ->
212+ Maybe.map2 (\a b -> a :: b) (f el) (go tail)
213+ in
214+ go n
209215
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− )
215216
217+alt : Deconstructor a -> Deconstructor a -> Deconstructor a
218+alt f g n =
219+ case f n of
220+ Just x ->
221+ Just x
216222
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
223+ Nothing ->
224+ g n
224225
225− Nothing ->
226− g n a
227− )
228226
227+{-| Try to execute all of the `Deconstructor`s in order until one succeeds.
229228
230−oneOf : List (Deconstructor a b) -> Deconstructor a b
229+This is especially useful for deconstructing head-tagged unions from Hoon.
230+
231+-}
232+oneOf : List (Deconstructor a) -> Deconstructor a
231233oneOf l =
232234 case l of
233235 [] ->
234− Deconstructor (\_ _ -> Nothing)
236+ always Nothing
235237
236238 x :: xs ->
237239 alt x (oneOf xs)
238240
239241
240−tar : Deconstructor (Noun -> a) a
241−tar =
242− Deconstructor (\noun f -> Just (f noun))
242+{-| Ignore any value.
243243
244+This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.
244245
245−ignore : Deconstructor a a
246+-}
247+ignore : Deconstructor ()
246248ignore =
247− Deconstructor (\_ f -> Just f)
249+ always (Just ())
248250
249251
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)
252+{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.
257253
258− Atom _ ->
259− Nothing
260− )
254+Accepts two arbitrary `Deconstructor`s that form a Cell.
261255
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 )))
262262
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)
263+ Atom _ ->
264+ Nothing
270265
271− Atom _ ->
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
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+ _ ->
272326 Nothing
273− )
274327
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
275357
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)
279358
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+ "@"
280370
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))
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/Jam.elmnew file+193
@@ -0,0 +1,193 @@
1+module Ur.Jam exposing (..)
2+
3+{-|
4+
5+
6+# Encoding and decoding Nouns
7+
8+@docs jam, cue
9+
10+-}
11+
12+import BitParser as BP exposing (BitParser)
13+import BitWriter as BW exposing (BitWriter)
14+import Bitwise
15+import Bytes exposing (Bytes)
16+import Bytes.Extra as Bytes
17+import Dict exposing (Dict)
18+import List.Extra as List
19+import Ur.Types exposing (..)
20+
21+
22+{-| `jam` encodes arbitrary Nouns into an Atom.
23+-}
24+jam : Noun -> Bytes
25+jam n =
26+ BW.run (jamWriter n BW.empty)
27+
28+
29+
30+-- Does not use references because it is complex to implement in Elm and would probably lead
31+-- to poor performance
32+
33+
34+jamWriter : Noun -> BitWriter -> BitWriter
35+jamWriter noun writer =
36+ case noun of
37+ Atom atom ->
38+ writer
39+ |> BW.bit 0
40+ |> mat atom
41+
42+ Cell ( a, b ) ->
43+ writer
44+ |> BW.bit 1
45+ |> BW.bit 0
46+ |> jamWriter a
47+ |> jamWriter b
48+
49+
50+{-| Decodes a `jam`med Noun (Atom) into the original Noun.
51+-}
52+cue : Bytes -> Maybe Noun
53+cue =
54+ BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second
55+
56+
57+cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )
58+cueParser refs =
59+ BP.getOffset
60+ |> BP.andThen
61+ (\offset ->
62+ BP.bit
63+ |> BP.andThen
64+ (\isAtom ->
65+ if isAtom == 0 then
66+ rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))
67+
68+ else
69+ BP.bit
70+ |> BP.andThen
71+ (\isRef ->
72+ if isRef == 0 then
73+ cueParser refs
74+ |> BP.andThen
75+ (\( refs_, a ) ->
76+ cueParser refs_
77+ |> BP.andThen
78+ (\( refs__, b ) ->
79+ let
80+ c =
81+ Cell ( a, b )
82+ in
83+ ( Dict.insert offset c refs__, c )
84+ |> BP.succeed
85+ )
86+ )
87+
88+ else
89+ rub
90+ |> BP.andThen
91+ (\ref ->
92+ case
93+ Dict.get
94+ (Bytes.toByteValues ref
95+ |> List.foldr
96+ (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
97+ 0
98+ )
99+ refs
100+ of
101+ Just n ->
102+ BP.succeed ( refs, n )
103+
104+ _ ->
105+ BP.fail
106+ )
107+ )
108+ )
109+ )
110+
111+
112+isSig : Bytes -> Bool
113+isSig bytes =
114+ Bytes.toByteValues bytes |> List.all (\x -> x == 0)
115+
116+
117+mat : Bytes -> BitWriter -> BitWriter
118+mat bytes writer =
119+ if isSig bytes then
120+ writer |> BW.bit 1
121+
122+ else
123+ let
124+ bits =
125+ bytesToBits bytes |> List.dropWhileRight (\x -> x == 0)
126+
127+ lengthBits =
128+ bits |> List.length |> intToBits |> List.reverse |> List.drop 1 |> List.reverse
129+ in
130+ writer
131+ |> BW.bit 0
132+ |> BW.bits (List.repeat (List.length lengthBits) 0)
133+ |> BW.bit 1
134+ |> BW.bits lengthBits
135+ |> BW.bits bits
136+
137+
138+rub : BitParser Bytes
139+rub =
140+ BP.bit
141+ |> BP.andThen
142+ (\zeroBit ->
143+ if zeroBit == 1 then
144+ BP.succeed Bytes.empty
145+
146+ else
147+ let
148+ countZeros n =
149+ BP.bit
150+ |> BP.andThen
151+ (\b ->
152+ if b == 0 then
153+ countZeros (n + 1)
154+
155+ else
156+ BP.succeed n
157+ )
158+ in
159+ countZeros 0
160+ |> BP.andThen
161+ (\lengthOfLength ->
162+ BP.rawBits lengthOfLength
163+ |> BP.andThen
164+ (\preLengthRawBits ->
165+ let
166+ length =
167+ BP.bitsToInt (preLengthRawBits ++ [ 1 ])
168+ in
169+ BP.bits length
170+ )
171+ )
172+ )
173+
174+
175+bytesToBits : Bytes -> List Int
176+bytesToBits bytes =
177+ case
178+ BP.run (BP.rawBits (Bytes.width bytes * 8)) bytes
179+ of
180+ Nothing ->
181+ []
182+
183+ Just bits ->
184+ bits
185+
186+
187+intToBits : Int -> List Int
188+intToBits n =
189+ if n <= 0 then
190+ []
191+
192+ else
193+ Bitwise.and 1 n :: intToBits (Bitwise.shiftRightBy 1 n)
src/Ur/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+9−12
@@ -1,22 +1,19 @@
1−module Ur.Phonemic exposing (Ship, fromString)
1+module Ur.Phonemic exposing (fromString)
2+
3+{-|
4+
5+@docs fromString
6+
7+-}
28
39import BigInt.Bytes
410import Bytes.Extra
5−import Ur exposing (Atom, Noun(..))
11+import Ur.Types exposing (Atom, Noun(..), Ship)
612import Urbit.Encoding.Atom exposing (toBigInt)
713import Urbit.Encoding.Phonemic exposing (..)
814
915
10−{-| A ship name like `~zod` or `~racfer-hattes`.
11−
12−Also know as `@p`.
13−
14−-}
15−type alias Ship =
16− String
17−
18−
19−{-| Converts a string like '~zod' into an Atom.
16+{-| Converts a ship name like `~zod` into an `Atom`.
2017-}
2118fromString : Ship -> Atom
2219fromString s =
src/Ur/Requests.elm+7−53
@@ -1,8 +1,6 @@
11module Ur.Requests exposing
22 ( EventId
33 , UrbitRequest(..)
4− , scry
5− , scryTask
64 , send
75 , sendTask
86 , tag
@@ -13,8 +11,9 @@ import Http
1311import Task exposing (Task)
1412import Ur exposing (..)
1513import Ur.Constructor as C
16−import Ur.Deconstructor as D
17−import Ur.Phonemic exposing (Ship)
14+import Ur.Jam exposing (jam)
15+import Ur.Phonemic
16+import Ur.Types exposing (..)
1817import Ur.Uw
1918
2019
@@ -68,7 +67,7 @@ sendTask { url, error, success, requests } =
6867 requests
6968 |> List.map (uncurry toNoun)
7069 |> C.listOf identity
71− |> Ur.jam
70+ |> jam
7271 |> Ur.Uw.encode
7372 |> Http.stringBody "application/x-urb-jam"
7473 , resolver =
@@ -89,68 +88,23 @@ type alias EventId =
8988 Int
9089
9190
92−scry :
93− { url : String
94− , agent : Agent
95− , path : Path
96− , error : msg
97− , success : D.Deconstructor (msg -> msg) msg
98− }
99− -> Cmd msg
100−scry args =
101− scryTask args |> Task.perform identity
102−
103−
104−scryTask :
105− { url : String
106− , agent : Agent
107− , path : Path
108− , error : msg
109− , success : D.Deconstructor (msg -> msg) msg
110− }
111− -> Task a msg
112−scryTask { url, agent, path, error, success } =
113− Http.riskyTask
114− { method = "GET"
115− , headers = []
116− , url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"
117− , body = Http.emptyBody
118− , resolver =
119− Http.bytesResolver
120− (\resp ->
121− case resp of
122− Http.GoodStatus_ _ bytes ->
123− case D.runBytes success bytes of
124− Just msg ->
125− Ok msg
126−
127− Nothing ->
128− Ok error
129−
130− _ ->
131− Ok error
132− )
133− , timeout = Nothing
134− }
135−
136−
13791toNoun : EventId -> UrbitRequest -> Noun
13892toNoun eventId req =
13993 case req of
14094 Subscribe ( ship, app, path ) ->
14195 C.cell (C.cord "subscribe") <|
14296 C.cell (C.int eventId) <|
143− C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
97+ C.cell (Atom (Ur.Phonemic.fromString ship)) <|
14498 C.cell (C.cord app) (C.listOf C.cord path)
14599
146100 Unsubscribe subId ->
147− C.cell (C.cord "usubscribe") <|
101+ C.cell (C.cord "unsubscribe") <|
148102 C.cell (C.int eventId) (C.int subId)
149103
150104 Poke { ship, agent, mark, noun } ->
151105 C.cell (C.cord "poke") <|
152106 C.cell (C.int eventId) <|
153− C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|
107+ C.cell (Atom (Ur.Phonemic.fromString ship)) <|
154108 C.cell (C.cord agent) <|
155109 C.cell (C.cord mark) <|
156110 noun
src/Ur/Run.elm+216−81
@@ -1,22 +1,28 @@
1−module Ur.Run exposing (Model, Msg, application)
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+-}
28
39import Browser exposing (Document, UrlRequest)
410import Browser.Navigation as Nav
511import Dict exposing (Dict)
612import Either exposing (Either(..))
7−import Html
13+import Html exposing (Html)
814import Json.Decode as JD
915import Task
1016import Time
11−import Ur exposing (Agent, Path)
1217import Ur.Cmd
1318import Ur.Cmd.Internal
1419import Ur.Constructor as C
1520import Ur.Deconstructor as D
16−import Ur.Phonemic exposing (Ship)
21+import Ur.NounDiff exposing (Patch, deconstructPatch)
1722import Ur.Requests exposing (..)
1823import Ur.Sub
1924import Ur.Sub.Internal
25+import Ur.Types exposing (..)
2026import Ur.Uw
2127import Url exposing (Url)
2228
@@ -25,8 +31,9 @@ type alias SubDict msg =
2531 Dict
2632 -- (ship, agent, path)
2733 ( String, String, List String )
28− { deconstructor : D.Deconstructor (msg -> msg) msg
34+ { deconstructor : D.Deconstructor msg
2935 , number : Int
36+ , sink : Bool
3037 }
3138
3239
@@ -34,6 +41,8 @@ type alias Flags =
3441 { uid : String }
3542
3643
44+{-| An Urbit wrapper around your application model.
45+-}
3746type alias Model app msg =
3847 { subscriptions : SubDict msg
3948 , subscriptionIntMapping : Dict Int ( String, String, List String )
@@ -42,9 +51,12 @@ type alias Model app msg =
4251 , eventId : Int
4352 , flags : Flags
4453 , requestsToRetry : List UrbitRequest
54+ , sinks : Dict Int Noun
4555 }
4656
4757
58+{-| An Urbit wrapper around your application messages.
59+-}
4860type Msg msg
4961 = AppMsg msg
5062 | EventSourceMsg JD.Value
@@ -55,6 +67,61 @@ type Msg msg
5567 | RetryRequests
5668
5769
70+{-| A wrapper around your application `Program`.
71+-}
72+type alias Program model msg =
73+ Platform.Program Flags (Model model msg) (Msg msg)
74+
75+
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+-}
58125application :
59126 { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
60127 , view : model -> Document msg
@@ -67,66 +134,20 @@ application :
67134 , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
68135 , urbitUrl : model -> String
69136 }
70− -> Program Flags (Model model msg) (Msg msg)
137+ -> Program model msg
71138application inp =
72139 let
73− { init, view, onUrlRequest, onUrlChange, onEventSourceMsg } =
140+ { view, onUrlRequest, onUrlChange } =
74141 inp
75142 in
76143 Browser.application
77− { init =
78− \flags u key ->
79− let
80− ( app, appCmds ) =
81− init u key
82−
83− { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =
84− processUrSubs
85− 0
86− Dict.empty
87− (inp.urbitSubscriptions app |> (\(Ur.Sub.Internal.Sub x) -> x))
88−
89− ( eventId_, cmds, urReqs ) =
90− processCmd eventId appCmds
91−
92− url =
93− inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
94− in
95− ( { subscriptions = subscriptions
96− , subscriptionIntMapping = subscriptionIntMapping
97− , app = app
98− , connected = False
99− , eventId = eventId_
100− , flags = flags
101− , requestsToRetry = []
102− }
103− , [ cmds
104− , pureCmd NeedsActivation
105− , send
106− { requests = urReqs ++ subscriptionRequests
107− , url = url
108− , error = Noop
109− , success = Noop
110− }
111− ]
112− |> Cmd.batch
113− )
144+ { init = \flags url key -> init inp (inp.init url key) flags
114145 , view =
115146 \model ->
116147 view model.app
117148 |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })
118149 , update = update inp
119− , subscriptions =
120− \model ->
121− Sub.batch
122− [ inp.subscriptions model.app |> Sub.map AppMsg
123− , onEventSourceMsg EventSourceMsg
124− , if List.isEmpty model.requestsToRetry then
125− Sub.none
126−
127− else
128− Time.every 1000 (always RetryRequests)
129− ]
150+ , subscriptions = subscriptions inp
130151 , onUrlRequest = \req -> onUrlRequest req |> AppMsg
131152 , onUrlChange = \url -> onUrlChange url |> AppMsg
132153 }
@@ -153,20 +174,20 @@ update inp msg model =
153174 ( appModel, appCmds ) =
154175 inp.update msg_ model.app
155176
156− { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =
177+ subsResult =
157178 processUrSubs
158179 model.eventId
159180 model.subscriptions
160− (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))
181+ (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))
161182
162183 ( eventId_, cmds, urReqs ) =
163− processCmd eventId appCmds
184+ processCmd subsResult.eventId appCmds
164185 in
165186 ( { model
166187 | app = appModel
167188 , eventId = eventId_
168− , subscriptions = subscriptions
169− , subscriptionIntMapping = model.subscriptionIntMapping |> Dict.union subscriptionIntMapping
189+ , subscriptions = subsResult.subscriptions
190+ , subscriptionIntMapping = model.subscriptionIntMapping |> Dict.union subsResult.subscriptionIntMapping
170191 }
171192 , Cmd.batch
172193 [ cmds
@@ -177,9 +198,9 @@ update inp msg model =
177198 , requests = urReqs
178199 }
179200 , send
180− { requests = subscriptionRequests
201+ { requests = subsResult.subscriptionRequests
181202 , url = url
182− , error = subscriptionRequests |> List.map (\( _, x ) -> x) |> FailedRequest
203+ , error = subsResult.subscriptionRequests |> List.map (\( _, x ) -> x) |> FailedRequest
183204 , success = Noop
184205 }
185206 ]
@@ -190,12 +211,10 @@ update inp msg model =
190211 Ok string ->
191212 case
192213 D.runBytes
193− (D.cell D.int (D.cell D.cord D.tar)
194− |> D.map (\a b c -> ( a, b, c ))
195− )
214+ (D.cell D.int (D.cell D.cord D.tar))
196215 (Ur.Uw.decode string)
197216 of
198− Just ( messageId, messageType, rest ) ->
217+ Just ( messageId, ( messageType, rest ) ) ->
199218 let
200219 ( eventId, ackReqs ) =
201220 tag model.eventId [ Ack messageId ]
@@ -225,14 +244,51 @@ update inp msg model =
225244 Dict.get messageId model.subscriptionIntMapping
226245 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
227246 of
228− Just { deconstructor } ->
229− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
230− Just subMsg ->
231− ( model_, pureCmd (AppMsg subMsg) )
232−
233− -- Got gargbage
234− Nothing ->
235− ( model_, ackCmd )
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 )
236292
237293 -- Got a fact for a subscription we do not hold
238294 Nothing ->
@@ -257,11 +313,11 @@ update inp msg model =
257313 NeedsActivation ->
258314 let
259315 ( eventId, reqs ) =
260− [ 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!" } ]
261317 |> tag model.eventId
262318 in
263319 ( { model | eventId = eventId }
264− , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }
320+ , send { url = url, requests = reqs, success = OpenConnection, error = Noop }
265321 )
266322
267323 Noop ->
@@ -288,6 +344,19 @@ update inp msg model =
288344 )
289345
290346
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+
291360processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
292361processCmd eventId urCmds =
293362 let
@@ -317,10 +386,10 @@ pureCmd msg =
317386
318387processUrSubs :
319388 EventId
320− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
321− -> Dict ( Ship, Agent, Path ) d
389+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
390+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }
322391 ->
323− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
392+ { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
324393 , eventId : EventId
325394 , subscriptionRequests : List ( EventId, UrbitRequest )
326395 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
@@ -329,7 +398,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
329398 let
330399 urbitSubs =
331400 urbitSubs_
332− |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })
401+ |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })
333402
334403 ( eventId_, newSubscriptionActions ) =
335404 Dict.diff urbitSubs existingSubscriptions
@@ -352,10 +421,11 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
352421 newSubscriptions =
353422 Dict.merge
354423 (\_ _ x -> x)
355− (\key number { deconstructor } ->
424+ (\key number { deconstructor, sink } ->
356425 Dict.insert key
357426 { deconstructor = deconstructor
358427 , number = number
428+ , sink = sink
359429 }
360430 )
361431 (\_ _ x -> x)
@@ -373,3 +443,68 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
373443 , subscriptionRequests =
374444 removedSubscriptionActions ++ (newSubscriptionActions |> List.map (\( id, ( req, _ ) ) -> ( id, req )))
375445 }
446+
447+
448+init :
449+ { a | urbitSubscriptions : model -> Ur.Sub.Sub msg, urbitUrl : model -> String }
450+ -> ( model, Ur.Cmd.Cmd msg )
451+ -> Flags
452+ ->
453+ ( Model model msg
454+ , Cmd (Msg msg)
455+ )
456+init inp ( app, appCmds ) flags =
457+ let
458+ subsResult =
459+ processUrSubs
460+ 0
461+ Dict.empty
462+ (inp.urbitSubscriptions app |> (\(Ur.Sub.Internal.Sub x) -> x))
463+
464+ ( eventId_, cmds, urReqs ) =
465+ processCmd subsResult.eventId appCmds
466+
467+ url =
468+ inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
469+ in
470+ ( { subscriptions = subsResult.subscriptions
471+ , sinks = Dict.empty
472+ , subscriptionIntMapping = subsResult.subscriptionIntMapping
473+ , app = app
474+ , connected = False
475+ , eventId = eventId_
476+ , flags = flags
477+ , requestsToRetry = []
478+ }
479+ , [ cmds
480+ , pureCmd NeedsActivation
481+ , send
482+ { requests = urReqs ++ subsResult.subscriptionRequests
483+ , url = url
484+ , error = Noop
485+ , success = Noop
486+ }
487+ ]
488+ |> Cmd.batch
489+ )
490+
491+
492+subscriptions :
493+ { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
494+ -> { d | app : b, requestsToRetry : List e, connected : Bool }
495+ -> Sub (Msg msg)
496+subscriptions inp model =
497+ Sub.batch
498+ [ inp.subscriptions model.app |> Sub.map AppMsg
499+ , inp.onEventSourceMsg EventSourceMsg
500+ , if List.isEmpty model.requestsToRetry then
501+ Sub.none
502+
503+ else
504+ Time.every 1000 (always RetryRequests)
505+ , if not model.connected then
506+ Time.every 10000 (always NeedsActivation)
507+
508+ else
509+ Sub.none
510+ ]
src/Ur/Sub.elm+41−4
@@ -1,24 +1,61 @@
1−module Ur.Sub exposing (Sub, batch, none, subscribe)
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+-}
28
39import Dict
410import Ur.Deconstructor as D
511import Ur.Sub.Internal
612
713
14+{-| Like `Sub` from `Platform.Sub` but for Urbit subscriptions.
15+-}
816type alias Sub msg =
917 Ur.Sub.Internal.Sub msg
1018
1119
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
20+{-| Creates an Urbit subscription.
1521
22+ subscribe
23+ { ship = ship
24+ , app = "journal"
25+ , path = [ "updates" ]
26+ , deconstructor = decodeJournalUpdate |> D.map GotUpdate
27+ }
1628
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+-}
1752none : Sub msg
1853none =
1954 Ur.Sub.Internal.Sub Dict.empty
2055
2156
57+{-| Batch multiple subscriptions into one.
58+-}
2259batch : List (Sub msg) -> Sub msg
2360batch subs =
2461 subs |> List.map (\(Ur.Sub.Internal.Sub dict) -> dict) |> List.foldl Dict.union Dict.empty |> Ur.Sub.Internal.Sub
src/Ur/Sub/Internal.elm+4−3
@@ -1,9 +1,8 @@
11module Ur.Sub.Internal exposing (Sub(..))
22
33import Dict exposing (Dict)
4−import Ur exposing (Agent, Path)
54import Ur.Deconstructor as D
6−import Ur.Phonemic exposing (Ship)
5+import Ur.Types exposing (Agent, Path, Ship)
76
87
98type Sub msg
@@ -11,5 +10,7 @@ type Sub msg
1110 (Dict
1211 -- key is (ship, app, path)
1312 ( Ship, Agent, Path )
14− (D.Deconstructor (msg -> msg) msg)
13+ { deconstructor : D.Deconstructor msg
14+ , sink : Bool
15+ }
1516 )
src/Ur/Types.elmnew file+60
@@ -0,0 +1,60 @@
1+module Ur.Types exposing
2+ ( Noun(..), Atom
3+ , Agent, Mark, Path, Ship
4+ )
5+
6+{-|
7+
8+
9+# Nouns
10+
11+@docs Noun, Atom
12+
13+
14+# Types
15+
16+@docs Agent, Mark, Path, Ship
17+
18+-}
19+
20+import Bytes exposing (Bytes)
21+
22+
23+{-| An [Urbit agent](https://developers.urbit.org/reference/glossary/agent) (app) name like `journal` or `groups`.
24+-}
25+type alias Agent =
26+ String
27+
28+
29+{-| An [Urbit subscription path](https://developers.urbit.org/reference/glossary/path).
30+-}
31+type alias Path =
32+ List String
33+
34+
35+{-| An [Urbit mark](https://developers.urbit.org/reference/arvo/clay/marks/marks)
36+-}
37+type alias Mark =
38+ String
39+
40+
41+{-| A ship name like `~zod` or `~racfer-hattes`.
42+
43+Also know as `@p`.
44+
45+-}
46+type alias Ship =
47+ String
48+
49+
50+{-| An [Urbit Noun](https://developers.urbit.org/reference/glossary/noun).
51+-}
52+type Noun
53+ = Cell ( Noun, Noun )
54+ | Atom Atom
55+
56+
57+{-| An [Urbit Atom](https://developers.urbit.org/reference/glossary/atom)
58+-}
59+type alias Atom =
60+ Bytes
src/Ur/Uw.elm+15−7
@@ -1,5 +1,11 @@
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+
39import BitParser as BP
410import BitWriter as BW
511import Bitwise
@@ -9,6 +15,7 @@ import Dict
915import List.Extra
1016
1117
18+{-| -}
1219decode : String -> Bytes
1320decode string =
1421 if string == "0w0" then
@@ -22,26 +29,27 @@ decode string =
2229 -- 0w
2330 |> List.drop 2
2431
25− go : List Char -> BW.BitWriter -> BW.BitWriter
26− go cs writer =
32+ go : List Char -> List Int -> BW.BitWriter -> BW.BitWriter
33+ go cs append writer =
2734 case cs of
2835 [] ->
29− writer
36+ BW.bits append writer
3037
3138 '.' :: rest ->
32− go rest writer
39+ go rest append writer
3340
3441 c :: rest ->
3542 case Dict.get c charToBits of
3643 Just bits ->
37− go rest writer |> BW.bits bits
44+ go rest (bits ++ append) writer
3845
3946 Nothing ->
40− go rest writer
47+ go rest [] writer
4148 in
42− BW.run (go chars BW.empty)
49+ BW.run (go chars [] BW.empty)
4350
4451
52+{-| -}
4553encode : Bytes -> String
4654encode bytes =
4755 let
tests/Test/Urbit.elm+13−11
@@ -14,6 +14,8 @@ 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 (..)
1719import Ur.Uw
1820
1921
@@ -75,7 +77,7 @@ tests =
7577 Expect.equal
7678 (Just ( 1, 2 ))
7779 (D.runBytes
78− (D.cell D.int D.int |> D.map Tuple.pair)
80+ (D.cell D.int D.int)
7981 (Bytes.fromByteValues [ 0x31, 0x12 ])
8082 )
8183 )
@@ -94,7 +96,7 @@ tests =
9496 Expect.equal
9597 (Just ( 4, [ 1, 2, 3 ] ))
9698 (D.runBytes
97− (D.cell D.int (D.list D.int) |> D.map Tuple.pair)
99+ (D.cell D.int (D.list D.int))
98100 (Bytes.fromByteValues [ 0x61, 0xC6, 0x21, 0x43, 0x0B ])
99101 )
100102 )
@@ -103,7 +105,7 @@ tests =
103105 Expect.equal
104106 (Just ( 8, 11 ))
105107 (D.runBytes
106− (D.cell D.float32 D.float32 |> D.map Tuple.pair)
108+ (D.cell D.float32 D.float32)
107109 (Bytes.fromByteValues [ 0x01, 0x1F, 0x00, 0x00, 0x20, 0x08, 0x7C, 0x00, 0x00, 0x98, 0x20 ])
108110 )
109111 )
@@ -112,7 +114,7 @@ tests =
112114 Expect.equal
113115 (Just ( 8, "hi" ))
114116 (D.runBytes
115− (D.cell D.int D.cord |> D.map Tuple.pair)
117+ (D.cell D.int D.cord)
116118 (Bytes.fromByteValues [ 0x41, 0x10, 0x3C, 0x5A, 0x1A ])
117119 )
118120 )
@@ -121,7 +123,7 @@ tests =
121123 Expect.equal
122124 (Just ( 8, "hi" ))
123125 (D.runBytes
124− (D.cell D.int D.tape |> D.map Tuple.pair)
126+ (D.cell D.int D.tape)
125127 (Bytes.fromByteValues [ 0x41, 0x30, 0x38, 0x3A, 0x78, 0x5A ])
126128 )
127129 )
@@ -132,8 +134,8 @@ tests =
132134 (Just "hi")
133135 (D.runBytes
134136 (D.oneOf
135− [ D.cell (D.const D.cord "tape") D.tape
136− , D.cell (D.const D.cord "cord") D.cord
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)
137139 ]
138140 )
139141 (Bytes.fromByteValues [ 0x01, 0x9F, 0x2E, 0x0C, 0xAE, 0x1C, 0x1C, 0x1D, 0x3C, 0x2D ])
@@ -145,8 +147,8 @@ tests =
145147 (Just "hi")
146148 (D.runBytes
147149 (D.oneOf
148− [ D.cell (D.const D.cord "tape") D.tape
149− , D.cell (D.const D.cord "cord") D.cord
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)
150152 ]
151153 )
152154 (Bytes.fromByteValues [ 0x01, 0x7F, 0xEC, 0x4D, 0x8E, 0x0C, 0x1E, 0x2D, 0x0D ])
@@ -158,7 +160,7 @@ tests =
158160 Expect.equal
159161 (Just ( 8, -8 ))
160162 (D.runBytes
161− (D.cell D.signedInt D.signedInt |> D.map Tuple.pair)
163+ (D.cell D.signedInt D.signedInt)
162164 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])
163165 )
164166 )
@@ -188,7 +190,7 @@ tests =
188190 (\( f, i, ui ) ->
189191 Expect.equal (Just ( f, i, ui ))
190192 (D.run
191− (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 )))
192194 (C.cell (C.float64 f) (C.cell (C.signedInt i) (C.int ui)))
193195 )
194196 )