f224d6c · airlock · git.iko.soy

git.iko.soy/airlock

Noun channels (#4)

* Got basic subscriptions working * Refactored urbit requests * Added elm.json back in * Added int64 * Switched to bigint * Added pokes * Retry critical failed requests * Cleaned up * Expose proper modules * Refactored subscriptions * Minor refactors

commitf224d6c636e12b676c86203f646202b5f7a3414c authoriko <mail@iko.soy> dateFri 16 Jun 2023, 20:57 (3 years ago) parent89f0999

22 files changed+1382−17

compare with master

unifiedsplit

.gitignore+1

@@ -1 +1,2 @@

11elm-stuff

2+elm.js

dev/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/Main.elm --start-page=index.html -- --output=elm.js --debug "$@"

elm.json+15−3

@@ -5,14 +5,26 @@

55 "license": "MIT",

66 "version": "1.0.0",

77 "exposed-modules": [

8− "Urbit"

8+ "Ur", "Ur.Cmd", "Ur.Sub", "Ur.Constructor", "Ur.Deconstructor", "Ur.Phonemic", "Ur.Da", "Ur.Uw", "Ur.Run"

99 ],

1010 "elm-version": "0.19.0 <= v < 0.20.0",

1111 "dependencies": {

1212 "TSFoster/elm-bytes-extra": "1.3.0 <= v < 1.4.0",

13+ "chelovek0v/bbase64": "1.0.1 <= v < 2.0.0",

14+ "cmditch/elm-bigint": "2.0.1 <= v < 3.0.0",

15+ "elm/browser": "1.0.2 <= v < 2.0.0",

1316 "elm/bytes": "1.0.8 <= v < 2.0.0",

14− "elm/core": "1.0.0 <= v < 1.0.5",

15− "elm-community/list-extra": "8.7.0 <= v < 9.0.0"

17+ "elm/core": "1.0.0 <= v < 2.0.0",

18+ "elm/html": "1.0.0 <= v < 2.0.0",

19+ "elm/http": "2.0.0 <= v < 3.0.0",

20+ "elm/json": "1.1.3 <= v < 2.0.0",

21+ "elm/time": "1.0.0 <= v < 2.0.0",

22+ "elm/url": "1.0.0 <= v < 2.0.0",

23+ "elm-community/list-extra": "8.7.0 <= v < 9.0.0",

24+ "elm-community/maybe-extra": "5.3.0 <= v < 6.0.0",

25+ "figbus/elm-urbit-api": "4.0.1 <= v < 5.0.0",

26+ "jxxcarlson/hex": "4.0.0 <= v < 5.0.0",

27+ "toastal/either": "3.6.3 <= v < 4.0.0"

1628 },

1729 "test-dependencies": {

1830 "elm-explorations/test": "2.1.1 <= v < 3.0.0"

example/elm.jsonnew file+53

@@ -0,0 +1,53 @@

1+{

2+ "type": "application",

3+ "source-directories": [

4+ "src",

5+ "../src"

6+ ],

7+ "elm-version": "0.19.1",

8+ "dependencies": {

9+ "direct": {

10+ "Orasund/elm-ui-widgets": "3.4.0",

11+ "TSFoster/elm-bytes-extra": "1.3.0",

12+ "chelovek0v/bbase64": "1.0.1",

13+ "cmditch/elm-bigint": "2.0.1",

14+ "elm/browser": "1.0.2",

15+ "elm/bytes": "1.0.8",

16+ "elm/core": "1.0.5",

17+ "elm/html": "1.0.0",

18+ "elm/http": "2.0.0",

19+ "elm/json": "1.1.3",

20+ "elm/parser": "1.1.0",

21+ "elm/time": "1.0.0",

22+ "elm/url": "1.0.0",

23+ "elm-community/list-extra": "8.7.0",

24+ "elm-community/maybe-extra": "5.3.0",

25+ "figbus/elm-urbit-api": "4.0.1",

26+ "jasonliang-dev/elm-heroicons": "2.0.0",

27+ "jxxcarlson/hex": "4.0.0",

28+ "ktonon/elm-word": "2.1.2",

29+ "mdgriffith/elm-ui": "1.1.8",

30+ "robinheghan/murmur3": "1.0.0",

31+ "toastal/either": "3.6.3"

32+ },

33+ "indirect": {

34+ "AdrianRibao/elm-derberos-date": "1.2.3",

35+ "avh4/elm-color": "1.0.0",

36+ "bitsoflogic/elm-radixint": "2.0.0",

37+ "elm/file": "1.0.5",

38+ "elm/random": "1.0.0",

39+ "elm/regex": "1.0.0",

40+ "elm/svg": "1.0.1",

41+ "elm/virtual-dom": "1.0.3",

42+ "elm-community/intdict": "3.0.0",

43+ "fredcy/elm-parseint": "2.0.1",

44+ "noahzgordon/elm-color-extra": "1.0.2",

45+ "rtfeldman/elm-hex": "1.0.0",

46+ "turboMaCk/queue": "1.1.0"

47+ }

48+ },

49+ "test-dependencies": {

50+ "direct": {},

51+ "indirect": {}

52+ }

53+}

example/fetch-event-source.jsnew file+2

@@ -0,0 +1,2 @@

1+var m=class extends Error{};async function A(r,e,t){let n=r.getReader(),o={done:!1,value:new Uint8Array};for(;o&&!o.done;)o=await Promise.race([n.read(),new Promise((g,i)=>{setTimeout(()=>i(new Error("getBytes timed out")),t)})]),e(o.value)}function R(r){let e,t,n,o=!1;return function(i){e===void 0?(e=i,t=0,n=-1):e=L(e,i);let s=e.length,a=0;for(;t<s;){o&&(e[t]===10&&(a=++t),o=!1);let c=-1;for(;t<s&&c===-1;++t)switch(e[t]){case 58:n===-1&&(n=t-a);break;case 13:o=!0;case 10:c=t;break}if(c===-1)break;r(e.subarray(a,c),n),a=t,n=-1}a===s?e=void 0:a!==0&&(e=e.subarray(a),t-=a)}}function P(r,e,t){let n=k(),o=new TextDecoder;return function(i,s){if(i.length===0)r?.(n),n=k();else if(s>0){let a=o.decode(i.subarray(0,s)),c=s+(i[s+1]===32?2:1),p=o.decode(i.subarray(c));switch(a){case"data":n.data=n.data?n.data+`

2+`+p:p;break;case"event":n.event=p;break;case"id":e?.(n.id=p);break;case"retry":let l=parseInt(p,10);isNaN(l)||t?.(n.retry=l);break}}}}function L(r,e){let t=new Uint8Array(r.length+e.length);return t.set(r),t.set(e,r.length),t}function k(){return{data:"",event:"",id:"",retry:void 0}}var b="text/event-stream",N=1e3,T="last-event-id";function q(r,{signal:e,headers:t,onopen:n,onmessage:o,onclose:g,onerror:i,openWhenHidden:s,fetch:a,responseTimeout:c,...p}){return new Promise((l,M)=>{let y={...t};y.accept||(y.accept=b);let f;function w(){f.abort(),document.hidden||E()}typeof document<"u"&&!s&&document.addEventListener("visibilitychange",w);let S=N,h;function x(){typeof document<"u"&&!s&&document.removeEventListener("visibilitychange",w),clearTimeout(h),f.abort()}e?.addEventListener("abort",()=>{x(),l()});let I=a??fetch,U=n??O,v=!1;async function E(){f=new AbortController;try{let u=await Promise.race([I(r,{...p,headers:y,signal:f.signal}),new Promise((d,C)=>{setTimeout(()=>C(new Error("fetch timed out")),c)})]);if(u.status===404)throw new m("Channel reaped");if(u.status<200||u.status>=300)throw new Error(`Invalid server response: ${u.status}`);await U(u,v),v&&(v=!1),await A(u.body,R(P(o,d=>{d?y[T]=d:delete y[T]},d=>{S=d})),c),g?.(),x(),l()}catch(u){if(!f.signal.aborted)try{v=!0;let d=i?.(u)??S;clearTimeout(h),f.abort(),h=setTimeout(E,d)}catch(d){x(),M(d)}}}E()})}function O(r){let e=r.headers.get("content-type");if(!e?.startsWith(b))throw new Error(`Expected content-type to be ${b}, Actual: ${e}`)}export{b as EventStreamContentType,q as fetchEventSource};

example/index.htmlnew file+13

@@ -0,0 +1,13 @@

1+<!DOCTYPE html>

2+<html lang="en">

3+ <head>

4+ <meta charset="UTF-8" />

5+ <meta name="viewport" content="width=device-width, initial-scale=1.0" />

6+ </head>

7+ <body>

8+ <div id="elm"></div>

9+ <script src="/elm.js"></script>

10+ <script type="module" src="/script.js"></script>

11+ </body>

12+</html>

13+

example/script.jsnew file+27

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

1+import { fetchEventSource } from "/fetch-event-source.js"

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

5+let app = Elm.Main.init({ node: document.getElementById("elm"), flags: { uid } });

7+app.ports.createEventSource.subscribe((url) => {

8+ fetchEventSource(url, {

9+ headers: {

10+ Accept: 'application/x-urb-jam',

11+ "x-channel-format": 'application/x-urb-jam',

12+ "content-type": 'application/x-urb-jam'

13+ },

14+ credentials: 'include',

15+ responseTimeout: 25000,

16+ openWhenHidden: true,

17+ onmessage(ev) {

18+ console.log(ev)

19+ app.ports.onEventSourceMessage.send({ message: ev.data });

20+ },

21+ onerror(err) {

22+ console.log(err)

23+ app.ports.onEventSourceMessage.send({ error: err });

24+ }

25+ });

26+

27+});

example/src/Main.elmnew file+239

@@ -0,0 +1,239 @@

1+port module Main 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.Da

15+import Ur.Deconstructor as D

16+import Ur.Requests

17+import Ur.Run

18+import Ur.Sub

19+import Widget

20+import Widget.Icon as Icon

21+import Widget.Material as Material

22+

23+

24+main =

25+ Ur.Run.application

26+ { init =

27+ \_ _ ->

28+ ( { error = ""

29+ , entries = Nothing

30+ , newEntry = ""

31+ }

32+ , Cmd.batch

33+ [ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"

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

35+ , Ur.Requests.scry

36+ { url = "http://localhost:8080"

37+ , agent = "journal"

38+ , path = [ "entries", "all" ]

39+ , error = Noop

40+ , success =

41+ D.cell D.ignore

42+ (D.cell (D.const D.cord "jrnl")

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

44+ |> D.map GotListings

45+ )

46+ }

47+ ]

48+ |> Ur.Cmd.cmd

49+ )

50+ , update = update

51+ , view = view

52+ , subscriptions = always Sub.none

53+ , createEventSource = createEventSource

54+ , urbitSubscriptions =

55+ \{ entries } ->

56+ case entries of

57+ Nothing ->

58+ Ur.Sub.none

59+

60+ Just _ ->

61+ Ur.Sub.subscribe

62+ { ship = "~zod"

63+ , app = "journal"

64+ , path = [ "updates" ]

65+ , deconstructor = decodeJournalUpdate |> D.map GotUpdate

66+ }

67+ , onEventSourceMsg = onEventSourceMessage

68+ , onUrlChange = \_ -> Noop

69+ , onUrlRequest = \_ -> Noop

70+ , urbitUrl = \_ -> "http://localhost:8080"

71+ }

72+

73+

74+type alias Model =

75+ { error : String

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

77+ , newEntry : String

78+ }

79+

80+

81+type Msg

82+ = Noop

83+ | Error String

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

85+ | GotUpdate JournalUpdate

86+ | UpdateNewEntry String

87+ | DeleteEntry BigInt

88+ | AddEntry String

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

90+

91+

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

93+update msg model =

94+ case msg of

95+ Noop ->

96+ ( model, Ur.Cmd.none )

97+

98+ Error err ->

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

100+

101+ GotListings entries ->

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

103+

104+ GotUpdate action ->

105+ let

106+ applyAction oldEntries =

107+ case action of

108+ Add id txt ->

109+ ( id, txt ) :: oldEntries

110+

111+ Edit id txt ->

112+ oldEntries

113+ |> List.map

114+ (\(( key, _ ) as value) ->

115+ if key == id then

116+ ( key, txt )

117+

118+ else

119+ value

120+ )

121+

122+ Delete id ->

123+ oldEntries |> List.filter (\( key, _ ) -> key /= id)

124+

125+ newEntries =

126+ model.entries |> Maybe.map applyAction

127+ in

128+ ( { model | entries = newEntries }, Ur.Cmd.none )

129+

130+ UpdateNewEntry txt ->

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

132+

133+ DeleteEntry id ->

134+ ( model

135+ , Ur.Cmd.poke

136+ { ship = "~zod"

137+ , agent = "journal"

138+ , mark = "journal-action"

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

140+ }

141+ )

142+

143+ AddEntry txt ->

144+ ( { model | newEntry = "" }

145+ , Time.now

146+ |> Task.perform

147+ (\time ->

148+ Ur.Cmd.poke

149+ { ship = "~zod"

150+ , agent = "journal"

151+ , mark = "journal-action"

152+ , noun = C.cell (C.cord "add") (C.cell (Ur.Da.posixToDa time |> C.bigint) (C.cord txt))

153+ }

154+ |> RunCmd

155+ )

156+ |> Ur.Cmd.cmd

157+ )

158+

159+ RunCmd cmd ->

160+ ( model, cmd )

161+

162+

163+type JournalUpdate

164+ = Add BigInt String

165+ | Edit BigInt String

166+ | Delete BigInt

167+

168+

169+decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a

170+decodeJournalUpdate =

171+ D.cell D.ignore <|

172+ D.oneOf

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

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

175+ , D.cell (D.const D.cord "del") D.bigint |> D.map Delete

176+ ]

177+

178+

179+view : Model -> Document Msg

180+view model =

181+ { body =

182+ [ layout []

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

184+ , row [ spacing 8 ]

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

186+ { chips = []

187+ , text = model.newEntry

188+ , placeholder = Nothing

189+ , label = "New entry"

190+ , onChange = UpdateNewEntry

191+ }

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

193+ { text = "submit"

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

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

196+ }

197+ ]

198+ , model.entries

199+ |> Maybe.withDefault []

200+ |> List.map

201+ (\( id, txt ) ->

202+ row

203+ [ Border.rounded 10

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

205+ , centerX

206+ , padding 10

207+ , spacing 12

208+ ]

209+ [ paragraph [] [ text txt ]

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

211+ { text = "delete"

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

213+ , onPress = DeleteEntry id |> Just

214+ }

215+ ]

216+ )

217+ |> column [ spacing 10, centerX ]

218+ ]

219+ |> column [ spacing 18, centerX ]

220+ )

