3d83802 · airlock · git.iko.soy

git.iko.soy/airlock

on master help sign in

Added proper docs

3d83802iko3 years ago

elm.json+1−1

compare with master

unifiedsplit

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

5 "license": "MIT",

6 "version": "1.0.0",

7 "exposed-modules": [

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

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

9 ],

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

11 "dependencies": {

src/Ur.elm+66−209

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

1−module Ur exposing

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

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

3+{-|

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

26−-}

27−type alias Agent =

28− String

6+# Simple requests

8+@docs logIn, getShipName, scry, scryTask

31−{-| An Urbit subscription path.

32-}

10-}

33−type alias Path =

34− List String

12+import Http

13+import Platform exposing (Task)

14+import Task

15+import Ur.Deconstructor as D

16+import Ur.Types exposing (..)

37−type alias Mark =

38− String

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

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

22+

23+-}

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

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

42logIn root password =

25logIn root password =

43 Http.riskyRequest

26 Http.riskyRequest

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

54 }

37 }

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

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

42+

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

44+

45+-}

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

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

58getShipName root =

47getShipName root =

59 Http.riskyRequest

48 Http.riskyRequest

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

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

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

67 }

56 }

70−type Noun

59+{-| -}

71− = Cell ( Noun, Noun )

60+scry :

72− | Atom Atom

61+ { url : String

73−

62+ , agent : Agent

74−

63+ , path : Path

75−type alias Atom =

64+ , error : msg

76− Bytes

65+ , success : D.Deconstructor (msg -> msg) msg

77−

66+ }

78−

67+ -> Cmd msg

79−jam : Noun -> Bytes

68+scry args =

80−jam n =

69+ scryTask args |> Task.perform identity

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

70+

82−

71+

83−

72+{-| -}

84−

73+scryTask :

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

74+ { url : String

86−-- to poor performance

75+ , agent : Agent

87−

76+ , path : Path

88−

77+ , error : msg

89−jamWriter : Noun -> BitWriter -> BitWriter

78+ , success : D.Deconstructor (msg -> msg) msg

90−jamWriter noun writer =

79+ }

91− case noun of

80+ -> Task a msg

92− Atom atom ->

81+scryTask { url, agent, path, error, success } =

93− writer

82+ Http.riskyTask

94− |> BW.bit 0

83+ { method = "GET"

95− |> mat atom

84+ , headers = []

96−

85+ , url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"

97− Cell ( a, b ) ->

86+ , body = Http.emptyBody

98− writer

87+ , resolver =

99− |> BW.bit 1

88+ Http.bytesResolver

100− |> BW.bit 0

89+ (\resp ->

101− |> jamWriter a

90+ case resp of

102− |> jamWriter b

91+ Http.GoodStatus_ _ bytes ->

103−

92+ case D.runBytes success bytes of

104−

93+ Just msg ->

105−cue : Bytes -> Maybe Noun

94+ Ok msg

106−cue =

95+

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

96+ Nothing ->

108−

97+ Ok error

109−

98+

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

99+ _ ->

111−cueParser refs =

100+ Ok error

112− BP.getOffset

101+ )

113− |> BP.andThen

102+ , timeout = Nothing

114− (\offset ->

103+ }

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)

src/Ur/Cmd.elm+14−10

@@ -1,35 +1,39 @@

1−module Ur.Cmd exposing

1+module Ur.Cmd exposing (Cmd, poke, cmd, none, batch)

2− ( Cmd

3− , batch

3+{-| This module is conceptually similar to `Platform.Cmd`, but also allows you to send Urbit requests.

4− , cmd

5− , none

5+@docs Cmd, poke, cmd, none, batch

6− , poke

7− )

7+-}

8−

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

10import Ur.Cmd.Internal

9import Ur.Cmd.Internal

11−import Ur.Phonemic exposing (Ship)

10+import Ur.Types exposing (Agent, Mark, Noun, Ship)

13+{-| -}

14type alias Cmd msg =

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

18+{-| -}

18none : Cmd msg

19none : Cmd msg

19none =

20none =

