Effects refactor continued (#177)

* Use Effects instead of replaceUrl in Mailbox
* Add Effect.navigateRoute to handle monitor message clicks
* Add a focusModal effect for mailbox purge
* Remove temporary Cmd wrapper Effect

ui/src/Effect.elm

@@ -5,6 +5,7 @@ module Effect exposing
     , deleteMessage
     , disableRouting
     , enableRouting
+    , focusModal
     , getGreeting
     , getHeaderList
     , getMessage
@@ -12,21 +13,25 @@ module Effect exposing
     , getServerMetrics
     , map
     , markMessageSeen
+    , navigateRoute
     , none
     , perform
     , posixTime
     , purgeMailbox
     , schedule
     , showFlash
-    , wrap
+    , updateRoute
     )
 
 import Api exposing (DataResult, HttpResult)
+import Browser.Navigation as Nav
 import Data.Message exposing (Message)
 import Data.MessageHeader exposing (MessageHeader)
 import Data.Metrics exposing (Metrics)
 import Data.ServerConfig exposing (ServerConfig)
 import Data.Session as Session exposing (Session)
+import Modal
+import Route exposing (Route)
 import Task
 import Time
 import Timer exposing (Timer)
@@ -34,11 +39,13 @@ import Timer exposing (Timer)
 
 type Effect msg
     = None
-    | Batch (List (Effect msg))
-    | Command (Cmd msg)
-    | PosixTime (Time.Posix -> msg)
-    | ScheduleTimer (Timer -> msg) Timer Float
     | ApiEffect (ApiEffect msg)
+    | Batch (List (Effect msg))
+    | ModalFocus (Modal.Msg -> msg)
+    | PosixTime (Time.Posix -> msg)
+    | RouteNavigate Bool Route
+    | RouteUpdate Route
+    | ScheduleTimer (Timer -> msg) Timer Float
     | SessionEffect SessionEffect
 
 
@@ -79,8 +86,8 @@ map f effect =
         Batch effects ->
             Batch <| List.map (map f) effects
 
-        Command cmd ->
-            Command <| Cmd.map f cmd
+        ModalFocus toMsg ->
+            ModalFocus <| toMsg >> f
 
         PosixTime toMsg ->
             PosixTime <| toMsg >> f
@@ -88,6 +95,12 @@ map f effect =
         ScheduleTimer toMsg timer millis ->
             ScheduleTimer (toMsg >> f) timer millis
 
+        RouteNavigate pushHistory route ->
+            RouteNavigate pushHistory route
+
+        RouteUpdate route ->
+            RouteUpdate route
+
         ApiEffect apiEffect ->
             ApiEffect <| mapApi f apiEffect
 
@@ -135,8 +148,8 @@ perform ( session, effect ) =
             List.foldl batchPerform ( session, [] ) effects
                 |> Tuple.mapSecond Cmd.batch
 
-        Command cmd ->
-            ( session, cmd )
+        ModalFocus toMsg ->
+            ( session, Modal.resetFocusCmd toMsg )
 
         PosixTime toMsg ->
             ( session, Task.perform toMsg Time.now )
@@ -144,6 +157,27 @@ perform ( session, effect ) =
         ScheduleTimer toMsg timer millis ->
             ( session, Timer.schedule toMsg timer millis )
 
+        RouteNavigate pushHistory route ->
+            let
+                url =
+                    -- TODO replace Session.router
+                    session.router.toPath route
+            in
+            ( Session.enableRouting session
+            , if pushHistory then
+                Nav.pushUrl session.key url
+
+              else
+                Nav.replaceUrl session.key url
+            )
+
+        RouteUpdate route ->
+            ( Session.disableRouting session
+            , -- TODO replace Session.router
+              session.router.toPath route
+                |> Nav.replaceUrl session.key
+            )
+
         ApiEffect apiEffect ->
             performApi ( session, apiEffect )
 
@@ -234,6 +268,13 @@ showFlash flash =
     SessionEffect (FlashShow flash)
 
 
+{-| Locks focus to the `modal-dialog` dom ID.
+-}
+focusModal : (Modal.Msg -> msg) -> Effect msg
+focusModal toMsg =
+    ModalFocus toMsg
+
+
 deleteMessage : HttpResult msg -> String -> String -> Effect msg
 deleteMessage toMsg mailboxName id =
     ApiEffect (DeleteMessage toMsg mailboxName id)
@@ -286,12 +327,20 @@ schedule toMsg timer millis =
     ScheduleTimer toMsg timer millis
 
 
