1
0
mirror of https://github.com/jhillyerd/inbucket.git synced 2026-01-25 20:45:59 +00:00

ui: Add an Effect system to handle global state and Elm Cmds (#176)

All pages now leverage Effects for most of their Session and Cmd requests. More work required for routing and other lingering Cmd use.
This commit is contained in:
James Hillyerd
2020-09-12 19:45:14 -07:00
committed by GitHub
parent cf4c5a29bb
commit 2162a4caaa
8 changed files with 460 additions and 167 deletions

View File

@@ -1,7 +1,7 @@
module Page.Home exposing (Model, Msg, init, update, view)
import Api
import Data.Session as Session exposing (Session)
import Data.Session exposing (Session)
import Effect exposing (Effect)
import Html exposing (Html)
import Html.Attributes exposing (class, property)
import HttpUtil
@@ -18,9 +18,9 @@ type alias Model =
}
init : Session -> ( Model, Cmd Msg )
init : Session -> ( Model, Effect Msg )
init session =
( Model session "", Api.getGreeting session GreetingLoaded )
( Model session "", Effect.getGreeting GreetingLoaded )
@@ -31,16 +31,14 @@ type Msg
= GreetingLoaded (Result HttpUtil.Error String)
update : Msg -> Model -> ( Model, Cmd Msg )
update : Msg -> Model -> ( Model, Effect Msg )
update msg model =
case msg of
GreetingLoaded (Ok greeting) ->
( { model | greeting = greeting }, Cmd.none )
( { model | greeting = greeting }, Effect.none )
GreetingLoaded (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )

View File