221+ ]

222+ , title = "Airlock"

223+ }

224+

225+

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

227+result f g res =

228+ case res of

229+ Ok b ->

230+ g b

231+

232+ Err a ->

233+ f a

234+

235+

236+port createEventSource : String -> Cmd msg

237+

238+

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

src/BigInt/Bytes.elmnew file+35

@@ -0,0 +1,35 @@

1+module BigInt.Bytes exposing (decode, encode)

3+import BigInt exposing (BigInt, toHexString)

4+import Bytes exposing (Bytes)

5+import Bytes.Extra

6+import Hex.Convert as Hex

9+encode : BigInt -> Bytes

10+encode x =

11+ let

12+ hexString =

13+ toHexString x

14+

15+ paddedHexString =

16+ if modBy 2 (String.length hexString) == 0 then

17+ hexString

18+

19+ else

20+ "0" ++ hexString

21+ in

22+ Hex.toBytes paddedHexString

23+ |> Maybe.map (Bytes.Extra.toByteValues >> List.reverse >> Bytes.Extra.fromByteValues)

24+ |> Maybe.withDefault Bytes.Extra.empty

25+

26+

27+decode : Bytes -> BigInt

28+decode bs =

29+ bs

30+ |> Bytes.Extra.toByteValues

31+ |> List.reverse