-{-| Wrap a Cmd into an Effect. This is a temporary function to aid in the transition to the effect
-pattern.
+{-| Updates the browsers displayed URL to the specified route, and triggers the route to be
+handled by the frontend.
 -}
-wrap : Cmd msg -> Effect msg
-wrap cmd =
-    Command cmd
+navigateRoute : Bool -> Route -> Effect msg
+navigateRoute pushHistory route =
+    RouteNavigate pushHistory route
+
+
+{-| Updates the browsers displayed URL to the specified route. Does not trigger our own route
+handling.
+-}
+updateRoute : Route -> Effect msg
+updateRoute route =
+    RouteUpdate route
 
 
 

ui/src/Page/Mailbox.elm

@@ -1,7 +1,6 @@
 module Page.Mailbox exposing (Model, Msg, init, subscriptions, update, view)
 
 import Api
-import Browser.Navigation as Nav
 import Data.Message as Message exposing (Message)
 import Data.MessageHeader exposing (MessageHeader)
 import Data.Session exposing (Session)
@@ -161,11 +160,7 @@ update msg model =
             ( updateSelected model id
             , Effect.batch
                 [ -- Update browser location.
-                  Effect.disableRouting
-                , Route.Message model.mailboxName id
-                    |> model.session.router.toPath
-                    |> Nav.replaceUrl model.session.key
-                    |> Effect.wrap
+                  Effect.updateRoute (Route.Message model.mailboxName id)
                 , Effect.getMessage MessageLoaded model.mailboxName id
                 ]
             )
@@ -241,7 +236,7 @@ update msg model =
             updateSearchInput model searchInput
 
         PurgeMailboxPrompt ->
-            ( { model | promptPurge = True }, Modal.resetFocusCmd ModalFocused |> Effect.wrap )
+            ( { model | promptPurge = True }, Effect.focusModal ModalFocused )
 
         PurgeMailboxCanceled ->
             ( { model | promptPurge = False }, Effect.none )
@@ -305,28 +300,16 @@ updateMessageResult model message =
 -}
 updateTriggerPurge : Model -> ( Model, Effect Msg )
 updateTriggerPurge model =
-    let
-        effects =
-            Effect.batch
-                [ Route.Mailbox model.mailboxName
-                    |> model.session.router.toPath
-                    |> Nav.replaceUrl model.session.key
-                    |> Effect.wrap
-                , Effect.purgeMailbox PurgedMailbox model.mailboxName
-                ]
-    in
-    case model.state of
-        ShowingList _ _ ->
     ( { model
         | promptPurge = False
         , state = ShowingList (MessageList [] Nothing "") NoMessage
       }
-            , Effect.batch [ Effect.disableRouting, effects ]
+    , Effect.batch
+        [ Effect.updateRoute (Route.Mailbox model.mailboxName)
+        , Effect.purgeMailbox PurgedMailbox model.mailboxName
+        ]
     )
 
-        _ ->
-            ( model, effects )
-
 
 updateSearchInput : Model -> String -> ( Model, Effect Msg )
 updateSearchInput model searchInput =
@@ -390,11 +373,7 @@ updateDeleteMessage model message =
             ( { model | state = ShowingList (filter (\x -> x.id /= message.id) list) NoMessage }
             , Effect.batch
                 [ Effect.deleteMessage DeletedMessage message.mailbox message.id
-                , Effect.disableRouting
-                , Route.Mailbox model.mailboxName
-                    |> model.session.router.toPath
-                    |> Nav.replaceUrl model.session.key
-                    |> Effect.wrap
+                , Effect.updateRoute (Route.Mailbox model.mailboxName)
                 ]
             )
 

ui/src/Page/Monitor.elm

@@ -1,9 +1,8 @@
 module Page.Monitor exposing (Model, Msg, init, update, view)
 
 import Api
-import Browser.Navigation as Nav
 import Data.MessageHeader as MessageHeader exposing (MessageHeader)
-import Data.Session as Session exposing (Session)
+import Data.Session exposing (Session)
 import DateFormat as DF
 import Effect exposing (Effect)
 import Html
@@ -102,10 +101,7 @@ update msg model =
 openMessage : MessageHeader -> Model -> ( Model, Effect Msg )
 openMessage header model =
     ( model
-    , Route.Message header.mailbox header.id
-        |> model.session.router.toPath
-        |> Nav.replaceUrl model.session.key
-        |> Effect.wrap
+    , Effect.navigateRoute True (Route.Message header.mailbox header.id)
     )