Created
September 20, 2019 09:51
-
-
Save FrankelJb/0428391c71eb7cb67df417fb879ab908 to your computer and use it in GitHub Desktop.
[Elm EventSource] Handling ports across a SPA #Elm #ElmSPA
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
type Msg | |
= ErrorMsg String | |
| EventSourceConnect ConnectionInfo | |
| EventSourceClosed ConnectionInfo | |
| PopulateEventHandler ConnectionInfo Video | |
| UserEventHandler ConnectionInfo Int | |
| NoOp | |
update : Msg -> ( Event, Cmd Msg ) | |
update msg = | |
case Debug.log "EventSourceMsg" msg of | |
ErrorMsg error -> | |
( Error <| ConnectionInfo error, Cmd.none ) | |
EventSourceConnect info -> | |
( Connected info, Cmd.none ) | |
EventSourceClosed info -> | |
( Closed info, Cmd.none ) | |
PopulateEventHandler event video -> | |
( PopulateEvent event video | |
, Cmd.none | |
) | |
UserEventHandler info userId -> | |
( UserEvent info userId | |
, Cmd.none | |
) | |
NoOp -> | |
( Unopened, Cmd.none ) | |
-- Subscriptions, events and ports below. |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
type Msg | |
= PopulateVideos | |
| PopulateVideosResult (Result Http.Error ()) | |
| StreamEventHandler EventSource.ConnectionInfo Int | |
| VideosResponse (WebData (List Video)) | |
| UpdatePath String | |
update : Msg -> Model -> ( Model, Cmd Msg ) | |
update msg model = | |
case msg of | |
PopulateVideos -> | |
( model, populateVideos model ) | |
PopulateVideosResult _ -> | |
( model, Cmd.none ) | |
StreamEventHandler _ _ -> | |
( model, Cmd.none ) | |
VideosResponse response -> | |
let | |
successVideos = | |
case response of | |
RemoteData.Success remoteVideos -> | |
Just remoteVideos | |
_ -> | |
Nothing | |
in | |
( { model | |
| videos = response | |
, session = Session.addVideos successVideos model.session | |
} | |
, Cmd.none | |
) | |
UpdatePath newPath -> | |
( { model | path = newPath }, Cmd.none ) | |
getVideos : Int -> Cmd Msg | |
getVideos userId = | |
Http.get | |
{ url = | |
Url.relative [ "api", "video", "list", String.fromInt userId ] | |
[] | |
, expect = Http.expectJson (RemoteData.fromResult >> VideosResponse) decodeVideoList | |
} | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
type Model | |
= Redirect Session.Data | |
| NotFound Session.Data | |
| Home Home.Model | |
| Video Video.Model | |
| EventSource Session.Data | |
type Msg | |
= LinkClicked Browser.UrlRequest | |
| UrlChanged Url.Url | |
| HomeMsg Home.Msg | |
| VideoMsg Video.Msg | |
| EventSourceMsg EventSource.Msg | |
update : Msg -> Model -> ( Model, Cmd Msg ) | |
update msg model = | |
case ( msg, model ) of | |
( LinkClicked urlRequest, _ ) -> | |
case urlRequest of | |
Browser.Internal url -> | |
( model, Nav.pushUrl (Session.navKey (toSession model)) (Url.toString url) ) | |
Browser.External href -> | |
( model, Nav.load href ) | |
( UrlChanged url, _ ) -> | |
changeRouteTo url model | |
( HomeMsg subMsg, Home home ) -> | |
Home.update subMsg home | |
|> updateWith Home HomeMsg model | |
( VideoMsg subMsg, Video video ) -> | |
Video.update subMsg video | |
|> updateWith Video VideoMsg model | |
( EventSourceMsg subMsg, _ ) -> | |
stepEvent model (EventSource.update subMsg) | |
( _, _ ) -> | |
-- Disregard messages that arrived for the wrong page. | |
( model, Cmd.none ) | |
updateWith : (subModel -> Model) -> (subMsg -> Msg) -> Model -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg ) | |
updateWith toModel toMsg _ ( subModel, subCmd ) = | |
( toModel subModel | |
, Cmd.map toMsg subCmd | |
) | |
stepEvent : Model -> ( EventSource.Event, Cmd EventSource.Msg ) -> ( Model, Cmd Msg ) | |
stepEvent model ( event, cmds ) = | |
case ( event, model ) of | |
( UserEvent _ id, Home home ) -> | |
( Home { home | session = Session.addEventAndUserId event (Just id) <| toSession model } | |
, Cmd.batch | |
[ Cmd.map EventSourceMsg cmds | |
, Cmd.map HomeMsg <| Home.getVideos id | |
] | |
) | |
( PopulateEvent _ video, Home home ) -> | |
( Home { home | session = Session.addEvent event <| toSession model } | |
, Cmd.batch | |
[ Cmd.map EventSourceMsg cmds | |
, Cmd.map HomeMsg <| Home.getVideos id | |
] | |
) | |
_ -> | |
( model, Cmd.none ) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment