8168841 · airlock · git.iko.soy

git.iko.soy/airlock

%sink (#6)

* %sink * Cleaned up code

commit8168841cfae2deae136d453e9cfb4793a5d72b3e authoriko <mail@iko.soy> dateWed 5 Jul 2023, 12:28 (3 years ago) parent59d334c

38 files changed+789−51

compare with master

unifiedsplit

.gitignore+1

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

11elm-stuff

22elm.js

3+zod

dev/elm-live.sh → dev/sink-elm-live.shrenamed+1−1

@@ -4,4 +4,4 @@ set -e

55cd "$(dirname "$0")/../example"

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

3+set -e

5+cd "$(dirname "$0")/../example"

7+nix run nixpkgs#elmPackages.elm-live -- src/Vanilla.elm --start-page=index.html -- --output=elm.js --debug "$@"

example/script.js+16−1

@@ -2,7 +2,22 @@ import { fetchEventSource } from "/fetch-event-source.js"

33const uid = `${Math.floor(Date.now() / 1000)}-${Math.random()}`;

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

@@ -0,0 +1,204 @@

1+port module Sink exposing (main)

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 Ur.Types exposing (Noun)

18+import Widget

19+import Widget.Icon as Icon

20+import Widget.Material as Material

21+

22+

23+url : String

24+url =

25+ "http://localhost:8080"

26+

27+

28+main : Ur.Run.Program Model Msg

29+main =

30+ Ur.Run.application

31+ { init =

32+ \_ _ ->

33+ ( { error = ""

34+ , entries = Nothing

35+ , newEntry = ""

36+ , shipName = Nothing

37+ }

38+ , Cmd.batch

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

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

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

42+ ]

43+ |> Ur.Cmd.cmd

44+ )

45+ , update = update

46+ , view = view

47+ , subscriptions = always Sub.none

48+ , createEventSource = createEventSource

49+ , urbitSubscriptions =

50+ \{ shipName } ->

51+ case shipName of

52+ Just ship ->

53+ Ur.Sub.batch

54+ [ Ur.Sub.sink

55+ { ship = ship

56+ , app = "journal"

57+ , path = [ "sync" ]

58+ , deconstructor =

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

60+ |> D.map GotListings

61+ }

62+ ]

63+

64+ _ ->

65+ Ur.Sub.none

66+ , onEventSourceMsg = onEventSourceMessage

67+ , onUrlChange = \_ -> Noop

68+ , onUrlRequest = \_ -> Noop

69+ , urbitUrl = \_ -> url

70+ }

71+

72+

73+type alias Model =

74+ { error : String

75+ , entries : Maybe (List ( BigInt, String ))

76+ , newEntry : String

77+ , shipName : Maybe String

78+ }

79+

80+

81+type Msg

82+ = Noop

83+ | GotSink Noun

84+ | Error String

85+ | GotListings (List ( BigInt, String ))

86+ | UpdateNewEntry String

87+ | DeleteEntry BigInt

88+ | AddEntry String

89+ | RunCmd (Ur.Cmd.Cmd Msg)

90+ | GotShipName String

91+

92+

93+update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )

94+update msg model =

95+ case msg of

96+ Noop ->

97+ ( model, Ur.Cmd.none )

98+

99+ GotSink _ ->

100+ ( model, Ur.Cmd.none )

101+

102+ Error err ->

103+ ( { model | error = err }, Ur.Cmd.none )

104+

105+ GotListings entries ->

106+ ( { model | entries = Just entries }, Ur.Cmd.none )

107+

108+ UpdateNewEntry txt ->

109+ ( { model | newEntry = txt }, Ur.Cmd.none )

110+

111+ DeleteEntry id ->

112+ ( model

113+ , Ur.Cmd.poke

114+ { ship = "~zod"

115+ , agent = "journal"

116+ , mark = "journal-action"

117+ , noun = C.cell (C.cord "del") (C.bigint id)

118+ }

119+ )

120+

121+ AddEntry txt ->

