From 5c5b0f819b62057a6bc82612cf88902cecd6bd07 Mon Sep 17 00:00:00 2001 From: James Hillyerd Date: Sun, 13 Sep 2020 17:08:11 -0700 Subject: [PATCH] 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 | 77 +++++++++++++++++++++++++++++++++-------- ui/src/Page/Mailbox.elm | 45 +++++++----------------- ui/src/Page/Monitor.elm | 8 ++--- 3 files changed, 77 insertions(+), 53 deletions(-) diff --git a/ui/src/Effect.elm b/ui/src/Effect.elm index 818e960..2907417 100644 --- a/ui/src/Effect.elm +++ b/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 diff --git a/ui/src/Page/Mailbox.elm b/ui/src/Page/Mailbox.elm index 3153b05..a3a8ce9 100644 --- a/ui/src/Page/Mailbox.elm +++ b/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,27 +300,15 @@ 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 ] - ) - - _ -> - ( model, effects ) + ( { model + | promptPurge = False + , state = ShowingList (MessageList [] Nothing "") NoMessage + } + , Effect.batch + [ Effect.updateRoute (Route.Mailbox model.mailboxName) + , Effect.purgeMailbox PurgedMailbox model.mailboxName + ] + ) updateSearchInput : Model -> String -> ( Model, Effect Msg ) @@ -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) ] ) diff --git a/ui/src/Page/Monitor.elm b/ui/src/Page/Monitor.elm index 07fff3c..016c27c 100644 --- a/ui/src/Page/Monitor.elm +++ b/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) )