ui: Embed Session into page models

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

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
+                , Session.none
-                    { title = "Error decoding session"
-                    , table = [ ( "Error", D.errorToString error ) ]
-                    }
                 )
 
             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
+                    , Session.none
-                        { title = "Unknown route requested"
-                        , table = [ ( "Path", path ) ]
-                        }
                     )
 
                 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 :

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 : Session -> ( Model, Cmd Msg, Session.Msg )
-init =
+init session =
-    ( Model "", Api.getGreeting GreetingLoaded, Session.none )
+    ( 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
+            )
 
 
 

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 : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg, Session.Msg )
-init mailboxName selection =
+init session mailboxName selection =
-    ( Model mailboxName (LoadingList selection) SafeHtmlBody "" False (Time.millisToPosix 0)
+    ( { 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
     )
 
 

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 : Session -> ( Model, Cmd Msg, Session.Msg )
-init =
+init session =
-    ( Model False [], Ports.monitorCommand True, Session.none )
+    ( 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
+            , Session.none
-                { title = "Decoding failed"
-                , table = [ ( "Error", D.errorToString err ) ]
-                }
             )
 
         OpenMessage header ->

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 : Session -> ( Model, Cmd Msg, Session.Msg )
-init =
+init session =
-    ( { now = Time.millisToPosix 0
+    ( { 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 )