32+ |> Bytes.Extra.fromByteValues

33+ |> Hex.toString

34+ |> BigInt.fromHexString

35+ |> Maybe.withDefault (BigInt.fromInt 0)

src/Urbit.elm → src/Ur.elmrenamed+41−3

@@ -1,7 +1,12 @@

1−module Urbit exposing

2− ( Noun(..)

1+module Ur exposing

2+ ( Agent

3+ , Atom

4+ , Mark

5+ , Noun(..)

6+ , Path

37 , cue

48 , jam

9+ , logIn

510 , mat

611 , rub

712 )

@@ -12,12 +17,45 @@ import Bitwise

1217import Bytes exposing (Bytes)

1318import Bytes.Extra as Bytes

1419import Dict exposing (Dict)

20+import Http

1521import List.Extra as List

1622

1723

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

25+-}

26+type alias Agent =

27+ String

28+

29+

30+{-| An Urbit subscription path.

31+-}

32+type alias Path =

33+ List String

34+

35+

36+type alias Mark =

37+ String

38+

39+

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

41+logIn root password =

42+ Http.riskyRequest

43+ { url = root ++ "/~/login"

44+ , method = "POST"

45+ , headers = []

46+ , timeout = Nothing

47+ , tracker = Nothing

48+ , body =

49+ Http.stringBody

50+ "application/x-www-form-urlencoded; charset=utf-8"

51+ ("password=" ++ password)

52+ , expect = Http.expectWhatever identity

53+ }

54+

55+

1856type Noun

1957 = Cell ( Noun, Noun )

20− | Atom Bytes

58+ | Atom Atom

2159

2260

2361type alias Atom =

src/Ur/Cmd.elmnew file+35

@@ -0,0 +1,35 @@

1+module Ur.Cmd exposing

2+ ( Cmd

3+ , batch

4+ , cmd

5+ , none

6+ , poke

7+ )

9+import Ur exposing (Agent, Mark, Noun)

10+import Ur.Cmd.Internal

11+import Ur.Phonemic exposing (Ship)

12+

13+

14+type alias Cmd msg =

15+ List (Ur.Cmd.Internal.Cmd msg)

16+

17+

18+none : Cmd msg