122+ ( { model | newEntry = "" }

123+ , Time.now

124+ |> Task.perform

125+ (\time ->

126+ Ur.Cmd.poke

127+ { ship = "~zod"

128+ , agent = "journal"

129+ , mark = "journal-action"

130+ , noun = C.cell (C.cord "add") (C.cell (time |> Time.posixToMillis |> BigInt.fromInt |> C.bigint) (C.cord txt))

131+ }

132+ |> RunCmd

133+ )

134+ |> Ur.Cmd.cmd

135+ )

136+

137+ RunCmd cmd ->

138+ ( model, cmd )

139+

140+ GotShipName name ->

141+ ( { model | shipName = Just name }, Ur.Cmd.none )

142+

143+

144+view : Model -> Document Msg

145+view model =

146+ { body =

147+ [ layout []

148+ ([ el [ alignTop ] (text model.error)

149+ , row [ spacing 8 ]

150+ [ Widget.textInput (Material.textInput Material.defaultPalette)

151+ { chips = []

152+ , text = model.newEntry

153+ , placeholder = Nothing

154+ , label = "New entry"

155+ , onChange = UpdateNewEntry

156+ }

157+ , Widget.iconButton (Material.containedButton Material.defaultPalette)

158+ { text = "submit"

159+ , icon = Icon.elmHeroicons Heroicons.Outline.check

160+ , onPress = AddEntry model.newEntry |> Just

161+ }

162+ ]

163+ , model.entries

164+ |> Maybe.withDefault []

165+ |> List.map

166+ (\( id, txt ) ->

167+ row

168+ [ Border.rounded 10

169+ , Border.shadow { offset = ( 0, 5 ), size = 1, blur = 10, color = rgba 0 0 0 0.3 }

170+ , centerX

171+ , padding 10

172+ , spacing 12

173+ ]

174+ [ paragraph [] [ text txt ]

175+ , Widget.iconButton (Material.containedButton Material.defaultPalette)

176+ { text = "delete"

177+ , icon = Icon.elmHeroicons Heroicons.Outline.trash

178+ , onPress = DeleteEntry id |> Just

179+ }

180+ ]

181+ )

182+ |> column [ spacing 10, centerX ]

183+ ]

184+ |> column [ spacing 18, centerX ]

185+ )

186+ ]

187+ , title = "Airlock"

188+ }

189+

190+

191+result : (a -> c) -> (b -> c) -> Result a b -> c

192+result f g res =

193+ case res of

194+ Ok b ->

195+ g b

196+

197+ Err a ->

198+ f a

199+

200+

201+port createEventSource : String -> Cmd msg

202+

203+

204+port onEventSourceMessage : (JD.Value -> msg) -> Sub msg

example/src/Main.elm → example/src/Vanilla.elmrenamed+11−7

@@ -1,4 +1,4 @@

1−port module Main exposing (main)

1+port module Vanilla exposing (main)

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,11 +35,11 @@ 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

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

example/journal/app/journal.hoon → example/urbit/app/journal.hoonrenamed+27−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,16 @@

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+=/ snik

25+ %+ sink ~[/sync]

26+ |=(stat=versioned-state (tap:j-orm journal.stat))

27+=/ sink (snik state)

2428^- agent:gall

29+

2530|_ =bowl:gall

2631+* this .

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

@@ -34,7 +39,8 @@

3439++ on-load

3540 |= old-vase=vase

3641 ^- (quip card _this)

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

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

43+ `this(state state, sink (snik state))

3844::

3945++ on-poke

4046 |= [=mark =vase]

@@ -42,27 +48,28 @@

4248 |^

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

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

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

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

4652 =/ act !<(action vase)

4753 =. state (poke-action act)

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

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

54+ =^ card sink (sync:sink state)

55+ :_ this(log.state (put:log-orm log.state now act))

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

5057 ::

5158 ++ poke-action

5259 |= act=action

5360 ^- _state

5461 ?- -.act

5562 %add

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

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

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

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

5865 ::

5966 %edit

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

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

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

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

6269 ::

6370 %del

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

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

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

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

6673 ==

6774 --

6875::

@@ -72,6 +79,7 @@

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

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

7481 [%updates ~] `this

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