20 []

21 []

24+{-| -}

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

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

24poke p =

26poke p =

25 [ Ur.Cmd.Internal.Poke p ]

27 [ Ur.Cmd.Internal.Poke p ]

30+{-| -}

28cmd : Cmd.Cmd msg -> Cmd msg

31cmd : Cmd.Cmd msg -> Cmd msg

29cmd c =

32cmd c =

30 [ Ur.Cmd.Internal.Cmd c ]

33 [ Ur.Cmd.Internal.Cmd c ]

36+{-| -}

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

37batch : List (Cmd msg) -> Cmd msg

34batch =

38batch =

35 List.concat

39 List.concat

src/Ur/Cmd/Internal.elm+1−2

@@ -1,7 +1,6 @@

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

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

3+import Ur.Types exposing (Agent, Mark, Noun, Ship)

4−import Ur.Phonemic exposing (Ship)

7type Cmd msg

6type Cmd msg

src/Ur/Constructor.elm+65−16

@@ -1,35 +1,58 @@

1module Ur.Constructor exposing

2− ( Constructor

2+ ( cell, sig, bytes

3− , bigint

3+ , int, signedInt, bigint

4− , bytes

5− , cell

6− , cord

7− , float32

4+ , float32, float64

8− , float64

5+ , cord, tape

9− , int

10 , listOf

6 , listOf

11− , sig

12− , signedInt

13− , tape

14 )

7 )

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+

16import BigInt exposing (BigInt)

38import BigInt exposing (BigInt)

17import BigInt.Bytes

39import BigInt.Bytes

18import Bitwise

40import Bitwise

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

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

20import Bytes.Encode as BE

42import Bytes.Encode as BE

21−import Ur exposing (..)

43+import Ur.Types exposing (..)

22−

23−

24−type alias Constructor a =

25− a -> Noun

46+{-| Constructs a [Cell](https://developers.urbit.org/reference/glossary/cell) from two Nouns.

47+-}

28cell : Noun -> Noun -> Noun

48cell : Noun -> Noun -> Noun

29cell a b =

49cell a b =

30 Cell ( a, b )

50 Cell ( a, b )

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

33int : Int -> Noun

56int : Int -> Noun

34int i =

57int i =

35 Atom

58 Atom

@@ -46,11 +69,15 @@ int i =

46 )

69 )

72+{-| Constructs an `Atom` from a `BigInt`.

73+-}

49bigint : BigInt -> Noun

74bigint : BigInt -> Noun

50bigint x =

75bigint x =

51 Atom (BigInt.Bytes.encode x)

76 Atom (BigInt.Bytes.encode x)

79+{-| Constructs an `Atom` from a signed `Int`.

80+-}

54signedInt : Int -> Noun

81signedInt : Int -> Noun

55signedInt i =

82signedInt i =

56 int

83 int

@@ -62,21 +89,34 @@ signedInt i =

62 )

89 )

92+{-| Constructs an `Atom` from `Bytes`

93+-}

65bytes : Bytes -> Noun

94bytes : Bytes -> Noun

66bytes =

95bytes =

67 Atom

96 Atom

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

70cord : String -> Noun

101cord : String -> Noun

71cord s =

102cord s =

72 Atom (BE.encode (BE.string s))

103 Atom (BE.encode (BE.string s))

104

105

