fe9c4e6...master · airlock

.gitignore+1

@@ -1,2 +1,3 @@

11elm-stuff

22elm.js

3+zod

LICENSEnew file+7

@@ -0,0 +1,7 @@

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+21−16

@@ -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)

@@ -12,7 +12,6 @@ import Ur

1212import Ur.Cmd

1313import Ur.Constructor as C

1414import Ur.Deconstructor as D

15−import Ur.Requests

1615import Ur.Run

1716import Ur.Sub

1817import Widget

@@ -20,6 +19,11 @@ import Widget.Icon as Icon

2019import Widget.Material as Material

2120

2221

22+url : String

23+url =

24+ "http://localhost:8080"

25+

26+

2327main : Ur.Run.Program Model Msg

2428main =

2529 Ur.Run.application

@@ -31,20 +35,20 @@ main =

3135 , shipName = Nothing

3236 }

3337 , Cmd.batch

34− [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"

38+ [ Ur.logIn url "lidlut-tabwed-pillex-ridrup"

3539 |> Cmd.map (result (Debug.toString >> Error) (always Noop))

36− , Ur.getShipName "http://localhost:8080" |> Cmd.map (result (always Noop) GotShipName)

37− , Ur.Requests.scry

38− { url = "http://localhost:8080"

40+ , Ur.getShipName url |> Cmd.map (result (always Noop) GotShipName)

41+ , Ur.scry

42+ { url = url

3943 , agent = "journal"

4044 , path = [ "entries", "all" ]

4145 , error = Noop

4246 , success =

4347 D.cell D.ignore

4448 (D.cell (D.const D.cord "jrnl")

45− (D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))

46− |> D.map GotListings

49+ (D.list (D.cell D.bigint D.cord))

4750 )

51+ |> D.map (\( (), ( (), listings ) ) -> GotListings listings)

4852 }

4953 ]

5054 |> Ur.Cmd.cmd

@@ -69,7 +73,7 @@ main =

6973 , onEventSourceMsg = onEventSourceMessage

7074 , onUrlChange = \_ -> Noop

7175 , onUrlRequest = \_ -> Noop

72− , urbitUrl = \_ -> "http://localhost:8080"

76+ , urbitUrl = \_ -> url

7377 }

7478

7579

@@ -173,14 +177,15 @@ type JournalUpdate

173177 | Delete BigInt

174178

175179

176−decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a

180+decodeJournalUpdate : D.Deconstructor JournalUpdate

177181decodeJournalUpdate =

178− D.cell D.ignore <|

179− D.oneOf

180− [ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add

181− , (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit

182− , D.cell (D.const D.cord "del") D.bigint |> D.map Delete

183− ]

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)

184189

185190

186191view : Model -> Document Msg

example/journal/app/journal.hoon → example/urbit/app/journal.hoonrenamed+26−19

@@ -1,5 +1,5 @@

11/- *journal

2−/+ default-agent, dbug, agentio

2+/+ default-agent, dbug, agentio, *sink

33|%

44+$ versioned-state

55 $% state-0

@@ -17,11 +17,15 @@

1717 ?. (has:log-orm log unix-ms)

1818 unix-ms

1919 $(time (add unix-ms 1))

20−--

20+--

21+

2122%- agent:dbug

22−=| state-0

23−=* state -

23+=/ state *state-0

24+=* entries (tap:j-orm journal.state)

25+=/ snik (sink ~[/sync])

26+=/ sink (snik entries)

2427^- agent:gall

28+::

2529|_ =bowl:gall

2630+* this .

2731 def ~(. (default-agent this %|) bowl)

@@ -34,7 +38,8 @@

3438++ on-load

3539 |= old-vase=vase

3640 ^- (quip card _this)

37− `this(state !<(versioned-state old-vase))

41+ =/ state !<(versioned-state old-vase)

42+ `this(state state, sink (snik entries))

3843::

3944++ on-poke

4045 |= [=mark =vase]

@@ -42,27 +47,28 @@

4247 |^