7583 ==

7684::

7785++ on-peek

@@ -85,14 +93,14 @@

8593 [%all ~]

8694 :^ ~ ~ %journal-update

8795 !> ^- update

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

96+ [now %jrnl (tap:j-orm journal.state)]

8997 ::

9098 [%before @ @ ~]

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

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

93101 :^ ~ ~ %journal-update

94102 !> ^- update

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

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

96104 ::

97105 [%between @ @ ~]

98106 =/ start=@

@@ -101,7 +109,7 @@

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

102110 :^ ~ ~ %journal-update

103111 !> ^- update

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

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

105113 ==

106114 ::

107115 [%x %updates *]

@@ -109,13 +117,13 @@

109117 [%all ~]

110118 :^ ~ ~ %journal-update

111119 !> ^- update

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

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

113121 ::

114122 [%since @ ~]

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

116124 :^ ~ ~ %journal-update

117125 !> ^- update

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

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

119127 ==

120128 ==

121129::

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

@@ -0,0 +1,27 @@

1+/+ noun-diff

2+|%

3+ ++ clog

4+ |$ [stut]

5+ $%

6+ [%flush stut]

7+ [%drain patch:noun-diff]

8+ ==

9+ ++ sink

10+ |* [pats=(list path) extract=$-(* *)]

11+ |* stat=*

12+ |@

13+ ++ sync

14+ |= [stat=_stat]

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

16+ =/ dif

17+ %+ diff:noun-diff (extract ^stat) (extract stat)

18+ :-

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

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

21+ ..sync(stat stat)

22+ ++ paths pats

23+ ++ flush

24+ ^- card:agent:gall

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

26+ --

27+--

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

src/Ur/Deconstructor.elm+15−4

@@ -6,16 +6,16 @@ module Ur.Deconstructor exposing

66 , int, signedInt, bigint

77 , float32, float64

88 , cord, tape

9− , bytes, sig, ignore, tar

9+ , bytes, sig, ignore, tar, lazy

1010 )

1111

1212{-| This module provides an API to deconstruct `Noun`s into arbitrary Elm data structures.

1313

1414The principal (and types) are very similar to `Url.Parser` from `elm/url`.

1515

16−You would parse a `[%edit cord @]` like this:

16+You would parse a `[%edit @ cord]` like this:

1717

18− type alias Edit = {text : String, id: Int}

18+ type alias Edit = {id: Int, text : String}

1919

2020 (D.cell (D.const D.cord "edit") (D.cell D.int D.cord)) |> D.map Edit

2121

@@ -63,7 +63,7 @@ that "capture" a value: `D.int` and `D.cord`.

6363

6464# Miscellaneous

6565

66−@docs bytes, sig, ignore, tar

66+@docs bytes, sig, ignore, tar, lazy

6767

6868-}

6969

@@ -370,6 +370,17 @@ cell (Deconstructor l) (Deconstructor r) =

370370 )

371371

372372

373+{-| -}

374+lazy : (() -> Deconstructor a b) -> Deconstructor a b

375+lazy f =

376+ Deconstructor

377+ (\noun a ->

378+ case f () of

379+ Deconstructor g ->

380+ g noun a

381+ )

382+

383+

373384{-| Maps (applies) a function to all of the values deconstructed.

374385

375386This is useful when you want to create a data type with extracted values as fields.

src/Ur/NounDiff.elmnew file+155

@@ -0,0 +1,155 @@

1+module Ur.NounDiff exposing (Patch, apply, deconstructPatch)

3+import Bytes.Extra

4+import Dict exposing (Dict)

5+import Ur.Deconstructor as D

6+import Ur.Types exposing (..)

9+type Patch

10+ = PatchCell Patch Patch

11+ | Diff DelDiff InsDiff

12+

13+

14+deconstructPatch : D.Deconstructor (Patch -> c) c

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 PatchCell

23+ , D.cell (D.const D.cord "diff") (D.cell deconstructDel deconstructIns) |> D.map Diff

24+ ]

