@@ -1,510 +0,0 @@
1−module Ur.Run exposing (element, document, application, Program, Model, Msg)
3−{-| This module contains functions to run your application with Urbit integration.
5−@docs element, document, application, Program, Model, Msg
9−import Browser exposing (Document, UrlRequest)
10−import Browser.Navigation as Nav
11−import Dict exposing (Dict)
12−import Either exposing (Either(..))
13−import Html exposing (Html)
14−import Json.Decode as JD
18−import Ur.Cmd.Internal
19−import Ur.Constructor as C
20−import Ur.Deconstructor as D
21−import Ur.NounDiff exposing (Patch, deconstructPatch)
22−import Ur.Requests exposing (..)
24−import Ur.Sub.Internal
25−import Ur.Types exposing (..)
27−import Url exposing (Url)
30−type alias SubDict msg =
32− -- (ship, agent, path)
33− ( String, String, List String )
34− { deconstructor : D.Deconstructor msg
44−{-| An Urbit wrapper around your application model.
46−type alias Model app msg =
47− { subscriptions : SubDict msg
48− , subscriptionIntMapping : Dict Int ( String, String, List String )
53− , requestsToRetry : List UrbitRequest
54− , sinks : Dict Int Noun
58−{-| An Urbit wrapper around your application messages.
62− | EventSourceMsg JD.Value
63− | FailedRequest (List UrbitRequest)
70−{-| A wrapper around your application `Program`.
72−type alias Program model msg =
73− Platform.Program Flags (Model model msg) (Msg msg)
76−{-| The same as `Browser.element` but with urbit stuff added around it.
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
91− { init = init inp inp.init
92− , view = \model -> inp.view model.app |> Html.map AppMsg
93− , update = update inp
94− , subscriptions = subscriptions inp
98−{-| The same as `Browser.element` but with urbit stuff added around it.
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
110− -> Program model msg
113− { init = init inp inp.init
117− |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })
118− , update = update inp
119− , subscriptions = subscriptions inp
123−{-| The same as `Browser.element` but with urbit stuff added around it.
126− { init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
127− , view : model -> Document msg
128− , update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
129− , subscriptions : model -> Sub msg
130− , urbitSubscriptions : model -> Ur.Sub.Sub msg
131− , onUrlRequest : UrlRequest -> msg
132− , onUrlChange : Url -> msg
133− , createEventSource : String -> Cmd (Msg msg)
134− , onEventSourceMsg : (JD.Value -> Msg msg) -> Sub (Msg msg)
135− , urbitUrl : model -> String
137− -> Program model msg
140− { view, onUrlRequest, onUrlChange } =
144− { init = \flags url key -> init inp (inp.init url key) flags
148− |> (\{ body, title } -> { title = title, body = body |> List.map (Html.map AppMsg) })
149− , update = update inp
150− , subscriptions = subscriptions inp
151− , onUrlRequest = \req -> onUrlRequest req |> AppMsg
152− , onUrlChange = \url -> onUrlChange url |> AppMsg
158− | update : msg -> app -> ( app, Ur.Cmd.Cmd msg )
159− , createEventSource : String -> Cmd (Msg msg)
160− , urbitUrl : app -> String
161− , urbitSubscriptions : app -> Ur.Sub.Sub msg
165− -> ( Model app msg, Cmd (Msg msg) )
166−update inp msg model =
169− inp.urbitUrl model.app ++ "/~/channel/" ++ model.flags.uid
174− ( appModel, appCmds ) =
175− inp.update msg_ model.app
181− (inp.urbitSubscriptions appModel |> (\(Ur.Sub.Internal.Sub x) -> x))
183− ( eventId_, cmds, urReqs ) =
184− processCmd subsResult.eventId appCmds
188− , eventId = eventId_
189− , subscriptions = subsResult.subscriptions
190− , subscriptionIntMapping = model.subscriptionIntMapping |> Dict.union subsResult.subscriptionIntMapping
201− { requests = subsResult.subscriptionRequests
203− , error = subsResult.subscriptionRequests |> List.map (\( _, x ) -> x) |> FailedRequest
209− EventSourceMsg value ->
210− case JD.decodeValue (JD.field "message" JD.string) value of
214− (D.cell D.int (D.cell D.cord D.tar))
215− (Ur.Uw.decode string)
217− Just ( messageId, ( messageType, rest ) ) ->
219− ( eventId, ackReqs ) =
220− tag model.eventId [ Ack messageId ]
224− { requests = ackReqs
227− , error = ackReqs |> List.map (\( _, x ) -> x) |> FailedRequest
231− { model | eventId = eventId }
235− -- Not sure what to do. Assume things are fine.
239− -- Not sure what to do.
244− Dict.get messageId model.subscriptionIntMapping
245− |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
247− Just { deconstructor, sink } ->
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
254− pureCmd (AppMsg subMsg)
261− Just (Drain patch) ->
262− case Dict.get messageId model.sinks of
266− Ur.NounDiff.apply patch oldNoun
268− ( { model | sinks = Dict.insert messageId newNoun model.sinks }
269− , case D.run deconstructor newNoun of
271− pureCmd (AppMsg subMsg)
285− case D.run (D.cell D.ignore (D.cell D.ignore deconstructor) |> D.map (\( (), ( (), m ) ) -> m)) rest of
287− ( model_, pureCmd (AppMsg subMsg) )
293− -- Got a fact for a subscription we do not hold
300− -- got something we don't expect
305− case JD.decodeValue (JD.field "error" JD.value) value of
307− ( { model | connected = False }, Cmd.none )
316− [ Poke { ship = "", agent = "hood", mark = "helm-hi", noun = C.cord "Opening airlock!" } ]
317− |> tag model.eventId
319− ( { model | eventId = eventId }
320− , send { url = url, requests = reqs, success = OpenConnection, error = Noop }
326− FailedRequest reqs ->
327− ( { model | requestsToRetry = reqs ++ model.requestsToRetry }, Cmd.none )
330− ( { model | connected = True }, inp.createEventSource url )
335− model.requestsToRetry |> tag model.eventId
337− ( { model | eventId = eventId, requestsToRetry = [] }
340− , error = FailedRequest model.requestsToRetry
352−deconstructSink : D.Deconstructor Sink
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)
360−processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
361−processCmd eventId urCmds =
368− Ur.Cmd.Internal.Cmd cmd ->
369− cmd |> Cmd.map AppMsg |> Left
371− Ur.Cmd.Internal.Poke p ->
372− Ur.Requests.Poke p |> Right
376− ( newEventId, urReqs ) =
379− ( newEventId, Cmd.batch cmds, urReqs )
382−pureCmd : msg -> Cmd msg
384− Task.succeed msg |> Task.perform identity
389− -> Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
390− -> Dict ( Ship, Agent, Path ) { deconstructor : d, sink : Bool }
392− { subscriptions : Dict ( Ship, Agent, Path ) { deconstructor : d, number : EventId, sink : Bool }
394− , subscriptionRequests : List ( EventId, UrbitRequest )
395− , subscriptionIntMapping : Dict EventId ( Ship, Agent, Path )
397−processUrSubs eventId existingSubscriptions urbitSubs_ =
401− |> Dict.map (\_ { deconstructor, sink } -> { deconstructor = deconstructor, sink = sink })
403− ( eventId_, newSubscriptionActions ) =
404− Dict.diff urbitSubs existingSubscriptions
406− |> List.map (\( address, _ ) -> ( Subscribe address, address ))
409− removedSubscriptions =
410− Dict.diff existingSubscriptions urbitSubs
412− ( eventId__, removedSubscriptionActions ) =
413− removedSubscriptions
415− |> List.map (\( _, { number } ) -> Unsubscribe number)
419− newSubscriptionActions |> List.map (\( a, ( _, b ) ) -> ( b, a )) |> Dict.fromList
424− (\key number { deconstructor, sink } ->
426− { deconstructor = deconstructor
436− { subscriptions = Dict.diff existingSubscriptions removedSubscriptions |> Dict.union newSubscriptions
437− , subscriptionIntMapping =
440− |> List.map (\( key, { number } ) -> ( number, key ))
442− , eventId = eventId__
443− , subscriptionRequests =
444− removedSubscriptionActions ++ (newSubscriptionActions |> List.map (\( id, ( req, _ ) ) -> ( id, req )))
449− { a | urbitSubscriptions : model -> Ur.Sub.Sub msg, urbitUrl : model -> String }
450− -> ( model, Ur.Cmd.Cmd msg )
456−init inp ( app, appCmds ) flags =
462− (inp.urbitSubscriptions app |> (\(Ur.Sub.Internal.Sub x) -> x))
464− ( eventId_, cmds, urReqs ) =
465− processCmd subsResult.eventId appCmds
468− inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
470− ( { subscriptions = subsResult.subscriptions
471− , sinks = Dict.empty
472− , subscriptionIntMapping = subsResult.subscriptionIntMapping
475− , eventId = eventId_
477− , requestsToRetry = []
480− , pureCmd NeedsActivation
482− { requests = urReqs ++ subsResult.subscriptionRequests
493− { a | subscriptions : b -> Sub msg, onEventSourceMsg : (JD.Value -> Msg c) -> Sub (Msg msg) }
494− -> { d | app : b, requestsToRetry : List e, connected : Bool }
496−subscriptions inp model =
498− [ inp.subscriptions model.app |> Sub.map AppMsg
499− , inp.onEventSourceMsg EventSourceMsg
500− , if List.isEmpty model.requestsToRetry then
504− Time.every 1000 (always RetryRequests)
505− , if not model.connected then
506− Time.every 10000 (always NeedsActivation)