4348 ?> (team:title our.bowl src.bowl)

4449 ?. ?=(%journal-action mark) (on-poke:def mark vase)

45− =/ now=@ (unique-time now.bowl log)

50+ =/ now=@ (unique-time now.bowl log.state)

4651 =/ act !<(action vase)

4752 =. state (poke-action act)

48− :_ this(log (put:log-orm log now act))

49− ~[(fact:io journal-update+!>(`update`[now act]) ~[/updates])]

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]

5056 ::

5157 ++ poke-action

5258 |= act=action

5359 ^- _state

5460 ?- -.act

5561 %add

56− ?< (has:j-orm journal id.act)

57− state(journal (put:j-orm journal id.act txt.act))

62+ ?< (has:j-orm journal.state id.act)

63+ state(journal (put:j-orm journal.state id.act txt.act))

5864 ::

5965 %edit

60− ?> (has:j-orm journal id.act)

61− state(journal (put:j-orm journal id.act txt.act))

66+ ?> (has:j-orm journal.state id.act)

67+ state(journal (put:j-orm journal.state id.act txt.act))

6268 ::

6369 %del

64− ?> (has:j-orm journal id.act)

65− state(journal +:(del:j-orm journal id.act))

70+ ?> (has:j-orm journal.state id.act)

71+ state(journal +:(del:j-orm journal.state id.act))

6672 ==

6773 --

6874::

@@ -72,6 +78,7 @@

7278 ?> (team:title our.bowl src.bowl)

7379 ?+ path (on-watch:def path)

7480 [%updates ~] `this

81+ [%sync ~] [~[flush:sink] this]

7582 ==

7683::

7784++ on-peek

@@ -85,14 +92,14 @@

8592 [%all ~]

8693 :^ ~ ~ %journal-update

8794 !> ^- update

88− [now %jrnl (tap:j-orm journal)]

95+ [now %jrnl entries]

8996 ::

9097 [%before @ @ ~]

9198 =/ before=@ (rash i.t.t.t.path dem)

9299 =/ max=@ (rash i.t.t.t.t.path dem)

93100 :^ ~ ~ %journal-update

94101 !> ^- update

95− [now %jrnl (tab:j-orm journal `before max)]

102+ [now %jrnl (tab:j-orm journal.state `before max)]

96103 ::

97104 [%between @ @ ~]

98105 =/ start=@

@@ -101,7 +108,7 @@

101108 =/ end=@ (add 1 (rash i.t.t.t.t.path dem))

102109 :^ ~ ~ %journal-update

103110 !> ^- update

104− [now %jrnl (tap:j-orm (lot:j-orm journal `end `start))]

111+ [now %jrnl (tap:j-orm (lot:j-orm journal.state `end `start))]

105112 ==

106113 ::

107114 [%x %updates *]

@@ -109,13 +116,13 @@

109116 [%all ~]

110117 :^ ~ ~ %journal-update

111118 !> ^- update

112− [now %logs (tap:log-orm log)]

119+ [now %logs (tap:log-orm log.state)]

113120 ::

114121 [%since @ ~]

115122 =/ since=@ (rash i.t.t.t.path dem)

116123 :^ ~ ~ %journal-update

117124 !> ^- update

118− [now %logs (tap:log-orm (lot:log-orm log `since ~))]