106+{-| Constructs a [`tape`](https://developers.urbit.org/reference/glossary/tape) from a `String`

107+-}

75tape : String -> Noun

108tape : String -> Noun

76tape s =

109tape s =

77 String.toList s |> List.map String.fromChar |> listOf cord

110 String.toList s |> List.map String.fromChar |> listOf cord

111

112

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

80listOf : (a -> Noun) -> List a -> Noun

120listOf : (a -> Noun) -> List a -> Noun

81listOf encEl list =

121listOf encEl list =

82 case list of

122 case list of

@@ -87,16 +127,25 @@ listOf encEl list =

87 cell (encEl x) (listOf encEl xs)

127 cell (encEl x) (listOf encEl xs)

128

129

130+{-| The [`sig`](https://developers.urbit.org/reference/glossary/tape) value. Also known as `~`.

131+

132+It is equivalent to `0`.

133+

134+-}

90sig : Noun

135sig : Noun

91sig =

136sig =

92 Atom (BE.encode (BE.sequence []))

137 Atom (BE.encode (BE.sequence []))

138

139

140+{-| Constructs an `Atom` from a 32-bit float.

141+-}

95float32 : Float -> Noun

142float32 : Float -> Noun

96float32 f =

143float32 f =

97 Atom (BE.encode (BE.float32 LE f))

144 Atom (BE.encode (BE.float32 LE f))

145

146

147+{-| Constructs an `Atom` from a 64-bit float.

148+-}

100float64 : Float -> Noun

149float64 : Float -> Noun

101float64 f =

150float64 f =

102 Atom (BE.encode (BE.float64 LE f))

151 Atom (BE.encode (BE.float64 LE f))

src/Ur/Da.elm+10

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

1module Ur.Da exposing (Da, posixToDa)

3+{-|

5+@docs Da, posixToDa

7+-}

3import BigInt exposing (BigInt)

9import BigInt exposing (BigInt)

4import Time exposing (Posix)

10import Time exposing (Posix)

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

14+-}

7type alias Da =

15type alias Da =

8 BigInt

16 BigInt

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

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

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

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

30+-}

21posixToDa : Posix -> Da

31posixToDa : Posix -> Da

22posixToDa p =

32posixToDa p =

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

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

src/Ur/Deconstructor.elm+133−31

@@ -1,27 +1,72 @@

1module Ur.Deconstructor exposing

2 ( Deconstructor

3− , alt

3+ , run, runBytes

4− , bigint

4+ , cell, list, oneOf, const

5− , bytes

6− , cell

7− , const

8− , cord

9− , float32

10− , float64

11− , ignore

12− , int

13− , list

14− , llec

15 , map

5 , map

16− , oneOf

17− , run

18− , runBytes

19− , sig

20− , signedInt

6+ , int, signedInt, bigint

7+ , float32, float64

21− , tape

8+ , cord, tape

22− , tar

9+ , bytes, sig, ignore, tar

23 )

10 )

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

13+

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

15+

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

17+

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

19+

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

21+

22+When you `map` a `Deconstructor` the function you pass to `map` will accept exactly the number of arguments

23+that "captured" values in exacly the order they occured in the `Deconstructor`.

24+

25+In our case we `map` the `Edit` type, which accepts exaclty two arguments because there are two `Deconstructor`s

26+that "capture" a value: `D.int` and `D.cord`.

27+

28+@docs Deconstructor

29+

30+

31+# Running a `Deconstructor`

32+

33+@docs run, runBytes

34+

35+

36+# Higher-order `Deconstructor`s

37+

38+@docs cell, list, oneOf, const

39+

40+

41+# Mapping a `Deconstructor`

42+

43+@docs map

44+

45+

46+# Numbers

47+

48+

49+## `Int`a

50+

51+@docs int, signedInt, bigint

52+

53+

54+## `Float`s

55+

56+@docs float32, float64

57+

58+

59+# `String`s

60+

61+@docs cord, tape

62+

63+

64+# Miscellaneous

65+

66+@docs bytes, sig, ignore, tar

67+

68+-}

69+

25import BigInt exposing (BigInt)

70import BigInt exposing (BigInt)

26import BigInt.Bytes

71import BigInt.Bytes

27import Bitwise

72import Bitwise

@@ -29,18 +74,25 @@ import Bytes exposing (Bytes, Endianness(..))

29import Bytes.Decode as BD

74import Bytes.Decode as BD

30import Bytes.Encode as BE

75import Bytes.Encode as BE

31import Bytes.Extra

76import Bytes.Extra

77+import Ur.Jam exposing (cue)

32−import Ur exposing (..)

78+import Ur.Types exposing (..)

81+{-| A `Noun` deconstructor.

82+-}

35type Deconstructor a b

83type Deconstructor a b

36 = Deconstructor (Noun -> a -> Maybe b)