25+

26+

27+deconstructPatch_ : D.Deconstructor (Patch -> c) c

28+deconstructPatch_ =

29+ D.oneOf

30+ [ D.cell (D.const D.cord "cell")

31+ (D.cell

32+ deconstructPatch

33+ deconstructPatch

34+ )

35+ |> D.map PatchCell

36+ , D.cell (D.const D.cord "diff") (D.cell deconstructDel deconstructIns) |> D.map Diff

37+ ]

38+

39+

40+apply : Patch -> Noun -> Noun

41+apply patch noun =

42+ case ( patch, noun ) of

43+ ( PatchCell lhs rhs, Cell ( lhs_, rhs_ ) ) ->

44+ Cell ( apply lhs lhs_, apply rhs rhs_ )

45+

46+ ( Diff delDiff insDiff, _ ) ->

47+ ins insDiff (del delDiff noun)

48+

49+ _ ->

50+ noun

51+

52+

53+del : DelDiff -> Noun -> Dict Int Noun

54+del diff noun =

55+ let

56+ go : DelDiff -> Noun -> Dict Int Noun -> Dict Int Noun

57+ go diff_ noun_ dict =

58+ case ( diff_, noun_ ) of

59+ ( Ignore, _ ) ->

60+ dict

61+

62+ ( DelCell lhsDiff rhsDiff, Cell ( lhs, rhs ) ) ->

63+ go lhsDiff lhs (go rhsDiff rhs dict)

64+

65+ ( DelHole hole, _ ) ->

66+ -- There should be a continuity check here.

67+ -- Check that the noun_ is equal to whatever the hole maps to in dict.

68+ -- I don't include it for speed and laziness reasons.

69+ Dict.insert hole noun_ dict

70+

71+ _ ->

72+ dict

73+ in

74+ go diff noun Dict.empty

75+

76+

77+ins : InsDiff -> Dict Int Noun -> Noun

78+ins diff dict =

79+ case diff of

80+ InsAtom a ->

81+ Atom a

82+

83+ InsHole hole ->

84+ Dict.get hole dict |> Maybe.withDefault (Atom Bytes.Extra.empty)

85+

86+ InsCell lhs rhs ->

87+ Cell ( ins lhs dict, ins rhs dict )

88+

89+

90+type DelDiff

91+ = Ignore

92+ | DelHole Int

93+ | DelCell DelDiff DelDiff

94+

95+

96+deconstructDel : D.Deconstructor (DelDiff -> c) c

97+deconstructDel =

98+ D.oneOf

99+ [ D.cell (D.const D.cord "ignore") D.ignore |> D.map Ignore

100+ , D.cell (D.const D.cord "hole") D.int |> D.map DelHole

101+ , D.cell (D.const D.cord "cell")

102+ (D.cell

103+ deconstructDel_

104+ deconstructDel_

105+ )

106+ |> D.map DelCell

107+ ]

108+

109+

110+deconstructDel_ : D.Deconstructor (DelDiff -> c) c

111+deconstructDel_ =

112+ D.oneOf

113+ [ D.const D.cord "ignore" |> D.map Ignore

114+ , D.cell (D.const D.cord "hole") D.int |> D.map DelHole

115+ , D.cell (D.const D.cord "cell")

116+ (D.cell

117+ (D.lazy (\() -> deconstructDel))

118+ (D.lazy (\() -> deconstructDel))

119+ )

120+ |> D.map DelCell

121+ ]

122+

123+

124+type InsDiff

125+ = InsAtom Atom

126+ | InsHole Int

127+ | InsCell InsDiff InsDiff

128+

129+

130+deconstructIns : D.Deconstructor (InsDiff -> c) c

131+deconstructIns =

132+ D.oneOf