125+ [now %logs (tap:log-orm (lot:log-orm log.state `since ~))]

119126 ==

120127 ==

121128::

example/journal/desk.bill → example/urbit/desk.billrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

example/urbit/lib/noun-diff.hoonnew file+227

@@ -0,0 +1,227 @@

1+=<

2+|%

3+ ++ diff

4+ |= [old=* new=*]

5+ ^- patch

6+ =/ del (extract-del (oracle old new) old)

7+ =/ ins (extract-ins (oracle old new) new)

8+ =/ allowed-holes (~(int in (find-del-holes del)) (find-ins-holes ins))

9+ =. del (filter-del-holes allowed-holes del)

10+ =/ ins (filter-ins-holes allowed-holes ins)

11+ =/ closed-patch (closure (gcp [del ins]))

12+ ?> =(& +.closed-patch)

13+ -.closed-patch

14+ ++ apply

15+ |= [patch=_id noun=*]

16+ ?- -.patch

17+ %diff

18+ =/ var-map (del del.patch noun)

19+ (ins ins.patch var-map)

20+ %cell

21+ ?> ?=(^ noun)

22+ [$(patch lhs.patch, noun -.noun) $(patch rhs.patch, noun +.noun)]

23+ ==

24+ ++ id

25+ ^- patch

26+ [%diff [%hole ~] [%hole ~]]

27+ +$ patch

28+ $%

29+ [%cell lhs=patch rhs=patch]

30+ [%diff ^diff]

31+ ==

32+--

33+::

34+|%

35+ +$ del-diff

36+ $%

37+ [%hole @]

38+ [%cell lhs=del-diff rhs=del-diff]

39+ [%ignore ~]

40+ ==

41+ +$ ins-diff

42+ $%

43+ [%hole @ original=*]

44+ [%cell lhs=ins-diff rhs=ins-diff]

45+ [%atom @]

46+ ==

47+ +$ final-ins-diff

48+ $%

49+ [%hole @]

50+ [%cell lhs=final-ins-diff rhs=final-ins-diff]

51+ [%atom @]

52+ ==

53+ +$ diff [del=del-diff ins=final-ins-diff]

54+ +$ patch

55+ $%

56+ [%cell lhs=patch rhs=patch]

57+ [%diff diff]

58+ ==

59+ ++ insify-noun

60+ |= noun=*

61+ ^- final-ins-diff

62+ ?- noun

63+ ^ [%cell $(noun -.noun) $(noun +.noun)]

64+ @ [%atom noun]

65+ ==

66+ ++ empty-set (silt `(list @)`~)

67+ ++ find-del-holes

68+ |= diff=del-diff

69+ ~+

70+ ^- (set @)

71+ ?- -.diff

72+ %hole (silt ~[+.diff])

73+ %cell

74+ (~(uni in $(diff lhs.diff)) $(diff rhs.diff))

75+ %ignore empty-set

76+ ==

77+ ++ find-final-ins-holes

78+ |= diff=final-ins-diff

79+ ~+

80+ ^- (set @)

81+ ?- -.diff

82+ %hole (silt ~[+.diff])

83+ %cell

84+ (~(uni in $(diff lhs.diff)) $(diff rhs.diff))

85+ %atom empty-set

86+ ==

87+ ++ find-ins-holes

88+ |= diff=ins-diff

89+ ~+

90+ ^- (set @)

91+ ?- -.diff

92+ %hole (silt ~[+<.diff])

93+ %cell

94+ (~(uni in $(diff lhs.diff)) $(diff rhs.diff))

95+ %atom empty-set

96+ ==

97+ ++ filter-del-holes

98+ |= [allowed-holes=(set @) diff=del-diff]

99+ ^- del-diff

100+ ?: ?=(%ignore -.diff) diff

101+ ?- -.diff

102+ %hole

103+ ?: (~(has in allowed-holes) +.diff) diff

104+ [%ignore ~]

105+ %cell [%cell $(diff +<.diff) $(diff +>.diff)]

106+ ==

107+ ++ filter-ins-holes

108+ |= [allowed-holes=(set @) diff=ins-diff]

109+ ^- final-ins-diff

110+ ?- -.diff

111+ %hole

112+ ?: (~(has in allowed-holes) +<.diff) [%hole +<.diff]

113+ (insify-noun original:diff)

114+ %cell [%cell $(diff +<.diff) $(diff +>.diff)]

115+ %atom diff

116+ ==

117+ ++ gcp

118+ |= diff=diff

119+ ^- patch

120+ ?- -.ins.diff

121+ %atom

122+ [%diff diff]

123+ %cell

124+ ?: ?=(%cell -.del.diff)

125+ [%cell $(diff [+<.del.diff +<.ins.diff]) $(diff [+>.del.diff +>.ins.diff])]

126+ [%diff diff]

127+ %hole

128+ [%diff diff]

129+ ==

130+ ++ closure

131+ |= =patch

132+ ^- [^patch ?]

133+ ?- -.patch

134+ %diff

135+ =/ del-holes (find-del-holes del:patch)

136+ =/ ins-holes (find-final-ins-holes ins:patch)

137+ =/ difference (~(dif in ins-holes) del-holes)

138+ [patch =(difference empty-set)]

139+ %cell

140+ =/ lhs $(patch lhs:patch)

141+ =/ rhs $(patch rhs:patch)

142+ ?: ?&(+.lhs +.rhs) [[%cell -.lhs -.rhs] &]

143+ $(patch (pull-diff [%cell -.lhs -.rhs]))

144+ ==

145+ ++ pull-diff

146+ |= =patch

147+ ^- [%diff del=del-diff ins=final-ins-diff]

148+ ?- -.patch

149+ %diff patch

150+ %cell

151+ =/ pulled-lhs $(patch lhs:patch)

152+ =/ pulled-rhs $(patch rhs:patch)

153+ :+

154+ %diff

155+ [%cell del:pulled-lhs del:pulled-rhs]

156+ [%cell ins:pulled-lhs ins:pulled-rhs]

157+ ==

158+ ++ is-subtree

159+ |= [tree=* subtree=*]

160+ ~+

161+ ^- ?

162+ ?: =(tree subtree) &

163+ ?@ tree |

164+ ?|

165+ (is-subtree -.tree subtree)

166+ (is-subtree +.tree subtree)

167+ ==

168+ ++ oracle

169+ |= [a=* b=*]

170+ |= subtree=*

171+ ^- (unit @)

172+ ?:

173+ ?&

174+ (is-subtree a subtree)

175+ (is-subtree b subtree)

176+ ==

177+ `(mug subtree)

178+ ~

179+ ++ extract-del

180+ |= [oracle=$-(* (unit @)) subtree=*]

181+ ~+

182+ ^- del-diff

183+ =/ hash (oracle subtree)

184+ ?^ hash [%hole +.hash]

185+ ?@ subtree [%ignore ~]

186+ [%cell (extract-del oracle -.subtree) (extract-del oracle +.subtree)]

187+ ++ extract-ins

188+ |= [oracle=$-(* (unit @)) subtree=*]

189+ ~+

190+ ^- ins-diff

191+ =/ hash (oracle subtree)

192+ ?^ hash [%hole +.hash subtree]

193+ ?@ subtree [%atom subtree]

194+ [%cell (extract-ins oracle -.subtree) (extract-ins oracle +.subtree)]

195+ ++ ins

196+ |= [diff=final-ins-diff var-map=(map @ *)]

197+ ^- *

198+ ?- -.diff

199+ %atom

200+ +.diff

201+ %cell

202+ [$(diff +<.diff) $(diff +>.diff)]

203+ %hole

204+ (~(got by var-map) +.diff)

205+ ==

206+ ++ del

207+ |= [diff=del-diff noun=*]

208+ ^- (map @ *)

209+ |^ (go diff noun ((map @ *) ~))

210+ ++ go

211+ |= [diff=del-diff noun=* var-map=(map @ *)]

212+ ^- (map @ *)

213+ ?- -.diff

214+ %ignore var-map

215+ %hole

216+ =/ subtree (~(get by var-map) +.diff)

217+ ?~ subtree (~(put by var-map) +.diff noun)

218+ ?> =(+.subtree noun)

219+ var-map

220+ %cell

221+ ?> ?=(^ noun)

222+ =/ lhs-var-map $(diff +<.diff, noun -.noun)

223+ =/ rhs-var-map $(diff +>.diff, noun +.noun, var-map lhs-var-map)

224+ rhs-var-map

225+ ==

226+ --

227+--

example/urbit/lib/sink.hoonnew file+26

@@ -0,0 +1,26 @@

1+/+ noun-diff

2+|%

3+++ clog

4+ |$ [stut]

5+ $%

6+ [%flush stut]

7+ [%drain patch:noun-diff]

8+ ==

9+++ sink

10+ |* pats=(list path)

11+ |* stat=*

12+ |@

13+ ++ sync

14+ |= [stat=_stat]

15+ ^- [card:agent:gall _..sync]

16+ =/ dif

17+ %+ diff:noun-diff ^stat stat

18+ :-

19+ [%give %fact pats %noun !>(^-((clog) [%drain dif]))]

20+ ..sync(stat stat)

21+ ++ paths pats

22+ ++ flush

23+ ^- card:agent:gall

24+ [%give %fact pats %noun !>(^-((clog) [%flush stat]))]

25+ --

26+--

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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+82−209

@@ -1,43 +1,26 @@

1−module Ur exposing

2− ( Agent

3− , Atom

4− , Mark

5− , Noun(..)

6− , Path

7− , cue

8− , getShipName

9− , jam

10− , logIn

11− , mat

12− , rub

13− )

14−

15−import BitParser as BP exposing (BitParser)

16−import BitWriter as BW exposing (BitWriter)

17−import Bitwise

18−import Bytes exposing (Bytes)

19−import Bytes.Extra as Bytes

20−import Dict exposing (Dict)

21−import Http

22−import List.Extra as List

1+module Ur exposing (logIn, getShipName, scry, scryTask)

232

3+{-|

244

25−{-| An Urbit agent (app) name like `journal` or 'groups'.

26−-}

27−type alias Agent =

28− String

295

6+# Simple requests

7+

8+@docs logIn, getShipName, scry, scryTask

309

31−{-| An Urbit subscription path.

3210-}

33−type alias Path =

34− List String

11+

12+import Http

13+import Platform exposing (Task)

14+import Task

15+import Ur.Deconstructor as D

16+import Ur.Types exposing (..)

3517

3618

37−type alias Mark =

38− String

19+{-| Logs into your Urbit at the given root path and password.

3920

21+ logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"

4022

23+-}

4124logIn : String -> String -> Cmd (Result Http.Error ())

4225logIn root password =

4326 Http.riskyRequest

@@ -54,7 +37,13 @@ logIn root password =

5437 }

5538

5639

57−getShipName : String -> Cmd (Result Http.Error String)

40+{-| Queries the name of the current ship.

41+Return strings like `~zod` or `~racfer-hattes`.

42+

43+ getShipName "http://localhost:8080"

44+

45+-}

46+getShipName : String -> Cmd (Result Http.Error Ship)

5847getShipName root =

5948 Http.riskyRequest

6049 { url = root ++ "/~/name"

@@ -67,180 +56,64 @@ getShipName root =

6756 }

6857

6958

70−type Noun

71− = Cell ( Noun, Noun )

72− | Atom Atom

73−

74−

75−type alias Atom =

76− Bytes

77−

78−

79−jam : Noun -> Bytes

80−jam n =

81− BW.run (jamWriter n BW.empty)

82−

83−

84−

85−-- Does not use references because it is complex to implement in Elm and would probably lead

86−-- to poor performance

87−

88−

89−jamWriter : Noun -> BitWriter -> BitWriter

90−jamWriter noun writer =

91− case noun of

92− Atom atom ->

93− writer

94− |> BW.bit 0

95− |> mat atom

96−

97− Cell ( a, b ) ->

98− writer

99− |> BW.bit 1

100− |> BW.bit 0

101− |> jamWriter a

102− |> jamWriter b

103−

104−

105−cue : Bytes -> Maybe Noun

106−cue =

107− BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second

108−

109−

110−cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )

111−cueParser refs =

112− BP.getOffset

113− |> BP.andThen

114− (\offset ->

115− BP.bit

116− |> BP.andThen

117− (\isAtom ->

118− if isAtom == 0 then

119− rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))

120−

121− else

122− BP.bit

123− |> BP.andThen

124− (\isRef ->

125− if isRef == 0 then

126− cueParser refs

127− |> BP.andThen

128− (\( refs_, a ) ->

129− cueParser refs_

130− |> BP.andThen

131− (\( refs__, b ) ->

132− let

133− c =

134− Cell ( a, b )

135− in

136− ( Dict.insert offset c refs__, c )

137− |> BP.succeed

138− )

139− )

140−

141− else

142− rub

143− |> BP.andThen

144− (\ref ->

145− case

146− Dict.get

147− (Bytes.toByteValues ref

148− |> List.foldr

149− (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)

150− 0

151− )

152− refs

153− of

154− Just n ->

155− BP.succeed ( refs, n )

156−

157− _ ->

158− BP.fail

159− )

160− )

161− )

162− )