84 = Deconstructor (Noun -> a -> Maybe b)

87+{-| Executes a `Deconstructor` on a `Noun`.

88+-}

39run : Deconstructor (a -> a) a -> Noun -> Maybe a

89run : Deconstructor (a -> a) a -> Noun -> Maybe a

40run (Deconstructor f) noun =

90run (Deconstructor f) noun =

41 f noun identity

91 f noun identity

94+{-| Executes a deconstructor on a `jam`med `Noun`.

95+-}

44runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a

96runBytes : Deconstructor (a -> a) a -> Bytes -> Maybe a

45runBytes (Deconstructor f) bs =

97runBytes (Deconstructor f) bs =

46 cue bs

98 cue bs

@@ -48,6 +100,15 @@ runBytes (Deconstructor f) bs =

48 (\noun -> f noun identity)

100 (\noun -> f noun identity)

101

102

103+{-| Asserts that the value at the current position should be exactly equal to the second argument.

104+

105+The first argument is a `Deconstructor` for the gven tyoe.

106+

107+The second argument is the value to compare with.

108+

109+This is useful to match on `term`s when there are multiple possible cases in a head-tagged union.

110+

111+-}

51const : Deconstructor (a -> a) a -> a -> Deconstructor c c

112const : Deconstructor (a -> a) a -> a -> Deconstructor c c

52const (Deconstructor f) value =

113const (Deconstructor f) value =

53 Deconstructor

114 Deconstructor

@@ -65,6 +126,8 @@ const (Deconstructor f) value =

65 )

126 )

127

128

129+{-| Extracts a `cord` at the current location.

130+-}

68cord : Deconstructor (String -> a) a

131cord : Deconstructor (String -> a) a

69cord =

132cord =

70 Deconstructor

133 Deconstructor

@@ -79,11 +142,18 @@ cord =

79 )

142 )

143

144

145+{-| Extracts a `tape` at the current location.

146+-}

82tape : Deconstructor (String -> a) a

147tape : Deconstructor (String -> a) a

83tape =

148tape =

84 list cord |> fmap String.concat

149 list cord |> fmap String.concat

150

151

152+{-| Extracts a 32-bit unsigned `Int` at the given location.

153+

154+If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.

155+

156+-}

87int : Deconstructor (Int -> a) a

157int : Deconstructor (Int -> a) a

88int =

158int =

89 Deconstructor

159 Deconstructor

@@ -113,6 +183,8 @@ int =

113 )

183 )

114

184

115

185

186+{-| Extracts a `BigInt` at the current location.

187+-}

116bigint : Deconstructor (BigInt -> a) a

188bigint : Deconstructor (BigInt -> a) a

117bigint =

189bigint =

118 Deconstructor

190 Deconstructor

@@ -126,6 +198,11 @@ bigint =

126 )

198 )

127

199

128

200

201+{-| Extracts a 32-bit signed `Int` at the given location.

202+

203+If the `Atom` at the current location is larger than 32 bits the the behaviour is undefined.

204+

205+-}

129signedInt : Deconstructor (Int -> a) a

206signedInt : Deconstructor (Int -> a) a

130signedInt =

207signedInt =

131 int

208 int

@@ -139,6 +216,8 @@ signedInt =

139 )

216 )

140

217

141

218

219+{-| Extracts a 32-bit `Float` at the given location.

220+-}

142float32 : Deconstructor (Float -> a) a

221float32 : Deconstructor (Float -> a) a

143float32 =

222float32 =

144 Deconstructor

223 Deconstructor

@@ -153,6 +232,8 @@ float32 =

153 )

232 )

154

233

155

234

235+{-| Extracts a 64-bit `Float` at the given location.

236+-}

156float64 : Deconstructor (Float -> a) a

237float64 : Deconstructor (Float -> a) a

157float64 =

238float64 =

158 Deconstructor

239 Deconstructor

@@ -167,6 +248,8 @@ float64 =

167 )

248 )

168

249

169

250

251+{-| Extracts the raw `Byte`s of an `Atom` at the current location.

252+-}