19+none =

20+ []

21+

22+

23+poke : { ship : Ship, agent : Agent, mark : Mark, noun : Noun } -> Cmd msg

24+poke p =

25+ [ Ur.Cmd.Internal.Poke p ]

26+

27+

28+cmd : Cmd.Cmd msg -> Cmd msg

29+cmd c =

30+ [ Ur.Cmd.Internal.Cmd c ]

31+

32+

33+batch : List (Cmd msg) -> Cmd msg

34+batch =

35+ List.concat

src/Ur/Cmd/Internal.elmnew file+9

@@ -0,0 +1,9 @@

1+module Ur.Cmd.Internal exposing (Cmd(..))

3+import Ur exposing (Agent, Mark, Noun)

4+import Ur.Phonemic exposing (Ship)

7+type Cmd msg

8+ = Poke { ship : Ship, agent : Agent, mark : Mark, noun : Noun }

9+ | Cmd (Cmd.Cmd msg)

src/Urbit/Constructor.elm → src/Ur/Constructor.elmrenamed+11−2

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

1−module Urbit.Constructor exposing

1+module Ur.Constructor exposing

22 ( Constructor

3+ , bigint

4+ , bytes

35 , cell

46 , cord

57 , float32

@@ -11,10 +13,12 @@ module Urbit.Constructor exposing

1113 , tape

1214 )

1315

16+import BigInt exposing (BigInt)

17+import BigInt.Bytes

1418import Bitwise

1519import Bytes exposing (Bytes, Endianness(..))

1620import Bytes.Encode as BE

17−import Urbit exposing (..)

21+import Ur exposing (..)

1822

1923

2024type alias Constructor a =

@@ -42,6 +46,11 @@ int i =

4246 )

4347

4448

49+bigint : BigInt -> Noun

50+bigint x =

51+ Atom (BigInt.Bytes.encode x)

52+

53+

4554signedInt : Int -> Noun

4655signedInt i =

4756 int

src/Ur/Da.elmnew file+23

@@ -0,0 +1,23 @@

1+module Ur.Da exposing (Da, posixToDa)

3+import BigInt exposing (BigInt)

4+import Time exposing (Posix)

7+type alias Da =

8+ BigInt

10+

11+unixEpochStart : BigInt

12+unixEpochStart =

13+ BigInt.fromIntString "170141184475152167957503069145530368000" |> Maybe.withDefault (BigInt.fromInt 0)

14+

15+

16+second : BigInt

17+second =

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

19+

20+

21+posixToDa : Posix -> Da

22+posixToDa p =

23+ BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000)) unixEpochStart

src/Urbit/Deconstructor.elm → src/Ur/Deconstructor.elmrenamed+26−4

@@ -1,12 +1,14 @@

1−module Urbit.Deconstructor exposing

1+module Ur.Deconstructor exposing

22 ( Deconstructor

33 , alt

4+ , bigint

45 , bytes

56 , cell

67 , const

78 , cord

89 , float32

910 , float64

11+ , ignore

1012 , int

1113 , list

1214 , llec

@@ -20,12 +22,14 @@ module Urbit.Deconstructor exposing

2022 , tar

2123 )

2224

25+import BigInt exposing (BigInt)

26+import BigInt.Bytes

2327import Bitwise

2428import Bytes exposing (Bytes, Endianness(..))

2529import Bytes.Decode as BD

2630import Bytes.Encode as BE

2731import Bytes.Extra

28−import Urbit exposing (..)

32+import Ur exposing (..)

2933

3034

3135type Deconstructor a b

@@ -109,6 +113,19 @@ int =

109113 )

110114

111115

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

123+

124+ Cell _ ->

125+ Nothing

126+ )

127+

128+

112129signedInt : Deconstructor (Int -> a) a

113130signedInt =

114131 int

@@ -220,9 +237,14 @@ oneOf l =

220237 alt x (oneOf xs)

221238

222239

223−tar : Deconstructor a a

240+tar : Deconstructor (Noun -> a) a

224241tar =

225− Deconstructor (\_ a -> Just a)

242+ Deconstructor (\noun f -> Just (f noun))

243+

244+

245+ignore : Deconstructor a a

246+ignore =

247+ Deconstructor (\_ f -> Just f)

226248

227249

228250llec : Deconstructor a b -> Deconstructor b c -> Deconstructor a c

src/Ur/Phonemic.elmnew file+28

@@ -0,0 +1,28 @@

1+module Ur.Phonemic exposing (Ship, fromString)

3+import BigInt.Bytes

4+import Bytes.Extra

5+import Ur exposing (Atom, Noun(..))

6+import Urbit.Encoding.Atom exposing (toBigInt)

7+import Urbit.Encoding.Phonemic exposing (..)

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.

20+-}

21+fromString : Ship -> Atom

22+fromString s =

23+ case fromPatp s of

24+ Ok atom ->

25+ toBigInt atom |> BigInt.Bytes.encode

26+

27+ Err _ ->

28+ Bytes.Extra.empty

src/Ur/Requests.elmnew file+164

@@ -0,0 +1,164 @@

1+module Ur.Requests exposing

2+ ( EventId

3+ , UrbitRequest(..)

4+ , scry

5+ , scryTask

6+ , send

7+ , sendTask

8+ , tag

9+ , toNoun

10+ )

11+

12+import Http

13+import Task exposing (Task)

14+import Ur exposing (..)

15+import Ur.Constructor as C

16+import Ur.Deconstructor as D

17+import Ur.Phonemic exposing (Ship)

18+import Ur.Uw

19+

20+

21+type UrbitRequest

22+ = Subscribe ( Ship, Agent, Path )

23+ | Unsubscribe EventId

24+ | Poke { ship : Ship, agent : Agent, mark : Mark, noun : Noun }

25+ | Ack Int

26+

27+

28+tag : EventId -> List x -> ( EventId, List ( EventId, x ) )

29+tag eventId reqs =

30+ case reqs of

31+ [] ->

32+ ( eventId, [] )

33+

34+ req :: rest ->

35+ tag (eventId + 1) rest |> Tuple.mapSecond (\xs -> ( eventId, req ) :: xs)

36+

37+

38+send :