133+ [ D.cell (D.const D.cord "hole") D.int |> D.map InsHole

134+ , D.cell (D.const D.cord "atom") D.bytes |> D.map InsAtom

135+ , D.cell (D.const D.cord "cell")

136+ (D.cell

137+ deconstructIns_

138+ deconstructIns_

139+ )

140+ |> D.map InsCell

141+ ]

142+

143+

144+deconstructIns_ : D.Deconstructor (InsDiff -> c) c

145+deconstructIns_ =

146+ D.oneOf

147+ [ D.cell (D.const D.cord "hole") D.int |> D.map InsHole

148+ , D.cell (D.const D.cord "atom") D.bytes |> D.map InsAtom

149+ , D.cell (D.const D.cord "cell")

150+ (D.cell

151+ (D.lazy (\() -> deconstructIns))

152+ (D.lazy (\() -> deconstructIns))

153+ )

154+ |> D.map InsCell

155+ ]

src/Ur/Run.elm+75−16

@@ -18,6 +18,7 @@ import Ur.Cmd

1818import Ur.Cmd.Internal

1919import Ur.Constructor as C

2020import Ur.Deconstructor as D

21+import Ur.NounDiff exposing (Patch, deconstructPatch)

2122import Ur.Requests exposing (..)

2223import Ur.Sub

2324import Ur.Sub.Internal

@@ -32,6 +33,7 @@ type alias SubDict msg =

3233 ( String, String, List String )

3334 { deconstructor : D.Deconstructor (msg -> msg) msg

3435 , number : Int

36+ , sink : Bool

3537 }

3638

3739

@@ -49,6 +51,7 @@ type alias Model app msg =

4951 , eventId : Int

5052 , flags : Flags

5153 , requestsToRetry : List UrbitRequest

54+ , sinks : Dict Int Noun

5255 }

5356

5457

@@ -171,7 +174,6 @@ update inp msg model =

171174 ( appModel, appCmds ) =

172175 inp.update msg_ model.app

173176

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

175177 subsResult =

176178 processUrSubs

177179 model.eventId

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

244246 Dict.get messageId model.subscriptionIntMapping

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

246248 of

247− Just { deconstructor } ->

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

249− Just subMsg ->

250− ( model_, pureCmd (AppMsg subMsg) )

251−

252− -- Got gargbage

253− Nothing ->

254− ( model_, ackCmd )

249+ Just { deconstructor, sink } ->

250+ if sink then

251+ case D.run (D.cell D.ignore (D.cell D.ignore deconstructSink)) rest of

252+ Just (Flush noun) ->

253+ ( { model | sinks = Dict.insert messageId noun model.sinks }

254+ , case D.run deconstructor noun of

255+ Just subMsg ->

256+ pureCmd (AppMsg subMsg)

257+

258+ -- Got garbage

259+ Nothing ->

260+ Cmd.none

261+ )

262+

263+ Just (Drain patch) ->

264+ case Dict.get messageId model.sinks of

265+ Just oldNoun ->

266+ let

267+ newNoun =

268+ Ur.NounDiff.apply patch oldNoun

269+ in

270+ ( { model | sinks = Dict.insert messageId newNoun model.sinks }

271+ , case D.run deconstructor newNoun of

272+ Just subMsg ->

273+ pureCmd (AppMsg subMsg)

274+

275+ Nothing ->

276+ Cmd.none

277+ )

278+

279+ Nothing ->

280+ ( model, Cmd.none )

281+

282+ -- Got garbage

283+ Nothing ->

284+ ( model, Cmd.none )

285+

286+ else

287+ case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of

288+ Just subMsg ->

289+ ( model_, pureCmd (AppMsg subMsg) )

290+

291+ -- Got gargbage

292+ Nothing ->

293+ ( model_, ackCmd )

255294

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

257296 Nothing ->

@@ -280,7 +319,7 @@ update inp msg model =

280319 |> tag model.eventId

281320 in

282321 ( { model | eventId = eventId }

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

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

284323 )

285324

286325 Noop ->

@@ -307,6 +346,19 @@ update inp msg model =