170bytes : Deconstructor (Bytes -> a) a

253bytes : Deconstructor (Bytes -> a) a

171bytes =

254bytes =

172 Deconstructor

255 Deconstructor

@@ -180,6 +263,8 @@ bytes =

180 )

263 )

181

264

182

265

266+{-| Asserts the the `Atom` at the current position should be exactly `sig` (`~`).

267+-}

183sig : Deconstructor a a

268sig : Deconstructor a a

184sig =

269sig =

185 Deconstructor

270 Deconstructor

@@ -197,6 +282,11 @@ sig =

197 )

282 )

198

283

199

284

285+{-| Extracts a sig-terminated list of arbitrary elements at the current position.

286+

287+The first argument is a `Deconstructor` of the elements of the list.

288+

289+-}

200list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b

290list : Deconstructor (a -> a) a -> Deconstructor (List a -> b) b

201list (Deconstructor f) =

291list (Deconstructor f) =

202 Deconstructor

292 Deconstructor

@@ -227,6 +317,11 @@ alt (Deconstructor f) (Deconstructor g) =

227 )

317 )

228

318

229

319

320+{-| Try to execute all of the `Deconstructor`s in order until one succeeds.

321+

322+This is especially useful for deconstructing head-tagged unions from Hoon.

323+

324+-}

230oneOf : List (Deconstructor a b) -> Deconstructor a b

325oneOf : List (Deconstructor a b) -> Deconstructor a b

231oneOf l =

326oneOf l =

232 case l of

327 case l of

@@ -237,29 +332,31 @@ oneOf l =

237 alt x (oneOf xs)

332 alt x (oneOf xs)

238

333

239

334

335+{-| Extract the raw `Noun` at the current position.

336+

337+Always succeeds.

338+

339+-}

240tar : Deconstructor (Noun -> a) a

340tar : Deconstructor (Noun -> a) a

241tar =

341tar =

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

342 Deconstructor (\noun f -> Just (f noun))

243

343

244

344

345+{-| Ignore any value at the current position.

346+

347+This is useful when you have a value you don't care about. `ignore` allows you to just skip the value.

348+

349+-}

245ignore : Deconstructor a a

350ignore : Deconstructor a a

246ignore =

351ignore =

247 Deconstructor (\_ f -> Just f)

352 Deconstructor (\_ f -> Just f)

248

353

249

354

250−llec : Deconstructor a b -> Deconstructor b c -> Deconstructor a c

355+{-| Extracts a [`Cell`](https://developers.urbit.org/reference/glossary/cell) (pair) of two arbitrary values.

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)

257−

258− Atom _ ->

259− Nothing

260− )

261

356

357+Accepts two arbitrary `Deconstructor`s that form a Cell.

262

358

359+-}

263cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c

360cell : Deconstructor a b -> Deconstructor b c -> Deconstructor a c

264cell (Deconstructor l) (Deconstructor r) =

361cell (Deconstructor l) (Deconstructor r) =

265 Deconstructor

362 Deconstructor

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

273 )

370 )

274

371

275

372

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

374+

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

376+

377+-}

276map : a -> Deconstructor a b -> Deconstructor (b -> c) c

378map : a -> Deconstructor a b -> Deconstructor (b -> c) c

277map a (Deconstructor f) =

379map a (Deconstructor f) =

278 Deconstructor (\noun g -> f noun a |> Maybe.map g)

380 Deconstructor (\noun g -> f noun a |> Maybe.map g)

src/Ur/Jam.elmnew file+193

@@ -0,0 +1,193 @@

1+module Ur.Jam exposing (..)

3+{-|

6+# Encoding and decoding Nouns

8+@docs jam, cue

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/Phonemic.elm+9−12

@@ -1,22 +1,19 @@

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

1+module Ur.Phonemic exposing (fromString)

3+{-|

5+@docs fromString

7+-}

3import BigInt.Bytes

9import BigInt.Bytes

4import Bytes.Extra

10import Bytes.Extra

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

11+import Ur.Types exposing (Atom, Noun(..), Ship)

6import Urbit.Encoding.Atom exposing (toBigInt)

12import Urbit.Encoding.Atom exposing (toBigInt)

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

13import 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.

16+{-| Converts a ship name like `~zod` into an Atom.

20-}

17-}