39+ { url : String

40+ , error : msg

41+ , success : msg

42+ , requests : List ( EventId, UrbitRequest )

43+ }

44+ -> Cmd msg

45+send inp =

46+ sendTask inp |> Task.perform identity

47+

48+

49+{-| `requests` should the result of calling `tag`

50+-}

51+sendTask :

52+ { url : String

53+ , error : msg

54+ , success : msg

55+ , requests : List ( EventId, UrbitRequest )

56+ }

57+ -> Task a msg

58+sendTask { url, error, success, requests } =

59+ if List.isEmpty requests then

60+ Task.succeed success

61+

62+ else

63+ Http.riskyTask

64+ { method = "PUT"

65+ , headers = []

66+ , url = url

67+ , body =

68+ requests

69+ |> List.map (uncurry toNoun)

70+ |> C.listOf identity

71+ |> Ur.jam

72+ |> Ur.Uw.encode

73+ |> Http.stringBody "application/x-urb-jam"

74+ , resolver =

75+ Http.bytesResolver

76+ (\resp ->

77+ case resp of

78+ Http.GoodStatus_ _ _ ->

79+ Ok success

80+

81+ _ ->

82+ Ok error

83+ )

84+ , timeout = Nothing

85+ }

86+

87+

88+type alias EventId =

89+ Int

90+

91+

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+

137+toNoun : EventId -> UrbitRequest -> Noun

138+toNoun eventId req =

139+ case req of

140+ Subscribe ( ship, app, path ) ->

141+ C.cell (C.cord "subscribe") <|

142+ C.cell (C.int eventId) <|

143+ C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|

144+ C.cell (C.cord app) (C.listOf C.cord path)

145+

146+ Unsubscribe subId ->

147+ C.cell (C.cord "usubscribe") <|

148+ C.cell (C.int eventId) (C.int subId)

149+

150+ Poke { ship, agent, mark, noun } ->

151+ C.cell (C.cord "poke") <|

152+ C.cell (C.int eventId) <|

153+ C.cell (Ur.Atom (Ur.Phonemic.fromString ship)) <|

154+ C.cell (C.cord agent) <|

155+ C.cell (C.cord mark) <|

156+ noun

157+

158+ Ack number ->

159+ C.cell (C.cord "ack") (C.int number)

160+

161+

162+uncurry : (a -> b -> c) -> (( a, b ) -> c)

163+uncurry f ( a, b ) =

164+ f a b

src/Ur/Run.elmnew file+375

@@ -0,0 +1,375 @@

1+module Ur.Run exposing (Model, Msg, application)

3+import Browser exposing (Document, UrlRequest)

4+import Browser.Navigation as Nav

5+import Dict exposing (Dict)

6+import Either exposing (Either(..))

7+import Html

8+import Json.Decode as JD

9+import Task

10+import Time

11+import Ur exposing (Agent, Path)

12+import Ur.Cmd

13+import Ur.Cmd.Internal

14+import Ur.Constructor as C

15+import Ur.Deconstructor as D

16+import Ur.Phonemic exposing (Ship)

17+import Ur.Requests exposing (..)

18+import Ur.Sub

19+import Ur.Sub.Internal

20+import Ur.Uw

21+import Url exposing (Url)

22+

23+

24+type alias SubDict msg =

25+ Dict

26+ -- (ship, agent, path)

27+ ( String, String, List String )

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

29+ , number : Int

30+ }

31+

32+

33+type alias Flags =

34+ { uid : String }

35+

36+

37+type alias Model app msg =

38+ { subscriptions : SubDict msg

39+ , subscriptionIntMapping : Dict Int ( String, String, List String )

40+ , app : app

41+ , connected : Bool

42+ , eventId : Int

43+ , flags : Flags

44+ , requestsToRetry : List UrbitRequest

45+ }

46+

47+

48+type Msg msg

49+ = AppMsg msg

50+ | EventSourceMsg JD.Value

51+ | FailedRequest (List UrbitRequest)

52+ | Noop

53+ | OpenConnection

54+ | NeedsActivation

55+ | RetryRequests

56+

57+

58+application :

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

60+ , view : model -> Document msg

61+ , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )

62+ , subscriptions : model -> Sub msg

63+ , urbitSubscriptions : model -> Ur.Sub.Sub msg

64+ , onUrlRequest : UrlRequest -> msg

65+ , onUrlChange : Url -> msg

66+ , createEventSource : String -> Cmd (Msg msg)

67+ , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)

68+ , urbitUrl : model -> String

69+ }

70+ -> Program Flags (Model model msg) (Msg msg)

71+application inp =

72+ let

73+ { init, view, onUrlRequest, onUrlChange, onEventSourceMsg } =

74+ inp

75+ in

76+ Browser.application

77+ { init =

78+ \flags u key ->

79+ let

80+ ( app, appCmds ) =

81+ init u key

82+

83+ { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =

84+ processUrSubs

85+ 0

86+ Dict.empty

87+ (inp.urbitSubscriptions app |> (\(Ur.Sub.Internal.Sub x) -> x))

88+

89+ ( eventId_, cmds, urReqs ) =

90+ processCmd eventId appCmds

91+

92+ url =

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

94+ in

95+ ( { subscriptions = subscriptions

96+ , subscriptionIntMapping = subscriptionIntMapping

97+ , app = app

98+ , connected = False

99+ , eventId = eventId_

100+ , flags = flags

101+ , requestsToRetry = []

102+ }

103+ , [ cmds

104+ , pureCmd NeedsActivation

105+ , send

106+ { requests = urReqs ++ subscriptionRequests

107+ , url = url

108+ , error = Noop

109+ , success = Noop

110+ }

111+ ]

112+ |> Cmd.batch

113+ )

114+ , view =

115+ \model ->

116+ view model.app

117+ |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })

118+ , update = update inp

119+ , subscriptions =

120+ \model ->

121+ Sub.batch

122+ [ inp.subscriptions model.app |> Sub.map AppMsg

123+ , onEventSourceMsg EventSourceMsg

124+ , if List.isEmpty model.requestsToRetry then

125+ Sub.none

126+

127+ else

128+ Time.every 1000 (always RetryRequests)

129+ ]