@@ -1,12 +1,13 @@
module Page.Mailbox exposing (Model, Msg, init, load, subscriptions, update, view)
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 as Session exposing (Session)
import Data.Session exposing (Session)
import DateFormat as DF
import DateFormat.Relative as Relative
import Effect exposing (Effect)
import Html
exposing
( Attribute
@@ -54,7 +55,6 @@ import Json.Decode as D
import Json.Encode as E
import Modal
import Route
import Task
import Time exposing (Posix)
import Timer exposing (Timer)
@@ -103,7 +103,7 @@ type alias Model =
}
init : Session -> String -> Maybe MessageID -> ( Model, Cmd Msg )
init : Session -> String -> Maybe MessageID -> ( Model, Effect Msg )
init session mailboxName selection =
( { session = session
, mailboxName = mailboxName
@@ -114,16 +114,11 @@ init session mailboxName selection =
, markSeenTimer = Timer.empty
, now = Time.millisToPosix 0
}
, load session mailboxName
)
load : Session -> String -> Cmd Msg
load session mailboxName =
Cmd.batch
[ Task.perform Tick Time.now
, Api.getHeaderList session ListLoaded mailboxName
, Effect.batch
[ Effect.posixTime Tick
, Effect.getHeaderList ListLoaded mailboxName
]
)
@@ -159,38 +154,38 @@ type Msg
| ModalFocused Modal.Msg
update : Msg -> Model -> ( Model, Cmd Msg )
update : Msg -> Model -> ( Model, Effect Msg )
update msg model =
case msg of
ClickMessage id ->
( updateSelected { model | session = Session.disableRouting model.session } id
, Cmd.batch
( updateSelected model id
, Effect.batch
[ -- Update browser location.
Route.Message model.mailboxName id
Effect.disableRouting
, Route.Message model.mailboxName id
|> model.session.router.toPath
|> Nav.replaceUrl model.session.key
, Api.getMessage model.session MessageLoaded model.mailboxName id
|> Effect.wrap
, Effect.getMessage MessageLoaded model.mailboxName id
]
)
CloseMessage ->
case model.state of
ShowingList list _ ->
( { model | state = ShowingList list NoMessage }, Cmd.none )
( { model | state = ShowingList list NoMessage }, Effect.none )
_ ->
( model, Cmd.none )
( model, Effect.none )
DeleteMessage message ->
updateDeleteMessage model message
DeletedMessage (Ok _) ->
( model, Cmd.none )
( model, Effect.none )
DeletedMessage (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
ListKeyPress id keyCode ->
case keyCode of
@@ -198,7 +193,7 @@ update msg model =
updateOpenMessage model id
_ ->
( model, Cmd.none )
( model, Effect.none )
ListLoaded (Ok headers) ->
case model.state of
@@ -214,63 +209,51 @@ update msg model =
updateOpenMessage newModel id
Nothing ->
( { newModel
| session = Session.addRecent model.mailboxName model.session
}
, Cmd.none
)
( newModel, Effect.addRecent newModel.mailboxName )
_ ->
( model, Cmd.none )
( model, Effect.none )
ListLoaded (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
MarkSeenLoaded (Ok _) ->
( model, Cmd.none )
( model, Effect.none )
MarkSeenLoaded (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
MessageLoaded (Ok message) ->
updateMessageResult model message
MessageLoaded (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
MessageBody bodyMode ->
( { model | bodyMode = bodyMode }, Cmd.none )
( { model | bodyMode = bodyMode }, Effect.none )
ModalFocused message ->
( { model | session = Modal.updateSession message model.session }
, Cmd.none
, Effect.none
)
OnSearchInput searchInput ->
updateSearchInput model searchInput
PurgeMailboxPrompt ->
( { model | promptPurge = True }, Modal.resetFocusCmd ModalFocused )
( { model | promptPurge = True }, Modal.resetFocusCmd ModalFocused |> Effect.wrap )
PurgeMailboxCanceled ->
( { model | promptPurge = False }, Cmd.none )
( { model | promptPurge = False }, Effect.none )
PurgeMailboxConfirmed ->
updateTriggerPurge model
PurgedMailbox (Ok _) ->
( model, Cmd.none )
( model, Effect.none )
PurgedMailbox (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
MarkSeenTriggered timer ->
if timer == model.markSeenTimer then
@@ -278,15 +261,15 @@ update msg model =
updateMarkMessageSeen model
else
( model, Cmd.none )
( model, Effect.none )
Tick now ->
( { model | now = now }, Cmd.none )
( { model | now = now }, Effect.none )
{-| Replace the currently displayed message.
-}
updateMessageResult : Model -> Message -> ( Model, Cmd Msg )
updateMessageResult : Model -> Message -> ( Model, Effect Msg )
updateMessageResult model message =
let
bodyMode =
@@ -298,7 +281,7 @@ updateMessageResult model message =
in
case model.state of
LoadingList _ ->
( model, Cmd.none )
( model, Effect.none )
ShowingList list _ ->
let
@@ -314,38 +297,38 @@ updateMessageResult model message =
, markSeenTimer = newTimer
}
-- Set 1500ms delay before reporting message as seen to backend.
, Timer.schedule MarkSeenTriggered newTimer 1500
, Effect.schedule MarkSeenTriggered newTimer 1500
)
{-| Updates model and triggers commands to purge this mailbox.
-}
updateTriggerPurge : Model -> ( Model, Cmd Msg )
updateTriggerPurge : Model -> ( Model, Effect Msg )
updateTriggerPurge model =
let
cmd =
Cmd.batch
effects =
Effect.batch
[ Route.Mailbox model.mailboxName
|> model.session.router.toPath
|> Nav.replaceUrl model.session.key
, Api.purgeMailbox model.session PurgedMailbox model.mailboxName
|> Effect.wrap
, Effect.purgeMailbox PurgedMailbox model.mailboxName
]
in
case model.state of
ShowingList _ _ ->
( { model
| promptPurge = False
, session = Session.disableRouting model.session
, state = ShowingList (MessageList [] Nothing "") NoMessage
}
, cmd
, Effect.batch [ Effect.disableRouting, effects ]
)
_ ->
( model, cmd )
( model, effects )
updateSearchInput : Model -> String -> ( Model, Cmd Msg )
updateSearchInput : Model -> String -> ( Model, Effect Msg )
updateSearchInput model searchInput =
let
searchFilter =
@@ -357,14 +340,14 @@ updateSearchInput model searchInput =
in
case model.state of
LoadingList _ ->
( model, Cmd.none )
( model, Effect.none )
ShowingList list messageState ->
( { model
| searchInput = searchInput
, state = ShowingList { list | searchFilter = searchFilter } messageState
}
, Cmd.none
, Effect.none
)
@@ -396,7 +379,7 @@ updateSelected model id =
{ model | state = ShowingList newList (Transitioning visible) }
updateDeleteMessage : Model -> Message -> ( Model, Cmd Msg )
updateDeleteMessage : Model -> Message -> ( Model, Effect Msg )
updateDeleteMessage model message =
let
filter f messageList =
@@ -404,26 +387,24 @@ updateDeleteMessage model message =
in
case model.state of
ShowingList list _ ->
( { model
| session = Session.disableRouting model.session
, state =
ShowingList (filter (\x -> x.id /= message.id) list) NoMessage
}
, Cmd.batch
[ Api.deleteMessage model.session DeletedMessage message.mailbox message.id
( { 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
]
)
_ ->
( model, Cmd.none )
( model, Effect.none )
{-| Updates both the active message, and the message list to mark the currently viewed message as seen.
-}
updateMarkMessageSeen : Model -> ( Model, Cmd Msg )
updateMarkMessageSeen : Model -> ( Model, Effect Msg )
updateMarkMessageSeen model =
case model.state of
ShowingList messages (ShowingMessage visibleMessage) ->
@@ -442,21 +423,20 @@ updateMarkMessageSeen model =
| state =
ShowingList newMessages (ShowingMessage { visibleMessage | seen = True })
}
, Api.markMessageSeen model.session MarkSeenLoaded visibleMessage.mailbox visibleMessage.id
, Effect.markMessageSeen MarkSeenLoaded visibleMessage.mailbox visibleMessage.id
)
_ ->
( model, Cmd.none )
( model, Effect.none )
updateOpenMessage : Model -> String -> ( Model, Cmd Msg )
updateOpenMessage : Model -> String -> ( Model, Effect Msg )
updateOpenMessage model id =
let
newModel =
{ model | session = Session.addRecent model.mailboxName model.session }
in
( updateSelected newModel id
, Api.getMessage model.session MessageLoaded model.mailboxName id
( updateSelected model id
, Effect.batch
[ Effect.addRecent model.mailboxName
, Effect.getMessage MessageLoaded model.mailboxName id
]
)

View File

@@ -5,6 +5,7 @@ import Browser.Navigation as Nav
import Data.MessageHeader as MessageHeader exposing (MessageHeader)
import Data.Session as Session exposing (Session)
import DateFormat as DF
import Effect exposing (Effect)
import Html
exposing
( Attribute
@@ -41,9 +42,9 @@ type alias Model =
}
init : Session -> ( Model, Cmd Msg )
init : Session -> ( Model, Effect Msg )
init session =
( Model session False [], Cmd.none )
( Model session False [], Effect.none )
@@ -58,20 +59,20 @@ type Msg
| MessageKeyPress MessageHeader Int
update : Msg -> Model -> ( Model, Cmd Msg )
update : Msg -> Model -> ( Model, Effect Msg )
update msg model =
case msg of
Connected True ->
( { model | connected = True, messages = [] }, Cmd.none )
( { model | connected = True, messages = [] }, Effect.none )
Connected False ->
( { model | connected = False }, Cmd.none )
( { model | connected = False }, Effect.none )
MessageReceived value ->
case D.decodeValue (MessageHeader.decoder |> D.at [ "detail" ]) value of
Ok header ->
( { model | messages = header :: List.take 500 model.messages }
, Cmd.none
, Effect.none
)
Err err ->
@@ -81,12 +82,10 @@ update msg model =
, table = [ ( "Error", D.errorToString err ) ]
}
in
( { model | session = Session.showFlash flash model.session }
, Cmd.none
)
( model, Effect.showFlash flash )
Clear ->
( { model | messages = [] }, Cmd.none )
( { model | messages = [] }, Effect.none )
OpenMessage header ->
openMessage header model
@@ -97,15 +96,16 @@ update msg model =
openMessage header model
_ ->
( model, Cmd.none )
( model, Effect.none )
openMessage : MessageHeader -> Model -> ( Model, Cmd Msg )
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
)

View File

@@ -1,10 +1,10 @@
module Page.Status exposing (Model, Msg, init, subscriptions, update, view)
import Api
import Data.Metrics exposing (Metrics)
import Data.ServerConfig exposing (ServerConfig)
import Data.Session as Session exposing (Session)
import Data.Session exposing (Session)
import DateFormat.Relative as Relative
import Effect exposing (Effect)
import Filesize
import Html
exposing
@@ -19,7 +19,6 @@ import Html.Attributes exposing (class)
import HttpUtil
import Sparkline as Spark
import Svg.Attributes as SvgAttrib
import Task
import Time exposing (Posix)
@@ -60,7 +59,7 @@ type alias Metric =
}
init : Session -> ( Model, Cmd Msg )
init : Session -> ( Model, Effect Msg )
init session =
( { session = session
, now = Time.millisToPosix 0
@@ -82,9 +81,9 @@ init session =
, retainedCount = Metric "Stored Messages" 0 fmtInt graphZero initDataSet 60
, retainedSize = Metric "Store Size" 0 Filesize.format graphZero initDataSet 60
}
, Cmd.batch
[ Task.perform Tick Time.now
, Api.getServerConfig session ServerConfigLoaded
, Effect.batch
[ Effect.posixTime Tick
, Effect.getServerConfig ServerConfigLoaded
]
)
@@ -114,27 +113,25 @@ type Msg
| Tick Posix
update : Msg -> Model -> ( Model, Cmd Msg )
update : Msg -> Model -> ( Model, Effect Msg )
update msg model =
case msg of
MetricsReceived (Ok metrics) ->
( updateMetrics metrics model, Cmd.none )
( updateMetrics metrics model, Effect.none )
MetricsReceived (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
ServerConfigLoaded (Ok config) ->
( { model | config = Just config }, Cmd.none )
( { model | config = Just config }, Effect.none )
ServerConfigLoaded (Err err) ->
( { model | session = Session.showFlash (HttpUtil.errorFlash err) model.session }
, Cmd.none
)
( model, Effect.showFlash (HttpUtil.errorFlash err) )
Tick time ->
( { model | now = time }, Api.getServerMetrics model.session MetricsReceived )
( { model | now = time }
, Effect.getServerMetrics MetricsReceived
)
{-| Update all metrics in Model; increment xCounter.