21fromString : Ship -> Atom

18fromString : Ship -> Atom

22fromString s =

19fromString s =

src/Ur/Requests.elm+6−52

@@ -1,8 +1,6 @@

1module Ur.Requests exposing

2 ( EventId

3 , UrbitRequest(..)

4− , scry

5− , scryTask

6 , send

4 , send

7 , sendTask

5 , sendTask

8 , tag

6 , tag

@@ -13,8 +11,9 @@ import Http

13import Task exposing (Task)

11import Task exposing (Task)

14import Ur exposing (..)

12import Ur exposing (..)

15import Ur.Constructor as C

13import Ur.Constructor as C

16−import Ur.Deconstructor as D

14+import Ur.Jam exposing (jam)

17−import Ur.Phonemic exposing (Ship)

15+import Ur.Phonemic

16+import Ur.Types exposing (..)

18import Ur.Uw

17import Ur.Uw

@@ -68,7 +67,7 @@ sendTask { url, error, success, requests } =

68 requests

67 requests

69 |> List.map (uncurry toNoun)

68 |> List.map (uncurry toNoun)

70 |> C.listOf identity

69 |> C.listOf identity

71− |> Ur.jam

70+ |> jam

72 |> Ur.Uw.encode

71 |> Ur.Uw.encode

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

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

74 , resolver =

73 , resolver =

@@ -89,58 +88,13 @@ type alias EventId =

89 Int

88 Int

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−

137toNoun : EventId -> UrbitRequest -> Noun

91toNoun : EventId -> UrbitRequest -> Noun

138toNoun eventId req =

92toNoun eventId req =

139 case req of

93 case req of

140 Subscribe ( ship, app, path ) ->

94 Subscribe ( ship, app, path ) ->

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

95 C.cell (C.cord "subscribe") <|

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

96 C.cell (C.int eventId) <|

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

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

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

98 C.cell (C.cord app) (C.listOf C.cord path)

145

146 Unsubscribe subId ->

100 Unsubscribe subId ->

@@ -150,7 +104,7 @@ toNoun eventId req =

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

104 Poke { ship, agent, mark, noun } ->

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

105 C.cell (C.cord "poke") <|

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

106 C.cell (C.int eventId) <|

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

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

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

108 C.cell (C.cord agent) <|

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

109 C.cell (C.cord mark) <|

156 noun

110 noun

src/Ur/Run.elm+20−10

@@ -1,11 +1,10 @@

1−module Ur.Run exposing

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

2− ( Model

3− , Msg

3+{-|

4− , Program

5− , application

5+@docs element, document, application, Program, Model, Msg

6− , document

7− , element

7+-}

8− )

10import Browser exposing (Document, UrlRequest)

9import Browser exposing (Document, UrlRequest)

11import Browser.Navigation as Nav

10import Browser.Navigation as Nav

@@ -15,15 +14,14 @@ import Html exposing (Html)

15import Json.Decode as JD

14import Json.Decode as JD

16import Task

15import Task

17import Time

16import Time

18−import Ur exposing (Agent, Path)

19import Ur.Cmd

17import Ur.Cmd

20import Ur.Cmd.Internal

18import Ur.Cmd.Internal

21import Ur.Constructor as C

19import Ur.Constructor as C

22import Ur.Deconstructor as D

20import Ur.Deconstructor as D

23−import Ur.Phonemic exposing (Ship)

24import Ur.Requests exposing (..)

21import Ur.Requests exposing (..)

25import Ur.Sub

22import Ur.Sub

26import Ur.Sub.Internal

23import Ur.Sub.Internal

24+import Ur.Types exposing (..)

27import Ur.Uw

25import Ur.Uw

28import Url exposing (Url)

26import Url exposing (Url)

@@ -41,6 +39,8 @@ type alias Flags =

41 { uid : String }

39 { uid : String }

42+{-| An Urbit wrapper around your application model.

43+-}

44type alias Model app msg =

45 { subscriptions : SubDict msg

46 , subscriptionIntMapping : Dict Int ( String, String, List String )

@@ -52,6 +52,8 @@ type alias Model app msg =

52 }

55+{-| An Urbit wrapper around your application messages.

56+-}

55type Msg msg

57type Msg msg

56 = AppMsg msg

58 = AppMsg msg

57 | EventSourceMsg JD.Value

59 | EventSourceMsg JD.Value

@@ -62,10 +64,14 @@ type Msg msg

62 | RetryRequests

64 | RetryRequests

67+{-| A wrapper around your application `Program`

68+-}

65type alias Program model msg =

69type alias Program model msg =

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

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

73+{-| The same as `Browser.element` but with urbit stuff added around it.

74+-}

69element :

75element :

70 { init : ( model, Ur.Cmd.Cmd msg )

76 { init : ( model, Ur.Cmd.Cmd msg )

71 , view : model -> Html msg

77 , view : model -> Html msg

@@ -86,6 +92,8 @@ element inp =

86 }

92 }

95+{-| The same as `Browser.element` but with urbit stuff added around it.

96+-}

89document :

97document :

90 { init : ( model, Ur.Cmd.Cmd msg )

98 { init : ( model, Ur.Cmd.Cmd msg )

91 , view : model -> Document msg

99 , view : model -> Document msg

@@ -109,6 +117,8 @@ document inp =

109 }

117 }

110

118

111

119

120+{-| The same as `Browser.element` but with urbit stuff added around it.

121+-}

112application :

122application :

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

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

114 , view : model -> Document msg

124 , view : model -> Document msg

src/Ur/Sub.elm+11−1

@@ -1,24 +1,34 @@

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

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

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

5+@docs Sub, subscribe, none, batch

7+-}