130+ , onUrlRequest = \req -> onUrlRequest req |> AppMsg

131+ , onUrlChange = \url -> onUrlChange url |> AppMsg

132+ }

133+

134+

135+update :

136+ { r

137+ | update : msg -> app -> ( app, Ur.Cmd.Cmd msg )

138+ , createEventSource : String -> Cmd (Msg msg)

139+ , urbitUrl : app -> String

140+ , urbitSubscriptions : app -> Ur.Sub.Sub msg

141+ }

142+ -> Msg msg

143+ -> Model app msg

144+ -> ( Model app msg, Cmd (Msg msg) )

145+update inp msg model =

146+ let

147+ url =

148+ inp.urbitUrl model.app ++ "/~/channel/" ++ model.flags.uid

149+ in

150+ case msg of

151+ AppMsg msg_ ->

152+ let

153+ ( appModel, appCmds ) =

154+ inp.update msg_ model.app

155+

156+ { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =

157+ processUrSubs

158+ model.eventId

159+ model.subscriptions

160+ (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))

161+

162+ ( eventId_, cmds, urReqs ) =

163+ processCmd eventId appCmds

164+ in

165+ ( { model

166+ | app = appModel

167+ , eventId = eventId_

168+ , subscriptions = subscriptions

169+ , subscriptionIntMapping = model.subscriptionIntMapping |> Dict.union subscriptionIntMapping

170+ }

171+ , Cmd.batch

172+ [ cmds

173+ , Ur.Requests.send

174+ { url = url

175+ , error = Noop

176+ , success = Noop

177+ , requests = urReqs

178+ }

179+ , send

180+ { requests = subscriptionRequests

181+ , url = url

182+ , error = subscriptionRequests |> List.map (\( _, x ) -> x) |> FailedRequest

183+ , success = Noop

184+ }

185+ ]

186+ )

187+

188+ EventSourceMsg value ->

189+ case JD.decodeValue (JD.field "message" JD.string) value of

190+ Ok string ->

191+ case

192+ D.runBytes

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

194+ |> D.map (\a b c -> ( a, b, c ))

195+ )

196+ (Ur.Uw.decode string)

197+ of

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

199+ let

200+ ( eventId, ackReqs ) =

201+ tag model.eventId [ Ack messageId ]

202+

203+ ackCmd =

204+ send

205+ { requests = ackReqs

206+ , url = url

207+ , success = Noop

208+ , error = ackReqs |> List.map (\( _, x ) -> x) |> FailedRequest

209+ }

210+

211+ model_ =

212+ { model | eventId = eventId }

213+ in

214+ case messageType of

215+ "watch-ack" ->

216+ -- Not sure what to do. Assume things are fine.

217+ ( model_, ackCmd )

218+

219+ "poke-ack" ->

220+ -- Not sure what to do.

221+ ( model_, ackCmd )

222+

223+ "fact" ->

224+ case

225+ Dict.get messageId model.subscriptionIntMapping

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

227+ of

228+ Just { deconstructor } ->

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

230+ Just subMsg ->

231+ ( model_, pureCmd (AppMsg subMsg) )

232+

233+ -- Got gargbage

234+ Nothing ->

235+ ( model_, ackCmd )

236+

237+ -- Got a fact for a subscription we do not hold

238+ Nothing ->

239+ ( model_, ackCmd )

240+

241+ _ ->

242+ ( model_, ackCmd )

243+

244+ -- got something we don't expect

245+ Nothing ->

246+ ( model, Cmd.none )

247+

248+ Err _ ->

249+ case JD.decodeValue (JD.field "error" JD.value) value of

250+ Ok _ ->

251+ ( { model | connected = False }, Cmd.none )

252+

253+ Err _ ->

254+ -- we got garbage

255+ ( model, Cmd.none )

256+

257+ NeedsActivation ->

258+ let

259+ ( eventId, reqs ) =

260+ [ Poke { ship = "~zod", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]

261+ |> tag model.eventId

262+ in

263+ ( { model | eventId = eventId }

264+ , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }

265+ )

266+

267+ Noop ->

268+ ( model, Cmd.none )

269+

270+ FailedRequest reqs ->

271+ ( { model | requestsToRetry = reqs ++ model.requestsToRetry }, Cmd.none )

272+

273+ OpenConnection ->

274+ ( { model | connected = True }, inp.createEventSource url )

275+

276+ RetryRequests ->

277+ let

278+ ( eventId, reqs ) =

279+ model.requestsToRetry |> tag model.eventId

280+ in

281+ ( { model | eventId = eventId, requestsToRetry = [] }

282+ , send

283+ { url = url

284+ , error = FailedRequest model.requestsToRetry

285+ , success = Noop

286+ , requests = reqs

287+ }

288+ )

289+

290+

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

292+processCmd eventId urCmds =

293+ let

294+ ( cmds, reqs ) =

295+ urCmds

296+ |> List.map

297+ (\x ->

298+ case x of

299+ Ur.Cmd.Internal.Cmd cmd ->

300+ cmd |> Cmd.map AppMsg |> Left

301+

302+ Ur.Cmd.Internal.Poke p ->

303+ Ur.Requests.Poke p |> Right

304+ )

305+ |> Either.partition

306+

307+ ( newEventId, urReqs ) =

308+ reqs |> tag eventId

309+ in

310+ ( newEventId, Cmd.batch cmds, urReqs )

311+

312+

313+pureCmd : msg -> Cmd msg

314+pureCmd msg =

315+ Task.succeed msg |> Task.perform identity

316+

317+

318+processUrSubs :

319+ EventId

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

321+ -> Dict ( Ship, Agent, Path ) d

322+ ->

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

324+ , eventId : EventId

325+ , subscriptionRequests : List ( EventId, UrbitRequest )

326+ , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )

327+ }

328+processUrSubs eventId existingSubscriptions urbitSubs_ =

329+ let

330+ urbitSubs =

331+ urbitSubs_

332+ |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })

333+

334+ ( eventId_, newSubscriptionActions ) =

335+ Dict.diff urbitSubs existingSubscriptions

336+ |> Dict.toList

337+ |> List.map (\( address, _ ) -> ( Subscribe address, address ))