163−

164−

165−isSig : Bytes -> Bool

166−isSig bytes =

167− Bytes.toByteValues bytes |> List.all (\x -> x == 0)

168−

169−

170−mat : Bytes -> BitWriter -> BitWriter

171−mat bytes writer =

172− if isSig bytes then

173− writer |> BW.bit 1

174−

175− else

176− let

177− bits =

178− bytesToBits bytes |> List.dropWhileRight (\x -> x == 0)

179−

180− lengthBits =

182− in

183− writer

184− |> BW.bit 0

185− |> BW.bits (List.repeat (List.length lengthBits) 0)

186− |> BW.bit 1

187− |> BW.bits lengthBits

188− |> BW.bits bits

189−

190−

191−rub : BitParser Bytes

192−rub =

193− BP.bit

194− |> BP.andThen

195− (\zeroBit ->

196− if zeroBit == 1 then

197− BP.succeed Bytes.empty

198−

199− else

200− let

201− countZeros n =

202− BP.bit

203− |> BP.andThen

204− (\b ->

205− if b == 0 then

206− countZeros (n + 1)

207−

208− else

209− BP.succeed n

210− )

211− in

212− countZeros 0

213− |> BP.andThen

214− (\lengthOfLength ->

215− BP.rawBits lengthOfLength

216− |> BP.andThen

217− (\preLengthRawBits ->

218− let

219− length =

220− BP.bitsToInt (preLengthRawBits ++ [ 1 ])

221− in

222− BP.bits length

223− )

224− )

225− )

