From 7c213cd89707de885603050b77155e37bf090b8e Mon Sep 17 00:00:00 2001 From: James Hillyerd Date: Mon, 24 Dec 2018 12:06:35 -0800 Subject: [PATCH 1/2] 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 ) From 2f7194835dce16f5509d6347ae54e9c955426db0 Mon Sep 17 00:00:00 2001 From: James Hillyerd Date: Mon, 24 Dec 2018 13:14:38 -0800 Subject: [PATCH 2/2] ui: Remove Session from Main model --- ui/src/Data/Session.elm | 30 ------ ui/src/Main.elm | 200 +++++++++++++++++----------------------- ui/src/Page/Home.elm | 15 ++- ui/src/Page/Mailbox.elm | 91 ++++++++---------- ui/src/Page/Monitor.elm | 21 ++--- ui/src/Page/Status.elm | 19 ++-- 6 files changed, 149 insertions(+), 227 deletions(-) diff --git a/ui/src/Data/Session.elm b/ui/src/Data/Session.elm index 825ffe6..3821292 100644 --- a/ui/src/Data/Session.elm +++ b/ui/src/Data/Session.elm @@ -1,6 +1,5 @@ module Data.Session exposing ( Flash - , Msg(..) , Persistent , Session , addRecent @@ -10,9 +9,7 @@ module Data.Session exposing , disableRouting , enableRouting , init - , none , showFlash - , update ) import Browser.Navigation as Nav @@ -46,10 +43,6 @@ type alias Persistent = } -type Msg - = None - - init : Nav.Key -> Url -> Persistent -> Session init key location persistent = { key = key @@ -61,29 +54,6 @@ init key location persistent = } -update : Msg -> Session -> ( Session, Cmd a ) -update msg session = - let - newSession = - case msg of - None -> - session - in - if session.persistent == newSession.persistent then - -- No change - ( newSession, Cmd.none ) - - else - ( newSession - , Ports.storeSession (encode newSession.persistent) - ) - - -none : Msg -none = - None - - addRecent : String -> Session -> Session addRecent mailbox session = if List.head session.persistent.recentMailboxes == Just mailbox then diff --git a/ui/src/Main.elm b/ui/src/Main.elm index 85bb465..30c207a 100644 --- a/ui/src/Main.elm +++ b/ui/src/Main.elm @@ -30,7 +30,6 @@ type Page type alias Model = { page : Page - , session : Session , mailboxName : String } @@ -41,12 +40,11 @@ init sessionValue location key = session = Session.init key location (Session.decodeValueWithDefault sessionValue) - ( subModel, _, _ ) = + ( subModel, _ ) = Home.init session initModel = { page = Home subModel - , session = session , mailboxName = "" } @@ -54,7 +52,7 @@ init sessionValue location key = Route.fromUrl location ( model, cmd ) = - changeRouteTo route initModel |> updateSession + changeRouteTo route initModel in ( model, Cmd.batch [ cmd, Task.perform TimeZoneLoaded Time.here ] ) @@ -67,7 +65,6 @@ type Msg | ClearFlash | OnMailboxNameInput String | ViewMailbox String - | SessionMsg Session.Msg | HomeMsg Home.Msg | MailboxMsg Mailbox.Msg | MonitorMsg Monitor.Msg @@ -113,124 +110,109 @@ pageSubscriptions page = update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - updateSession <| - case msg of - LinkClicked req -> - case req of - Browser.Internal url -> - case url.fragment of - Just "" -> - -- Anchor tag for accessibility purposes only, already handled. - ( model, Cmd.none, Session.none ) + let + session = + getSession model + in + case msg of + LinkClicked req -> + case req of + Browser.Internal url -> + case url.fragment of + Just "" -> + -- Anchor tag for accessibility purposes only, already handled. + ( model, Cmd.none ) - _ -> - ( applySessionUpdate Session.clearFlash model - , Nav.pushUrl model.session.key (Url.toString url) - , Session.none - ) + _ -> + ( applyToModelSession Session.clearFlash model + , Nav.pushUrl session.key (Url.toString url) + ) - Browser.External url -> - ( model, Nav.load url, Session.none ) + Browser.External url -> + ( model, Nav.load url ) - UrlChanged url -> - -- Responds to new browser URL. - if model.session.routing then - changeRouteTo (Route.fromUrl url) model + UrlChanged url -> + -- Responds to new browser URL. + if session.routing then + changeRouteTo (Route.fromUrl url) model - else - -- Skip once, but re-enable routing. - ( applySessionUpdate Session.enableRouting model - , Cmd.none - , Session.none - ) - - ClearFlash -> - ( applySessionUpdate Session.clearFlash model + else + -- Skip once, but re-enable routing. + ( applyToModelSession Session.enableRouting model , Cmd.none - , Session.none ) - SessionMsg sessionMsg -> - ( model, Cmd.none, sessionMsg ) + ClearFlash -> + ( applyToModelSession Session.clearFlash model + , Cmd.none + ) - SessionUpdated (Ok persistent) -> - let - session = - model.session - in - ( { model | session = { session | persistent = persistent } } - , Cmd.none - , Session.none - ) + SessionUpdated (Ok persistent) -> + ( updateSession model { session | persistent = persistent } + , Cmd.none + ) - SessionUpdated (Err error) -> - let - flash = - { title = "Error decoding session" - , table = [ ( "Error", D.errorToString error ) ] - } - in - ( { model | session = Session.showFlash flash model.session } - , Cmd.none - , Session.none - ) + SessionUpdated (Err error) -> + let + flash = + { title = "Error decoding session" + , table = [ ( "Error", D.errorToString error ) ] + } + in + ( applyToModelSession (Session.showFlash flash) model + , Cmd.none + ) - TimeZoneLoaded zone -> - let - session = - model.session - in - ( { model | session = { session | zone = zone } } - , Cmd.none - , Session.none - ) + TimeZoneLoaded zone -> + ( updateSession model { session | zone = zone } + , Cmd.none + ) - OnMailboxNameInput name -> - ( { model | mailboxName = name }, Cmd.none, Session.none ) + OnMailboxNameInput name -> + ( { model | mailboxName = name }, Cmd.none ) - ViewMailbox name -> - ( applySessionUpdate Session.clearFlash { model | mailboxName = "" } - , Route.pushUrl model.session.key (Route.Mailbox name) - , Session.none - ) + ViewMailbox name -> + ( applyToModelSession Session.clearFlash { model | mailboxName = "" } + , Route.pushUrl session.key (Route.Mailbox name) + ) - _ -> - updatePage msg model + _ -> + updatePage msg model {-| Delegates incoming messages to their respective sub-pages. -} -updatePage : Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) +updatePage : Msg -> Model -> ( Model, Cmd Msg ) updatePage msg model = case ( msg, model.page ) of ( HomeMsg subMsg, Home subModel ) -> - Home.update model.session subMsg subModel + Home.update subMsg subModel |> updateWith Home HomeMsg model ( MailboxMsg subMsg, Mailbox subModel ) -> - Mailbox.update model.session subMsg subModel + Mailbox.update subMsg subModel |> updateWith Mailbox MailboxMsg model ( MonitorMsg subMsg, Monitor subModel ) -> - Monitor.update model.session subMsg subModel + Monitor.update subMsg subModel |> updateWith Monitor MonitorMsg model ( StatusMsg subMsg, Status subModel ) -> - Status.update model.session subMsg subModel + Status.update subMsg subModel |> updateWith Status StatusMsg model ( _, _ ) -> -- Disregard messages destined for the wrong page. - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) -changeRouteTo : Route -> Model -> ( Model, Cmd Msg, Session.Msg ) +changeRouteTo : Route -> Model -> ( Model, Cmd Msg ) changeRouteTo route model = let session = getSession model - ( newModel, newCmd, newSession ) = + ( newModel, newCmd ) = case route of Route.Unknown path -> let @@ -239,9 +221,8 @@ changeRouteTo route model = , table = [ ( "Path", path ) ] } in - ( { model | session = Session.showFlash flash model.session } + ( applyToModelSession (Session.showFlash flash) model , Cmd.none - , Session.none ) Route.Home -> @@ -267,10 +248,10 @@ changeRouteTo route model = case model.page of Monitor _ -> -- Leaving Monitor page, shut down the web socket. - ( newModel, Cmd.batch [ Ports.monitorCommand False, newCmd ], newSession ) + ( newModel, Cmd.batch [ Ports.monitorCommand False, newCmd ] ) _ -> - ( newModel, newCmd, newSession ) + ( newModel, newCmd ) getSession : Model -> Session @@ -289,12 +270,8 @@ getSession model = subModel.session -applySessionUpdate : (Session -> Session) -> Model -> Model -applySessionUpdate f model = - let - session = - f (getSession model) - in +updateSession : Model -> Session -> Model +updateSession model session = case model.page of Home subModel -> { model | page = Home { subModel | session = session } } @@ -309,15 +286,9 @@ applySessionUpdate f model = { 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 (getSession model) - in - ( { model | session = session } - , Cmd.batch [ newCmd, cmd ] - ) +applyToModelSession : (Session -> Session) -> Model -> Model +applyToModelSession f model = + updateSession model (f (getSession model)) {-| Map page updates to Main Model and Msg types. @@ -326,12 +297,11 @@ updateWith : (subModel -> Page) -> (subMsg -> Msg) -> Model - -> ( subModel, Cmd subMsg, Session.Msg ) - -> ( Model, Cmd Msg, Session.Msg ) -updateWith toPage toMsg model ( subModel, subCmd, sessionMsg ) = + -> ( subModel, Cmd subMsg ) + -> ( Model, Cmd Msg ) +updateWith toPage toMsg model ( subModel, subCmd ) = ( { model | page = toPage subModel } , Cmd.map toMsg subCmd - , sessionMsg ) @@ -342,6 +312,9 @@ updateWith toPage toMsg model ( subModel, subCmd, sessionMsg ) = view : Model -> Document Msg view model = let + session = + getSession model + mailbox = case model.page of Mailbox subModel -> @@ -354,7 +327,7 @@ view model = { viewMailbox = ViewMailbox , mailboxOnInput = OnMailboxNameInput , mailboxValue = model.mailboxName - , recentOptions = model.session.persistent.recentMailboxes + , recentOptions = session.persistent.recentMailboxes , recentActive = mailbox , clearFlash = ClearFlash } @@ -366,8 +339,9 @@ view model = -> Document Msg framePage page toMsg { title, modal, content } = Document title - [ Page.frame controls - model.session + [ Page.frame + controls + session page (Maybe.map (Html.map toMsg) modal) (List.map (Html.map toMsg) content) @@ -375,16 +349,16 @@ view model = in case model.page of Home subModel -> - framePage Page.Other HomeMsg (Home.view model.session subModel) + framePage Page.Other HomeMsg (Home.view subModel) Mailbox subModel -> - framePage Page.Mailbox MailboxMsg (Mailbox.view model.session subModel) + framePage Page.Mailbox MailboxMsg (Mailbox.view subModel) Monitor subModel -> - framePage Page.Monitor MonitorMsg (Monitor.view model.session subModel) + framePage Page.Monitor MonitorMsg (Monitor.view subModel) Status subModel -> - framePage Page.Status StatusMsg (Status.view model.session subModel) + framePage Page.Status StatusMsg (Status.view subModel) diff --git a/ui/src/Page/Home.elm b/ui/src/Page/Home.elm index f4c3a96..3ce3f99 100644 --- a/ui/src/Page/Home.elm +++ b/ui/src/Page/Home.elm @@ -20,9 +20,9 @@ type alias Model = } -init : Session -> ( Model, Cmd Msg, Session.Msg ) +init : Session -> ( Model, Cmd Msg ) init session = - ( Model session "", Api.getGreeting GreetingLoaded, Session.none ) + ( Model session "", Api.getGreeting GreetingLoaded ) @@ -33,16 +33,15 @@ type Msg = GreetingLoaded (Result HttpUtil.Error String) -update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) -update session msg model = +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = case msg of GreetingLoaded (Ok greeting) -> - ( { model | greeting = greeting }, Cmd.none, Session.none ) + ( { model | greeting = greeting }, Cmd.none ) GreetingLoaded (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) @@ -50,8 +49,8 @@ update session msg model = -- VIEW -- -view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } -view session model = +view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } +view model = { title = "Inbucket" , modal = Nothing , content = diff --git a/ui/src/Page/Mailbox.elm b/ui/src/Page/Mailbox.elm index dc3abe7..26e98df 100644 --- a/ui/src/Page/Mailbox.elm +++ b/ui/src/Page/Mailbox.elm @@ -81,7 +81,7 @@ type alias Model = } -init : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg, Session.Msg ) +init : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg ) init session mailboxName selection = ( { session = session , mailboxName = mailboxName @@ -92,7 +92,6 @@ init session mailboxName selection = , now = Time.millisToPosix 0 } , load mailboxName - , Session.none ) @@ -152,32 +151,30 @@ type Msg | Tick Posix -update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) -update session msg model = +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = case msg of ClickMessage id -> ( updateSelected { model | session = Session.disableRouting model.session } id , Cmd.batch [ -- Update browser location. - Route.replaceUrl session.key (Route.Message model.mailboxName id) + Route.replaceUrl model.session.key (Route.Message model.mailboxName id) , Api.getMessage MessageLoaded model.mailboxName id ] - , Session.none ) OpenMessage id -> - updateOpenMessage session model id + updateOpenMessage model.session model id DeleteMessage message -> - updateDeleteMessage session model message + updateDeleteMessage model.session model message DeletedMessage (Ok _) -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) DeletedMessage (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) ListLoaded (Ok headers) -> @@ -191,32 +188,29 @@ update session msg model = in case selection of Just id -> - updateOpenMessage session newModel id + updateOpenMessage model.session newModel id Nothing -> - ( { model + ( { newModel | session = Session.addRecent model.mailboxName model.session } , Cmd.none - , Session.none ) _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) ListLoaded (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) MarkedSeen (Ok _) -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) MarkedSeen (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) MessageLoaded (Ok message) -> @@ -225,11 +219,10 @@ update session msg model = MessageLoaded (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) MessageBody bodyMode -> - ( { model | bodyMode = bodyMode }, Cmd.none, Session.none ) + ( { model | bodyMode = bodyMode }, Cmd.none ) OnSearchInput searchInput -> updateSearchInput model searchInput @@ -238,7 +231,7 @@ update session msg model = case model.state of ShowingList list (ShowingMessage visible) -> if visible.message.seen then - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) else -- Set 1500ms delay before reporting message as seen to backend. @@ -256,28 +249,26 @@ update session msg model = ) } , Cmd.none - , Session.none ) _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) PurgeMailboxPrompt -> - ( { model | promptPurge = True }, Cmd.none, Session.none ) + ( { model | promptPurge = True }, Cmd.none ) PurgeMailboxCanceled -> - ( { model | promptPurge = False }, Cmd.none, Session.none ) + ( { model | promptPurge = False }, Cmd.none ) PurgeMailboxConfirmed -> - updatePurge session model + updatePurge model.session model PurgedMailbox (Ok _) -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) PurgedMailbox (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) MarkSeenTick now -> @@ -289,21 +280,21 @@ update session msg model = updateMarkMessageSeen model message else - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) Nothing -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) Tick now -> - ( { model | now = now }, Cmd.none, Session.none ) + ( { model | now = now }, Cmd.none ) {-| Replace the currently displayed message. -} -updateMessageResult : Model -> Message -> ( Model, Cmd Msg, Session.Msg ) +updateMessageResult : Model -> Message -> ( Model, Cmd Msg ) updateMessageResult model message = let bodyMode = @@ -315,7 +306,7 @@ updateMessageResult model message = in case model.state of LoadingList _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) ShowingList list _ -> ( { model @@ -326,11 +317,10 @@ updateMessageResult model message = , bodyMode = bodyMode } , Task.perform OpenedTime Time.now - , Session.none ) -updatePurge : Session -> Model -> ( Model, Cmd Msg, Session.Msg ) +updatePurge : Session -> Model -> ( Model, Cmd Msg ) updatePurge session model = let cmd = @@ -347,14 +337,13 @@ updatePurge session model = , state = ShowingList (MessageList [] Nothing "") NoMessage } , cmd - , Session.none ) _ -> - ( model, cmd, Session.none ) + ( model, cmd ) -updateSearchInput : Model -> String -> ( Model, Cmd Msg, Session.Msg ) +updateSearchInput : Model -> String -> ( Model, Cmd Msg ) updateSearchInput model searchInput = let searchFilter = @@ -366,7 +355,7 @@ updateSearchInput model searchInput = in case model.state of LoadingList _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) ShowingList list messageState -> ( { model @@ -374,7 +363,6 @@ updateSearchInput model searchInput = , state = ShowingList { list | searchFilter = searchFilter } messageState } , Cmd.none - , Session.none ) @@ -406,7 +394,7 @@ updateSelected model id = { model | state = ShowingList newList (Transitioning visible) } -updateDeleteMessage : Session -> Model -> Message -> ( Model, Cmd Msg, Session.Msg ) +updateDeleteMessage : Session -> Model -> Message -> ( Model, Cmd Msg ) updateDeleteMessage session model message = let filter f messageList = @@ -423,14 +411,13 @@ updateDeleteMessage session model message = [ Api.deleteMessage DeletedMessage message.mailbox message.id , Route.replaceUrl session.key (Route.Mailbox model.mailboxName) ] - , Session.none ) _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) -updateMarkMessageSeen : Model -> Message -> ( Model, Cmd Msg, Session.Msg ) +updateMarkMessageSeen : Model -> Message -> ( Model, Cmd Msg ) updateMarkMessageSeen model message = case model.state of ShowingList list (ShowingMessage visible) -> @@ -456,14 +443,13 @@ updateMarkMessageSeen model message = ) } , Api.markMessageSeen MarkedSeen message.mailbox message.id - , Session.None ) _ -> - ( model, Cmd.none, Session.none ) + ( model, Cmd.none ) -updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg, Session.Msg ) +updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg ) updateOpenMessage session model id = let newModel = @@ -471,7 +457,6 @@ updateOpenMessage session model id = in ( updateSelected newModel id , Api.getMessage MessageLoaded model.mailboxName id - , Session.none ) @@ -479,8 +464,8 @@ updateOpenMessage session model id = -- VIEW -view : Session -> Model -> { title : String, modal : Maybe (Html Msg), content : List (Html Msg) } -view session model = +view : Model -> { title : String, modal : Maybe (Html Msg), content : List (Html Msg) } +view model = { title = model.mailboxName ++ " - Inbucket" , modal = viewModal model.promptPurge , content = @@ -499,7 +484,7 @@ view session model = ] [ i [ class "fas fa-trash" ] [] ] ] - , viewMessageList session model + , viewMessageList model.session model , main_ [ class "message" ] [ case model.state of @@ -510,10 +495,10 @@ view session model = ) ShowingList _ (ShowingMessage { message }) -> - viewMessage session.zone message model.bodyMode + viewMessage model.session.zone message model.bodyMode ShowingList _ (Transitioning { message }) -> - viewMessage session.zone message model.bodyMode + viewMessage model.session.zone message model.bodyMode _ -> text "" diff --git a/ui/src/Page/Monitor.elm b/ui/src/Page/Monitor.elm index 4af251a..58b935a 100644 --- a/ui/src/Page/Monitor.elm +++ b/ui/src/Page/Monitor.elm @@ -28,11 +28,10 @@ type MonitorMessage | Message MessageHeader -init : Session -> ( Model, Cmd Msg, Session.Msg ) +init : Session -> ( Model, Cmd Msg ) init session = ( Model session False [] , Ports.monitorCommand True - , Session.none ) @@ -63,14 +62,14 @@ type Msg | OpenMessage MessageHeader -update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) -update session msg model = +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = case msg of MessageReceived (Ok (Connected status)) -> - ( { model | connected = status }, Cmd.none, Session.none ) + ( { model | connected = status }, Cmd.none ) MessageReceived (Ok (Message header)) -> - ( { model | messages = header :: model.messages }, Cmd.none, Session.none ) + ( { model | messages = header :: model.messages }, Cmd.none ) MessageReceived (Err err) -> let @@ -81,13 +80,11 @@ update session msg model = in ( { model | session = Session.showFlash flash model.session } , Cmd.none - , Session.none ) OpenMessage header -> ( model - , Route.pushUrl session.key (Route.Message header.mailbox header.id) - , Session.none + , Route.pushUrl model.session.key (Route.Message header.mailbox header.id) ) @@ -95,8 +92,8 @@ update session msg model = -- VIEW -view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } -view session model = +view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } +view model = { title = "Inbucket Monitor" , modal = Nothing , content = @@ -120,7 +117,7 @@ view session model = , th [] [ text "Mailbox" ] , th [] [ text "Subject" ] ] - , tbody [] (List.map (viewMessage session.zone) model.messages) + , tbody [] (List.map (viewMessage model.session.zone) model.messages) ] ] } diff --git a/ui/src/Page/Status.elm b/ui/src/Page/Status.elm index 92ac454..e719c1e 100644 --- a/ui/src/Page/Status.elm +++ b/ui/src/Page/Status.elm @@ -53,7 +53,7 @@ type alias Metric = } -init : Session -> ( Model, Cmd Msg, Session.Msg ) +init : Session -> ( Model, Cmd Msg ) init session = ( { session = session , now = Time.millisToPosix 0 @@ -79,7 +79,6 @@ init session = [ Task.perform Tick Time.now , Api.getServerConfig ServerConfigLoaded ] - , Session.none ) @@ -108,29 +107,27 @@ type Msg | Tick Posix -update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) -update session msg model = +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = case msg of MetricsReceived (Ok metrics) -> - ( updateMetrics metrics model, Cmd.none, Session.none ) + ( updateMetrics metrics model, Cmd.none ) MetricsReceived (Err 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 ) + ( { model | config = Just config }, Cmd.none ) ServerConfigLoaded (Err err) -> ( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session } , Cmd.none - , Session.none ) Tick time -> - ( { model | now = time }, Api.getServerMetrics MetricsReceived, Session.none ) + ( { model | now = time }, Api.getServerMetrics MetricsReceived ) {-| Update all metrics in Model; increment xCounter. @@ -233,8 +230,8 @@ updateRemoteTotal metric value history = -- VIEW -- -view : Session -> Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } -view session model = +view : Model -> { title : String, modal : Maybe (Html msg), content : List (Html Msg) } +view model = { title = "Inbucket Status" , modal = Nothing , content =