338+ |> tag eventId

339+

340+ removedSubscriptions =

341+ Dict.diff existingSubscriptions urbitSubs

342+

343+ ( eventId__, removedSubscriptionActions ) =

344+ removedSubscriptions

345+ |> Dict.toList

346+ |> List.map (\( _, { number } ) -> Unsubscribe number)

347+ |> tag eventId_

348+

349+ keyToNumber =

350+ newSubscriptionActions |> List.map (\( a, ( _, b ) ) -> ( b, a )) |> Dict.fromList

351+

352+ newSubscriptions =

353+ Dict.merge

354+ (\_ _ x -> x)

355+ (\key number { deconstructor } ->

356+ Dict.insert key

357+ { deconstructor = deconstructor

358+ , number = number

359+ }

360+ )

361+ (\_ _ x -> x)

362+ keyToNumber

363+ urbitSubs

364+ Dict.empty

365+ in

366+ { subscriptions = Dict.diff existingSubscriptions removedSubscriptions |> Dict.union newSubscriptions

367+ , subscriptionIntMapping =

368+ newSubscriptions

369+ |> Dict.toList

370+ |> List.map (\( key, { number } ) -> ( number, key ))

371+ |> Dict.fromList

372+ , eventId = eventId__

373+ , subscriptionRequests =

374+ removedSubscriptionActions ++ (newSubscriptionActions |> List.map (\( id, ( req, _ ) ) -> ( id, req )))

375+ }

src/Ur/Sub.elmnew file+24

@@ -0,0 +1,24 @@

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

3+import Dict

4+import Ur.Deconstructor as D

5+import Ur.Sub.Internal

8+type alias Sub msg =

9+ Ur.Sub.Internal.Sub msg

10+

11+

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

15+

16+

17+none : Sub msg

18+none =

19+ Ur.Sub.Internal.Sub Dict.empty

20+

21+

22+batch : List (Sub msg) -> Sub msg

23+batch subs =

24+ subs |> List.map (\(Ur.Sub.Internal.Sub dict) -> dict) |> List.foldl Dict.union Dict.empty |> Ur.Sub.Internal.Sub

src/Ur/Sub/Internal.elmnew file+15

@@ -0,0 +1,15 @@

1+module Ur.Sub.Internal exposing (Sub(..))

3+import Dict exposing (Dict)

4+import Ur exposing (Agent, Path)

5+import Ur.Deconstructor as D

6+import Ur.Phonemic exposing (Ship)

9+type Sub msg

10+ = Sub

11+ (Dict

12+ -- key is (ship, app, path)

13+ ( Ship, Agent, Path )

14+ (D.Deconstructor (msg -> msg) msg)

15+ )

src/Ur/Uw.elmnew file+196

@@ -0,0 +1,196 @@

1+module Ur.Uw exposing (decode, encode)

3+import BitParser as BP

4+import BitWriter as BW

5+import Bitwise

6+import Bytes exposing (Bytes)

7+import Bytes.Extra

8+import Dict

9+import List.Extra

10+

11+

12+decode : String -> Bytes

13+decode string =

14+ if string == "0w0" then

15+ Bytes.Extra.empty

16+

17+ else

18+ let

19+ chars =

20+ string

21+ |> String.toList

22+ -- 0w

23+ |> List.drop 2

24+

25+ go : List Char -> BW.BitWriter -> BW.BitWriter

26+ go cs writer =

27+ case cs of

28+ [] ->

29+ writer

30+

31+ '.' :: rest ->

32+ go rest writer

33+

34+ c :: rest ->

35+ case Dict.get c charToBits of

36+ Just bits ->

37+ go rest writer |> BW.bits bits

38+

39+ Nothing ->

40+ go rest writer

41+ in

42+ BW.run (go chars BW.empty)

43+

44+

45+encode : Bytes -> String

46+encode bytes =

47+ let

48+ w =

49+ Bytes.width bytes * 8

50+

51+ go () =

52+ take w 6

53+ |> BP.andThen

54+ (\bits ->

55+ if List.isEmpty bits then

56+ BP.succeed []

57+

58+ else

59+ case Dict.get (BP.bitsToInt bits) intToChar of

60+ Nothing ->

61+ BP.fail

62+

63+ Just char ->

64+ go () |> BP.map (\chars -> char :: chars)

65+ )

66+

67+ encoded =

68+ BP.run (go ()) bytes

69+ |> Maybe.withDefault []

70+ |> List.Extra.dropWhileRight (\x -> x == '0')

71+ |> dot

72+ |> List.reverse

73+ in

74+ if List.isEmpty encoded then

75+ "0w0"

76+

77+ else

78+ String.fromList ('0' :: 'w' :: encoded)

79+

80+

81+dot : List Char -> List Char

82+dot chars =

83+ if List.isEmpty chars then

84+ []

85+

86+ else if List.length chars <= 5 then

87+ chars

88+

89+ else

90+ List.take 5 chars ++ ('.' :: dot (List.drop 5 chars))

91+

92+

93+take : Int -> Int -> BP.BitParser (List Int)

94+take width n =

95+ if n <= 0 then

96+ BP.succeed []

97+

98+ else

99+ BP.getOffset

100+ |> BP.andThen

101+ (\offset ->

102+ if offset >= width then

103+ BP.succeed []

104+

105+ else

106+ BP.bit

107+ |> BP.andThen

108+ (\bit -> take width (n - 1) |> BP.map (\bits -> bit :: bits))

109+ )

110+

111+

112+intToChar : Dict.Dict Int Char

113+intToChar =

114+ Dict.fromList mapping

115+

116+

117+charToBits : Dict.Dict Char (List Int)

118+charToBits =

119+ let

120+ intToBits bitsLeft n =

121+ if bitsLeft > 0 then

122+ Bitwise.and 1 n :: intToBits (bitsLeft - 1) (Bitwise.shiftRightBy 1 n)

123+

124+ else

125+ []

126+ in

127+ mapping |> List.map (\( x, y ) -> ( y, intToBits 6 x )) |> Dict.fromList

128+

129+

130+mapping : List ( number, Char )

131+mapping =

