@@ -1,28 +1,22 @@
1−module Ur.Run exposing (element, document, application, Program, Model, Msg)
2−
3−{-| This module contains functions to run your application with Urbit integration.
4−
5−@docs element, document, application, Program, Model, Msg
6−
7−-}
1+module Ur.Run exposing (Model, Msg, Program, application)
82
93import Browser exposing (Document, UrlRequest)
104import Browser.Navigation as Nav
115import Dict exposing (Dict)
126import Either exposing (Either(..))
13−import Html exposing (Html)
7+import Html
148import Json.Decode as JD
159import Task
1610import Time
11+import Ur exposing (Agent, Path)
1712import Ur.Cmd
1813import Ur.Cmd.Internal
1914import Ur.Constructor as C
2015import Ur.Deconstructor as D
21−import Ur.NounDiff exposing (Patch, deconstructPatch)
16+import Ur.Phonemic exposing (Ship)
2217import Ur.Requests exposing (..)
2318import Ur.Sub
2419import Ur.Sub.Internal
25−import Ur.Types exposing (..)
2620import Ur.Uw
2721import Url exposing (Url)
2822
@@ -31,9 +25,8 @@ type alias SubDict msg =
3125 Dict
3226 -- (ship, agent, path)
3327 ( String, String, List String )
34− { deconstructor : D.Deconstructor msg
28+ { deconstructor : D.Deconstructor (msg -> msg) msg
3529 , number : Int
36− , sink : Bool
3730 }
3831
3932
@@ -41,8 +34,6 @@ type alias Flags =
4134 { uid : String }
4235
4336
44−{-| An Urbit wrapper around your application model.
45−-}
4637type alias Model app msg =
4738 { subscriptions : SubDict msg
4839 , subscriptionIntMapping : Dict Int ( String, String, List String )
@@ -51,12 +42,9 @@ type alias Model app msg =
5142 , eventId : Int
5243 , flags : Flags
5344 , requestsToRetry : List UrbitRequest
54− , sinks : Dict Int Noun
5545 }
5646
5747
58−{-| An Urbit wrapper around your application messages.
59−-}
6048type Msg msg
6149 = AppMsg msg
6250 | EventSourceMsg JD.Value
@@ -67,61 +55,10 @@ type Msg msg
6755 | RetryRequests
6856
6957
70−{-| A wrapper around your application `Program`.
71−-}
7258type alias Program model msg =
7359 Platform.Program Flags (Model model msg) (Msg msg)
7460
7561
76−{-| The same as `Browser.element` but with urbit stuff added around it.
77−-}
78−element :
79− { init : ( model, Ur.Cmd.Cmd msg )
80− , view : model -> Html msg
81− , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
82− , subscriptions : model -> Sub msg
83− , urbitSubscriptions : model -> Ur.Sub.Sub msg
84− , createEventSource : String -> Cmd (Msg msg)
85− , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
86− , urbitUrl : model -> String
87− }
88− -> Program model msg
89−element inp =
90− Browser.element
91− { init = init inp inp.init
92− , view = \model -> inp.view model.app |> Html.map AppMsg
93− , update = update inp
94− , subscriptions = subscriptions inp
95− }
96−
97−
98−{-| The same as `Browser.element` but with urbit stuff added around it.
99−-}
100−document :
101− { init : ( model, Ur.Cmd.Cmd msg )
102− , view : model -> Document msg
103− , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
104− , subscriptions : model -> Sub msg
105− , urbitSubscriptions : model -> Ur.Sub.Sub msg
106− , createEventSource : String -> Cmd (Msg msg)
107− , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
108− , urbitUrl : model -> String
109− }
110− -> Program model msg
111−document inp =
112− Browser.document
113− { init = init inp inp.init
114− , view =
115− \model ->
116− inp.view model.app
117− |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })
118− , update = update inp
119− , subscriptions = subscriptions inp
120− }
121−
122−
123−{-| The same as `Browser.element` but with urbit stuff added around it.
124−-}
12562application :
12663 { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
12764 , view : model -> Document msg
@@ -174,11 +111,12 @@ update inp msg model =
174111 ( appModel, appCmds ) =
175112 inp.update msg_ model.app
176113
114+ -- { subscriptions, eventId, subscriptionRequests, subscriptionIntMapping } =
177115 subsResult =
178116 processUrSubs
179117 model.eventId
180118 model.subscriptions
181− (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))
119+ (inp.urbitSubscriptions model.app |> (\(Ur.Sub.Internal.Sub x) -> x))
182120
183121 ( eventId_, cmds, urReqs ) =
184122 processCmd subsResult.eventId appCmds
@@ -211,10 +149,12 @@ update inp msg model =
211149 Ok string ->
212150 case
213151 D.runBytes
214− (D.cell D.int (D.cell D.cord D.tar))
152+ (D.cell D.int (D.cell D.cord D.tar)
153+ |> D.map (\a b c -> ( a, b, c ))
154+ )
215155 (Ur.Uw.decode string)
216156 of
217− Just ( messageId, ( messageType, rest ) ) ->
157+ Just ( messageId, messageType, rest ) ->
218158 let
219159 ( eventId, ackReqs ) =
220160 tag model.eventId [ Ack messageId ]
@@ -244,51 +184,14 @@ update inp msg model =
244184 Dict.get messageId model.subscriptionIntMapping
245185 |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
246186 of
247− Just { deconstructor, sink } ->
248− if sink then
249− case D.run (D.cell D.ignore (D.cell D.ignore deconstructSink) |> D.map (\( (), ( (), s ) ) -> s)) rest of
250− Just (Flush noun) ->
251− ( { model | sinks = Dict.insert messageId noun model.sinks }
252− , case D.run deconstructor noun of
253− Just subMsg ->
254− pureCmd (AppMsg subMsg)
255−
256− -- Got garbage
257− Nothing ->
258− Cmd.none
259− )
260−
261− Just (Drain patch) ->
262− case Dict.get messageId model.sinks of
263− Just oldNoun ->
264− let
265− newNoun =
266− Ur.NounDiff.apply patch oldNoun
267− in
268− ( { model | sinks = Dict.insert messageId newNoun model.sinks }
269− , case D.run deconstructor newNoun of
270− Just subMsg ->
271− pureCmd (AppMsg subMsg)
272−
273− Nothing ->
274− Cmd.none
275− )
276−
277− Nothing ->
278− ( model, Cmd.none )
279−
280− -- Got garbage
281− Nothing ->
282− ( model, Cmd.none )
283−
284− else
285− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor) |> D.map (\( (), ( (), m ) ) -> m)) rest of
286− Just subMsg ->
287− ( model_, pureCmd (AppMsg subMsg) )
288−
289− -- Got gargbage
290− Nothing ->
291− ( model_, ackCmd )
187+ Just { deconstructor } ->
188+ case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
189+ Just subMsg ->
190+ ( model_, pureCmd (AppMsg subMsg) )
191+
192+ -- Got gargbage
193+ Nothing ->
194+ ( model_, ackCmd )
292195
293196 -- Got a fact for a subscription we do not hold
294197 Nothing ->
@@ -313,11 +216,11 @@ update inp msg model =
313216 NeedsActivation ->
314217 let
315218 ( eventId, reqs ) =
316− [ Poke { ship = "", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
219+ [ Poke { ship = "~zod", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
317220 |> tag model.eventId
318221 in
319222 ( { model | eventId = eventId }
320− , send { url = url, requests = reqs, success = OpenConnection, error = Noop }
223+ , send { url = url, requests = reqs, success = OpenConnection, error = NeedsActivation }
321224 )
322225
323226 Noop ->
@@ -344,19 +247,6 @@ update inp msg model =
344247 )
345248
346249
347−type Sink
348− = Flush Noun
349− | Drain Patch
350−
351−
352−deconstructSink : D.Deconstructor Sink
353−deconstructSink =
354− D.oneOf
355− [ D.cell (D.const D.cord "flush") D.tar |> D.map (\( (), n ) -> Flush n)
356− , D.cell (D.const D.cord "drain") (D.lazy deconstructPatch) |> D.map (\( (), patch ) -> Drain patch)
357− ]
358−
359−
360250processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
361251processCmd eventId urCmds =
362252 let
@@ -386,10 +276,10 @@ pureCmd msg =
386276
387277processUrSubs :
388278 EventId
389− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
390− -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }
279+ -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
280+ -> Dict ( Ship, Agent, Path ) d
391281 ->
392− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
282+ { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId }
393283 , eventId : EventId
394284 , subscriptionRequests : List ( EventId, UrbitRequest )
395285 , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
@@ -398,7 +288,7 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
398288 let
399289 urbitSubs =
400290 urbitSubs_
401− |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })
291+ |> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })
402292
403293 ( eventId_, newSubscriptionActions ) =
404294 Dict.diff urbitSubs existingSubscriptions
@@ -421,11 +311,10 @@ processUrSubs eventId existingSubscriptions urbitSubs_ =
421311 newSubscriptions =
422312 Dict.merge
423313 (\_ _ x -> x)
424− (\key number { deconstructor, sink } ->
314+ (\key number { deconstructor } ->
425315 Dict.insert key
426316 { deconstructor = deconstructor
427317 , number = number
428− , sink = sink
429318 }
430319 )
431320 (\_ _ x -> x)
@@ -468,7 +357,6 @@ init inp ( app, appCmds ) flags =
468357 inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
469358 in
470359 ( { subscriptions = subsResult.subscriptions
471− , sinks = Dict.empty
472360 , subscriptionIntMapping = subsResult.subscriptionIntMapping
473361 , app = app
474362 , connected = False
@@ -491,7 +379,7 @@ init inp ( app, appCmds ) flags =
491379
492380subscriptions :
493381 { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
494− -> { d | app : b, requestsToRetry : List e, connected : Bool }
382+ -> { d | app : b, requestsToRetry : List e }
495383 -> Sub (Msg msg)
496384subscriptions inp model =
497385 Sub.batch
@@ -502,9 +390,4 @@ subscriptions inp model =
502390
503391 else
504392 Time.every 1000 (always RetryRequests)
505− , if not model.connected then
506− Time.every 10000 (always NeedsActivation)
507−
508− else
509− Sub.none
510393 ]