226−

227−

228−bytesToBits : Bytes -> List Int

229−bytesToBits bytes =

230− case

231− BP.run (BP.rawBits (Bytes.width bytes * 8)) bytes

232− of

233− Nothing ->

234− []

235−

236− Just bits ->

237− bits

238−

239−

240−intToBits : Int -> List Int

241−intToBits n =

242− if n <= 0 then

243− []

244−

245− else

246− Bitwise.and 1 n :: intToBits (Bitwise.shiftRightBy 1 n)

59+{-| 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+10

@@ -1,9 +1,17 @@

11module Ur.Da exposing (Da, posixToDa)

22

3+{-|

4+

5+@docs Da, posixToDa

6+

7+-}

8+

39import BigInt exposing (BigInt)

410import Time exposing (Posix)

511

612

13+{-| Represents a `@da`.

14+-}

715type alias Da =

816 BigInt

917

@@ -18,6 +26,8 @@ second =

1826 BigInt.fromIntString "18446744073709551616" |> Maybe.withDefault (BigInt.fromInt 0)

1927

2028

29+{-| Converts `Posix` to a `@da`.

30+-}

2131posixToDa : Posix -> Da

2232posixToDa p =

2333 BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000000)) unixEpochStart

src/Ur/Deconstructor.elm+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 =

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+144−27

