From 7c213cd89707de885603050b77155e37bf090b8e Mon Sep 17 00:00:00 2001 From: James Hillyerd Date: Mon, 24 Dec 2018 12:06:35 -0800 Subject: [PATCH] ui: Embed Session into page models --- ui/src/Data/Session.elm | 78 +++++++++++++++++-------------- ui/src/Main.elm | 101 +++++++++++++++++++++++++++++++--------- ui/src/Page/Home.elm | 17 ++++--- ui/src/Page/Mailbox.elm | 68 ++++++++++++++++++++------- ui/src/Page/Monitor.elm | 25 ++++++---- ui/src/Page/Status.elm | 20 +++++--- 6 files changed, 214 insertions(+), 95 deletions(-) diff --git a/ui/src/Data/Session.elm b/ui/src/Data/Session.elm index 4d4861c..825ffe6 100644 --- a/ui/src/Data/Session.elm +++ b/ui/src/Data/Session.elm @@ -3,10 +3,15 @@ module Data.Session exposing , Msg(..) , Persistent , Session + , addRecent + , clearFlash , decodeValueWithDefault , decoder + , disableRouting + , enableRouting , init , none + , showFlash , update ) @@ -43,11 +48,6 @@ type alias Persistent = type Msg = None - | SetFlash Flash - | ClearFlash - | DisableRouting - | EnableRouting - | AddRecent String init : Nav.Key -> Url -> Persistent -> Session @@ -68,35 +68,6 @@ update msg session = case msg of None -> session - - SetFlash flash -> - { session | flash = Just flash } - - ClearFlash -> - { session | flash = Nothing } - - DisableRouting -> - { session | routing = False } - - EnableRouting -> - { session | routing = True } - - AddRecent mailbox -> - if List.head session.persistent.recentMailboxes == Just mailbox then - session - - else - let - recent = - session.persistent.recentMailboxes - |> List.filter ((/=) mailbox) - |> List.take 7 - |> (::) mailbox - - persistent = - session.persistent - in - { session | persistent = { persistent | recentMailboxes = recent } } in if session.persistent == newSession.persistent then -- No change @@ -113,6 +84,45 @@ none = None +addRecent : String -> Session -> Session +addRecent mailbox session = + if List.head session.persistent.recentMailboxes == Just mailbox then + session + + else + let + recent = + session.persistent.recentMailboxes + |> List.filter ((/=) mailbox) + |> List.take 7 + |> (::) mailbox + + persistent = + session.persistent + in + { session | persistent = { persistent | recentMailboxes = recent } } + + +disableRouting : Session -> Session +disableRouting session = + { session | routing = False } + + +enableRouting : Session -> Session +enableRouting session = + { session | routing = True } + + +clearFlash : Session -> Session +clearFlash session = + { session | flash = Nothing } + + +showFlash : Flash -> Session -> Session +showFlash flash session = + { session | flash = Just flash } + + decoder : D.Decoder Persistent decoder = D.succeed Persistent diff --git a/ui/src/Main.elm b/ui/src/Main.elm index 2dd4444..85bb465 100644 --- a/ui/src/Main.elm +++ b/ui/src/Main.elm @@ -42,7 +42,7 @@ init sessionValue location key = Session.init key location (Session.decodeValueWithDefault sessionValue) ( subModel, _, _ ) = - Home.init + Home.init session initModel = { page = Home subModel @@ -64,6 +64,7 @@ type Msg | LinkClicked UrlRequest | SessionUpdated (Result D.Error Session.Persistent) | TimeZoneLoaded Time.Zone + | ClearFlash | OnMailboxNameInput String | ViewMailbox String | SessionMsg Session.Msg @@ -123,9 +124,9 @@ update msg model = ( model, Cmd.none, Session.none ) _ -> - ( model + ( applySessionUpdate Session.clearFlash model , Nav.pushUrl model.session.key (Url.toString url) - , Session.ClearFlash + , Session.none ) Browser.External url -> @@ -138,7 +139,16 @@ update msg model = else -- Skip once, but re-enable routing. - ( model, Cmd.none, Session.EnableRouting ) + ( applySessionUpdate Session.enableRouting model + , Cmd.none + , Session.none + ) + + ClearFlash -> + ( applySessionUpdate Session.clearFlash model + , Cmd.none + , Session.none + ) SessionMsg sessionMsg -> ( model, Cmd.none, sessionMsg ) @@ -154,12 +164,15 @@ update msg model = ) SessionUpdated (Err error) -> - ( model + let + flash = + { title = "Error decoding session" + , table = [ ( "Error", D.errorToString error ) ] + } + in + ( { model | session = Session.showFlash flash model.session } , Cmd.none - , Session.SetFlash - { title = "Error decoding session" - , table = [ ( "Error", D.errorToString error ) ] - } + , Session.none ) TimeZoneLoaded zone -> @@ -176,9 +189,9 @@ update msg model = ( { model | mailboxName = name }, Cmd.none, Session.none ) ViewMailbox name -> - ( { model | mailboxName = "" } + ( applySessionUpdate Session.clearFlash { model | mailboxName = "" } , Route.pushUrl model.session.key (Route.Mailbox name) - , Session.ClearFlash + , Session.none ) _ -> @@ -214,35 +227,41 @@ updatePage msg model = changeRouteTo : Route -> Model -> ( Model, Cmd Msg, Session.Msg ) changeRouteTo route model = let + session = + getSession model + ( newModel, newCmd, newSession ) = case route of Route.Unknown path -> - ( model + let + flash = + { title = "Unknown route requested" + , table = [ ( "Path", path ) ] + } + in + ( { model | session = Session.showFlash flash model.session } , Cmd.none - , Session.SetFlash - { title = "Unknown route requested" - , table = [ ( "Path", path ) ] - } + , Session.none ) Route.Home -> - Home.init + Home.init session |> updateWith Home HomeMsg model Route.Mailbox name -> - Mailbox.init name Nothing + Mailbox.init session name Nothing |> updateWith Mailbox MailboxMsg model Route.Message mailbox id -> - Mailbox.init mailbox (Just id) + Mailbox.init session mailbox (Just id) |> updateWith Mailbox MailboxMsg model Route.Monitor -> - Monitor.init + Monitor.init session |> updateWith Monitor MonitorMsg model Route.Status -> - Status.init + Status.init session |> updateWith Status StatusMsg model in case model.page of @@ -254,11 +273,47 @@ changeRouteTo route model = ( newModel, newCmd, newSession ) +getSession : Model -> Session +getSession model = + case model.page of + Home subModel -> + subModel.session + + Mailbox subModel -> + subModel.session + + Monitor subModel -> + subModel.session + + Status subModel -> + subModel.session + + +applySessionUpdate : (Session -> Session) -> Model -> Model +applySessionUpdate f model = + let + session = + f (getSession model) + in + case model.page of + Home subModel -> + { model | page = Home { subModel | session = session } } + + Mailbox subModel -> + { model | page = Mailbox { subModel | session = session } } + + Monitor subModel -> + { model | page = Monitor { subModel | session = session } } + + Status subModel -> + { model | page = Status { subModel | session = session } } + + updateSession : ( Model, Cmd Msg, Session.Msg ) -> ( Model, Cmd Msg ) updateSession ( model, cmd, sessionMsg ) = let ( session, newCmd ) = - Session.update sessionMsg model.session + Session.update sessionMsg (getSession model) in ( { model | session = session } , Cmd.batch [ newCmd, cmd ] @@ -301,7 +356,7 @@ view model = , mailboxValue = model.mailboxName , recentOptions = model.session.persistent.recentMailboxes , recentActive = mailbox - , clearFlash = SessionMsg Session.ClearFlash + , clearFlash = ClearFlash } framePage : diff --git a/ui/src/Page/Home.elm b/ui/src/Page/Home.elm index 6059476..f4c3a96 100644 --- a/ui/src/Page/Home.elm +++ b/ui/src/Page/Home.elm @@ -15,12 +15,14 @@ import Ports type alias Model = - { greeting : String } + { session : Session + , greeting : String + } -init : ( Model, Cmd Msg, Session.Msg ) -init = - ( Model "", Api.getGreeting GreetingLoaded, Session.none ) +init : Session -> ( Model, Cmd Msg, Session.Msg ) +init session = + ( Model session "", Api.getGreeting GreetingLoaded, Session.none ) @@ -35,10 +37,13 @@ update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of GreetingLoaded (Ok greeting) -> - ( Model greeting, Cmd.none, Session.none ) + ( { model | greeting = greeting }, Cmd.none, Session.none ) GreetingLoaded (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) diff --git a/ui/src/Page/Mailbox.elm b/ui/src/Page/Mailbox.elm index 49bec0d..dc3abe7 100644 --- a/ui/src/Page/Mailbox.elm +++ b/ui/src/Page/Mailbox.elm @@ -71,7 +71,8 @@ type alias VisibleMessage = type alias Model = - { mailboxName : String + { session : Session + , mailboxName : String , state : State , bodyMode : Body , searchInput : String @@ -80,9 +81,16 @@ type alias Model = } -init : String -> Maybe MessageID -> ( Model, Cmd Msg, Session.Msg ) -init mailboxName selection = - ( Model mailboxName (LoadingList selection) SafeHtmlBody "" False (Time.millisToPosix 0) +init : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg, Session.Msg ) +init session mailboxName selection = + ( { session = session + , mailboxName = mailboxName + , state = LoadingList selection + , bodyMode = SafeHtmlBody + , searchInput = "" + , promptPurge = False + , now = Time.millisToPosix 0 + } , load mailboxName , Session.none ) @@ -148,13 +156,13 @@ update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of ClickMessage id -> - ( updateSelected model id + ( updateSelected { model | session = Session.disableRouting model.session } id , Cmd.batch [ -- Update browser location. Route.replaceUrl session.key (Route.Message model.mailboxName id) , Api.getMessage MessageLoaded model.mailboxName id ] - , Session.DisableRouting + , Session.none ) OpenMessage id -> @@ -167,7 +175,10 @@ update session msg model = ( model, Cmd.none, Session.none ) DeletedMessage (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) ListLoaded (Ok headers) -> case model.state of @@ -183,25 +194,39 @@ update session msg model = updateOpenMessage session newModel id Nothing -> - ( newModel, Cmd.none, Session.AddRecent model.mailboxName ) + ( { model + | session = Session.addRecent model.mailboxName model.session + } + , Cmd.none + , Session.none + ) _ -> ( model, Cmd.none, Session.none ) ListLoaded (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) MarkedSeen (Ok _) -> ( model, Cmd.none, Session.none ) MarkedSeen (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) MessageLoaded (Ok message) -> updateMessageResult model message MessageLoaded (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) MessageBody bodyMode -> ( { model | bodyMode = bodyMode }, Cmd.none, Session.none ) @@ -250,7 +275,10 @@ update session msg model = ( model, Cmd.none, Session.none ) PurgedMailbox (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) MarkSeenTick now -> case model.state of @@ -315,10 +343,11 @@ updatePurge session model = ShowingList list _ -> ( { model | promptPurge = False + , session = Session.disableRouting model.session , state = ShowingList (MessageList [] Nothing "") NoMessage } , cmd - , Session.DisableRouting + , Session.none ) _ -> @@ -386,14 +415,15 @@ updateDeleteMessage session model message = case model.state of ShowingList list _ -> ( { model - | state = + | session = Session.disableRouting model.session + , state = ShowingList (filter (\x -> x.id /= message.id) list) NoMessage } , Cmd.batch [ Api.deleteMessage DeletedMessage message.mailbox message.id , Route.replaceUrl session.key (Route.Mailbox model.mailboxName) ] - , Session.DisableRouting + , Session.none ) _ -> @@ -435,9 +465,13 @@ updateMarkMessageSeen model message = updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg, Session.Msg ) updateOpenMessage session model id = - ( updateSelected model id + let + newModel = + { model | session = Session.addRecent model.mailboxName model.session } + in + ( updateSelected newModel id , Api.getMessage MessageLoaded model.mailboxName id - , Session.AddRecent model.mailboxName + , Session.none ) diff --git a/ui/src/Page/Monitor.elm b/ui/src/Page/Monitor.elm index 83aaeef..4af251a 100644 --- a/ui/src/Page/Monitor.elm +++ b/ui/src/Page/Monitor.elm @@ -17,7 +17,8 @@ import Time exposing (Posix) type alias Model = - { connected : Bool + { session : Session + , connected : Bool , messages : List MessageHeader } @@ -27,9 +28,12 @@ type MonitorMessage | Message MessageHeader -init : ( Model, Cmd Msg, Session.Msg ) -init = - ( Model False [], Ports.monitorCommand True, Session.none ) +init : Session -> ( Model, Cmd Msg, Session.Msg ) +init session = + ( Model session False [] + , Ports.monitorCommand True + , Session.none + ) @@ -69,12 +73,15 @@ update session msg model = ( { model | messages = header :: model.messages }, Cmd.none, Session.none ) MessageReceived (Err err) -> - ( model + let + flash = + { title = "Decoding failed" + , table = [ ( "Error", D.errorToString err ) ] + } + in + ( { model | session = Session.showFlash flash model.session } , Cmd.none - , Session.SetFlash - { title = "Decoding failed" - , table = [ ( "Error", D.errorToString err ) ] - } + , Session.none ) OpenMessage header -> diff --git a/ui/src/Page/Status.elm b/ui/src/Page/Status.elm index 3494599..92ac454 100644 --- a/ui/src/Page/Status.elm +++ b/ui/src/Page/Status.elm @@ -21,7 +21,8 @@ import Time exposing (Posix) type alias Model = - { now : Posix + { session : Session + , now : Posix , config : Maybe ServerConfig , metrics : Maybe Metrics , xCounter : Float @@ -52,9 +53,10 @@ type alias Metric = } -init : ( Model, Cmd Msg, Session.Msg ) -init = - ( { now = Time.millisToPosix 0 +init : Session -> ( Model, Cmd Msg, Session.Msg ) +init session = + ( { session = session + , now = Time.millisToPosix 0 , config = Nothing , metrics = Nothing , xCounter = 60 @@ -113,13 +115,19 @@ update session msg model = ( updateMetrics metrics model, Cmd.none, Session.none ) MetricsReceived (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) ServerConfigLoaded (Ok config) -> ( { model | config = Just config }, Cmd.none, Session.none ) ServerConfigLoaded (Err err) -> - ( model, Cmd.none, Session.SetFlash (HttpUtil.errorFlash err) ) + ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } + , Cmd.none + , Session.none + ) Tick time -> ( { model | now = time }, Api.getServerMetrics MetricsReceived, Session.none )