307346 )

308347

309348

349+type Sink

350+ = Flush Noun

351+ | Drain Patch

352+

353+

354+deconstructSink : D.Deconstructor (Sink -> c) c

355+deconstructSink =

356+ D.oneOf

357+ [ D.cell (D.const D.cord "flush") D.tar |> D.map Flush

358+ , D.cell (D.const D.cord "drain") deconstructPatch |> D.map Drain

359+ ]

360+

361+

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

311363processCmd eventId urCmds =

312364 let

@@ -336,10 +388,10 @@ pureCmd msg =

336388

337389processUrSubs :

338390 EventId

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

340− -> Dict ( Ship, Agent, Path ) d

391+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }

392+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }

341393 ->

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

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

343395 , eventId : EventId

344396 , subscriptionRequests : List ( EventId, UrbitRequest )

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

@@ -348,7 +400,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =

348400 let

349401 urbitSubs =

350402 urbitSubs_

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

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

352404

353405 ( eventId_, newSubscriptionActions ) =

354406 Dict.diff urbitSubs existingSubscriptions

@@ -371,10 +423,11 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =

371423 newSubscriptions =

372424 Dict.merge

373425 (\_ _ x -> x)

374− (\key number { deconstructor } ->

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

375427 Dict.insert key

376428 { deconstructor = deconstructor

377429 , number = number

430+ , sink = sink

378431 }

379432 )

380433 (\_ _ x -> x)

@@ -417,6 +470,7 @@ init inp ( app, appCmds ) flags =

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

418471 in

419472 ( { subscriptions = subsResult.subscriptions

473+ , sinks = Dict.empty

420474 , subscriptionIntMapping = subsResult.subscriptionIntMapping

421475 , app = app

422476 , connected = False

@@ -439,7 +493,7 @@ init inp ( app, appCmds ) flags =

439493

440494subscriptions :

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

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

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

443497 -> Sub (Msg msg)

444498subscriptions inp model =

445499 Sub.batch

@@ -450,4 +504,9 @@ subscriptions inp model =

450504

451505 else

452506 Time.every 1000 (always RetryRequests)

507+ , if not model.connected then

508+ Time.every 10000 (always NeedsActivation)

509+

510+ else

511+ Sub.none

453512 ]

src/Ur/Sub.elm+20−2

@@ -1,4 +1,7 @@

1−module Ur.Sub exposing (Sub, subscribe, none, batch)

1+module Ur.Sub exposing

2+ ( Sub, subscribe, none, batch

3+ , sink

4+ )

36{-| This module is conceptually similar to `Platform.Sub`, but also you to subscribe to Urbit channels.

@@ -29,7 +32,22 @@ type alias Sub msg =

2932-}

3033subscribe : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg

3134subscribe { ship, app, path, deconstructor } =

32− Dict.singleton ( ship, app, path ) deconstructor |> Ur.Sub.Internal.Sub

35+ Dict.singleton ( ship, app, path )

36+ { deconstructor = deconstructor

37+ , sink = False

38+ }

39+ |> Ur.Sub.Internal.Sub

40+

41+

42+{-| Create a Sink subscription.

43+-}

44+sink : { ship : String, app : String, path : List String, deconstructor : D.Deconstructor (msg -> msg) msg } -> Sub msg

45+sink { ship, app, path, deconstructor } =

46+ Dict.singleton ( ship, app, path )

47+ { deconstructor = deconstructor

48+ , sink = True

49+ }

50+ |> Ur.Sub.Internal.Sub

3351

3452

3553{-| A subscription that does exactly nothing. (Does not subscribe to anything)

src/Ur/Sub/Internal.elm+3−1

@@ -10,5 +10,7 @@ type Sub msg

1010 (Dict

1111 -- key is (ship, app, path)

1212 ( Ship, Agent, Path )

13− (D.Deconstructor (msg -> msg) msg)

13+ { deconstructor : D.Deconstructor (msg -> msg) msg

14+ , sink : Bool

15+ }

1416 )