@@ -1,22 +1,28 @@

1−module Ur.Run exposing (Model, Msg, Program, 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,10 +67,61 @@ type Msg msg

5567 | RetryRequests

5668

5769

70+{-| A wrapper around your application `Program`.

71+-}

5872type alias Program model msg =

5973 Platform.Program Flags (Model model msg) (Msg msg)

6074

6175

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+-}

62125application :

63126 { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )

64127 , view : model -> Document msg

@@ -111,12 +174,11 @@ update inp msg model =

111174 ( appModel, appCmds ) =

112175 inp.update msg_ model.app

113176

114− -- { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =

115177 subsResult =

116178 processUrSubs

117179 model.eventId

118180 model.subscriptions

119− (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))

181+ (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))

120182

121183 ( eventId_, cmds, urReqs ) =

122184 processCmd subsResult.eventId appCmds

@@ -149,12 +211,10 @@ update inp msg model =

149211 Ok string ->

150212 case

151213 D.runBytes

152− (D.cell D.int (D.cell D.cord D.tar)

153− |> D.map (\a b c -> ( a, b, c ))

154− )

214+ (D.cell D.int (D.cell D.cord D.tar))

155215 (Ur.Uw.decode string)

156216 of

157− Just ( messageId, messageType, rest ) ->

217+ Just ( messageId, ( messageType, rest ) ) ->