3import Dict

9import Dict

4import Ur.Deconstructor as D

10import Ur.Deconstructor as D

5import Ur.Sub.Internal

11import Ur.Sub.Internal

14+{-| -}

8type alias Sub msg =

15type alias Sub msg =

9 Ur.Sub.Internal.Sub msg

16 Ur.Sub.Internal.Sub msg

19+{-| -}

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

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

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

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

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

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

25+{-| -}

17none : Sub msg

26none : Sub msg

18none =

27none =

19 Ur.Sub.Internal.Sub Dict.empty

28 Ur.Sub.Internal.Sub Dict.empty

31+{-| -}

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

32batch : List (Sub msg) -> Sub msg

23batch subs =

33batch subs =

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

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

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

@@ -1,9 +1,8 @@

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

3import Dict exposing (Dict)

4−import Ur exposing (Agent, Path)

5import Ur.Deconstructor as D

4import Ur.Deconstructor as D

6−import Ur.Phonemic exposing (Ship)

5+import Ur.Types exposing (Agent, Path, Ship)

9type Sub msg

8type Sub msg

src/Ur/Types.elmnew file+60

@@ -0,0 +1,60 @@

1+module Ur.Types exposing

2+ ( Noun(..), Atom

3+ , Agent, Mark, Path, Ship

4+ )

6+{-|

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

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

1module Ur.Uw exposing (decode, encode)

3+{-| This module works with Urbit base-64 encoded strings.

5+@docs decode, encode

7+-}

3import BitParser as BP

9import BitParser as BP

4import BitWriter as BW

10import BitWriter as BW

5import Bitwise

11import Bitwise

@@ -9,6 +15,7 @@ import Dict

9import List.Extra

15import List.Extra

18+{-| -}

12decode : String -> Bytes

19decode : String -> Bytes

13decode string =

20decode string =

14 if string == "0w0" then

21 if string == "0w0" then

@@ -42,6 +49,7 @@ decode string =

42 BW.run (go chars BW.empty)

49 BW.run (go chars BW.empty)

52+{-| -}

45encode : Bytes -> String

53encode : Bytes -> String

46encode bytes =

54encode bytes =

47 let

55 let