132+ [ ( 0, '0' )

133+ , ( 1, '1' )

134+ , ( 2, '2' )

135+ , ( 3, '3' )

136+ , ( 4, '4' )

137+ , ( 5, '5' )

138+ , ( 6, '6' )

139+ , ( 7, '7' )

140+ , ( 8, '8' )

141+ , ( 9, '9' )

142+ , ( 10, 'a' )

143+ , ( 11, 'b' )

144+ , ( 12, 'c' )

145+ , ( 13, 'd' )

146+ , ( 14, 'e' )

147+ , ( 15, 'f' )

148+ , ( 16, 'g' )

149+ , ( 17, 'h' )

150+ , ( 18, 'i' )

151+ , ( 19, 'j' )

152+ , ( 20, 'k' )

153+ , ( 21, 'l' )

154+ , ( 22, 'm' )

155+ , ( 23, 'n' )

156+ , ( 24, 'o' )

157+ , ( 25, 'p' )

158+ , ( 26, 'q' )

159+ , ( 27, 'r' )

160+ , ( 28, 's' )

161+ , ( 29, 't' )

162+ , ( 30, 'u' )

163+ , ( 31, 'v' )

164+ , ( 32, 'w' )

165+ , ( 33, 'x' )

166+ , ( 34, 'y' )

167+ , ( 35, 'z' )

168+ , ( 36, 'A' )

169+ , ( 37, 'B' )

170+ , ( 38, 'C' )

171+ , ( 39, 'D' )

172+ , ( 40, 'E' )

173+ , ( 41, 'F' )

174+ , ( 42, 'G' )

175+ , ( 43, 'H' )

176+ , ( 44, 'I' )

177+ , ( 45, 'J' )

178+ , ( 46, 'K' )

179+ , ( 47, 'L' )

180+ , ( 48, 'M' )

181+ , ( 49, 'N' )

182+ , ( 50, 'O' )

183+ , ( 51, 'P' )

184+ , ( 52, 'Q' )

185+ , ( 53, 'R' )

186+ , ( 54, 'S' )

187+ , ( 55, 'T' )

188+ , ( 56, 'U' )

189+ , ( 57, 'V' )

190+ , ( 58, 'W' )

191+ , ( 59, 'X' )

192+ , ( 60, 'Y' )

193+ , ( 61, 'Z' )

194+ , ( 62, '-' )

195+ , ( 63, '~' )

196+ ]

tests/Test/Urbit.elm+43−5

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

11module Test.Urbit exposing (tests)

3+import BigInt exposing (BigInt)

4+import BigInt.Bytes

35import BitParser

46import BitWriter

57import Bytes exposing (Bytes)

@@ -9,9 +11,10 @@ import Fuzz exposing (Fuzzer)

911import List.Extra as List

1012import Test exposing (..)

1113import Test.Utils exposing (..)

12−import Urbit exposing (..)

13−import Urbit.Constructor as C

14−import Urbit.Deconstructor as D

14+import Ur exposing (..)

15+import Ur.Constructor as C

16+import Ur.Deconstructor as D

17+import Ur.Uw

1518

1619

1720tests : Test

@@ -76,6 +79,16 @@ tests =

7679 (Bytes.fromByteValues [ 0x31, 0x12 ])

7780 )

7881 )

82+ , test "1.686.761.906.334"

83+ (\() ->

84+ Expect.equal

85+ (Just "1686761906334")

86+ (D.runBytes

87+ D.bigint

88+ (Bytes.fromByteValues [ 0x80, 0xC9, 0x13, 0x04, 0x5B, 0x17, 0x31 ])

89+ |> Maybe.map BigInt.toString

90+ )

91+ )

7992 , test "[4 ~[1 2 3]]"

8093 (\() ->

8194 Expect.equal

@@ -149,7 +162,7 @@ tests =

149162 (Bytes.fromByteValues [ 0xC1, 0x20, 0xE4, 0x01 ])

150163 )

151164 )

152− , test "65.600"

165+ , test "Int 65.600"

153166 (\() ->

154167 Expect.equal

155168 (Just 65600)

@@ -158,6 +171,15 @@ tests =

158171 (Bytes.fromByteValues [ 0xC0, 0x00, 0x02, 0x08 ])

159172 )

160173 )

174+ , test "BigInt 65.600"

175+ (\() ->

176+ Expect.equal

177+ (Just (BigInt.fromInt 65600))

178+ (D.runBytes

179+ D.bigint

180+ (Bytes.fromByteValues [ 0xC0, 0x00, 0x02, 0x08 ])

181+ )

182+ )

161183 ]

162184 , describe "Constructor <-> Deconstructor"

163185 [ Test.fuzz

@@ -203,6 +225,12 @@ tests =

203225 (C.tape x)

204226 )

205227 )

228+ , Test.fuzz bigint "bigint" (\x -> Expect.equal (Just x) (D.run D.bigint (C.bigint x)))

229+ ]

230+ , Test.describe "Ur.Uw"

231+ [ Test.fuzz atom

232+ "encode <-> decode"

233+ (\bs -> bytesEq bs (bs |> Ur.Uw.encode |> Ur.Uw.decode |> stripTrailingZeros))

206234 ]

207235 ]

208236

@@ -234,7 +262,12 @@ atom : Fuzzer Bytes

234262atom =

235263 bytes

236264 |> Fuzz.map

237− (\a -> a |> Bytes.toByteValues |> List.dropWhileRight (\x -> x == 0) |> Bytes.fromByteValues)

265+ stripTrailingZeros

266+

267+

268+stripTrailingZeros : Bytes -> Bytes

269+stripTrailingZeros =

270+ Bytes.toByteValues >> List.dropWhileRight (\x -> x == 0) >> Bytes.fromByteValues

238271

239272

240273noun : () -> Fuzzer Noun

@@ -243,3 +276,8 @@ noun () =

243276 [ ( 0.6, atom |> Fuzz.map Atom )

244277 , ( 0.4, Fuzz.map2 (\a b -> Cell ( a, b )) (Fuzz.lazy noun) (Fuzz.lazy noun) )

245278 ]

279+

280+

281+bigint : Fuzzer BigInt

282+bigint =

283+ bytes |> Fuzz.map BigInt.Bytes.decode