158218 let

159219 ( eventId, ackReqs ) =

160220 tag model.eventId [ Ack messageId ]

@@ -184,14 +244,51 @@ update inp msg model =

184244 Dict.get messageId model.subscriptionIntMapping

185245 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)

186246 of

187− Just { deconstructor } ->

188− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of

189− Just subMsg ->

190− ( model_, pureCmd (AppMsg subMsg) )

191−

192− -- Got gargbage

193− Nothing ->

194− ( model_, ackCmd )

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 )

195292

196293 -- Got a fact for a subscription we do not hold

197294 Nothing ->

@@ -216,11 +313,11 @@ update inp msg model =

216313 NeedsActivation ->

217314 let

218315 ( eventId, reqs ) =

219− [ 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!" } ]

220317 |> tag model.eventId

221318 in

222319 ( { model | eventId = eventId }

223− , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }

320+ , send { url = url, requests = reqs, success = OpenConnection, error = Noop }

224321 )

225322

226323 Noop ->

@@ -247,6 +344,19 @@ update inp msg model =

247344 )

248345

249346

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+

250360processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )

251361processCmd eventId urCmds =

252362 let

@@ -276,10 +386,10 @@ pureCmd msg =

276386

277387processUrSubs :

278388 EventId

279− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }

280− -> 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 }

281391 ->

282− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }

392+ { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }

283393 , eventId : EventId

284394 , subscriptionRequests : List ( EventId, UrbitRequest )

285395 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )

@@ -288,7 +398,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =

288398 let

289399 urbitSubs =

290400 urbitSubs_

291− |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })

401+ |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })

292402

293403 ( eventId_, newSubscriptionActions ) =

294404 Dict.diff urbitSubs existingSubscriptions

@@ -311,10 +421,11 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =

311421 newSubscriptions =

312422 Dict.merge

313423 (\_ _ x -> x)

314− (\key number { deconstructor } ->

424+ (\key number { deconstructor, sink } ->

315425 Dict.insert key

316426 { deconstructor = deconstructor

317427 , number = number

428+ , sink = sink

318429 }

319430 )

320431 (\_ _ x -> x)

@@ -357,6 +468,7 @@ init inp ( app, appCmds ) flags =

357468 inp.urbitUrl app ++ "/~/channel/" ++ flags.uid

358469 in

359470 ( { subscriptions = subsResult.subscriptions

471+ , sinks = Dict.empty

360472 , subscriptionIntMapping = subsResult.subscriptionIntMapping

361473 , app = app

362474 , connected = False

@@ -379,7 +491,7 @@ init inp ( app, appCmds ) flags =

379491

380492subscriptions :

381493 { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }

382− -> { d | app : b, requestsToRetry : List e }

494+ -> { d | app : b, requestsToRetry : List e, connected : Bool }

383495 -> Sub (Msg msg)

384496subscriptions inp model =

385497 Sub.batch

@@ -390,4 +502,9 @@ subscriptions inp model =

390502

391503 else

392504 Time.every 1000 (always RetryRequests)

505+ , if not model.connected then

506+ Time.every 10000 (always NeedsActivation)

507+

508+ else

509+ Sub.none

393510 ]

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 )