mirror of
https://github.com/jhillyerd/inbucket.git
synced 2025-12-17 09:37:02 +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:
@@ -1,5 +1,7 @@
|
||||
module Api exposing
|
||||
( deleteMessage
|
||||
( DataResult
|
||||
, HttpResult
|
||||
, deleteMessage
|
||||
, getGreeting
|
||||
, getHeaderList
|
||||
, getMessage
|
||||
|
||||
304
ui/src/Effect.elm
Normal file
304
ui/src/Effect.elm
Normal file
@@ -0,0 +1,304 @@
|
||||
module Effect exposing
|
||||
( Effect
|
||||
, addRecent
|
||||
, batch
|
||||
, deleteMessage
|
||||
, disableRouting
|
||||
, enableRouting
|
||||
, getGreeting
|
||||
, getHeaderList
|
||||
, getMessage
|
||||
, getServerConfig
|
||||
, getServerMetrics
|
||||
, map
|
||||
, markMessageSeen
|
||||
, none
|
||||
, perform
|
||||
, posixTime
|
||||
, purgeMailbox
|
||||
, schedule
|
||||
, showFlash
|
||||
, wrap
|
||||
)
|
||||
|
||||
import Api exposing (DataResult, HttpResult)
|
||||
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 Task
|
||||
import Time
|
||||
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)
|
||||
| SessionEffect SessionEffect
|
||||
|
||||
|
||||
type ApiEffect msg
|
||||
= DeleteMessage (HttpResult msg) String String
|
||||
| GetGreeting (DataResult msg String)
|
||||
| GetServerConfig (DataResult msg ServerConfig)
|
||||
| GetServerMetrics (DataResult msg Metrics)
|
||||
| GetHeaderList (DataResult msg (List MessageHeader)) String
|
||||
| GetMessage (DataResult msg Message) String String
|
||||
| MarkMessageSeen (HttpResult msg) String String
|
||||
| PurgeMailbox (HttpResult msg) String
|
||||
|
||||
|
||||
type SessionEffect
|
||||
= FlashClear
|
||||
| FlashShow Session.Flash
|
||||
| RecentAdd String
|
||||
| RoutingDisable
|
||||
| RoutingEnable
|
||||
|
||||
|
||||
{-| Packs a List of Effects into a single Effect
|
||||
-}
|
||||
batch : List (Effect msg) -> Effect msg
|
||||
batch effects =
|
||||
Batch effects
|
||||
|
||||
|
||||
{-| Transform message types produced by an effect.
|
||||
-}
|
||||
map : (a -> b) -> Effect a -> Effect b
|
||||
map f effect =
|
||||
case effect of
|
||||
None ->
|
||||
None
|
||||
|
||||
Batch effects ->
|
||||
Batch <| List.map (map f) effects
|
||||
|
||||
Command cmd ->
|
||||
Command <| Cmd.map f cmd
|
||||
|
||||
PosixTime toMsg ->
|
||||
PosixTime <| toMsg >> f
|
||||
|
||||
ScheduleTimer toMsg timer millis ->
|
||||
ScheduleTimer (toMsg >> f) timer millis
|
||||
|
||||
ApiEffect apiEffect ->
|
||||
ApiEffect <| mapApi f apiEffect
|
||||
|
||||
SessionEffect sessionEffect ->
|
||||
SessionEffect sessionEffect
|
||||
|
||||
|
||||
mapApi : (a -> b) -> ApiEffect a -> ApiEffect b
|
||||
mapApi f effect =
|
||||
case effect of
|
||||
DeleteMessage result mailbox id ->
|
||||
DeleteMessage (result >> f) mailbox id
|
||||
|
||||
GetGreeting result ->
|
||||
GetGreeting (result >> f)
|
||||
|
||||
GetServerConfig result ->
|
||||
GetServerConfig (result >> f)
|
||||
|
||||
GetServerMetrics result ->
|
||||
GetServerMetrics (result >> f)
|
||||
|
||||
GetHeaderList result mailbox ->
|
||||
GetHeaderList (result >> f) mailbox
|
||||
|
||||
GetMessage result mailbox id ->
|
||||
GetMessage (result >> f) mailbox id
|
||||
|
||||
MarkMessageSeen result mailbox id ->
|
||||
MarkMessageSeen (result >> f) mailbox id
|
||||
|
||||
PurgeMailbox result mailbox ->
|
||||
PurgeMailbox (result >> f) mailbox
|
||||
|
||||
|
||||
{-| Applies an effect by updating the session and/or producing a Cmd.
|
||||
-}
|
||||
perform : ( Session, Effect msg ) -> ( Session, Cmd msg )
|
||||
perform ( session, effect ) =
|
||||
case effect of
|
||||
None ->
|
||||
( session, Cmd.none )
|
||||
|
||||
Batch effects ->
|
||||
List.foldl batchPerform ( session, [] ) effects
|
||||
|> Tuple.mapSecond Cmd.batch
|
||||
|
||||
Command cmd ->
|
||||
( session, cmd )
|
||||
|
||||
PosixTime toMsg ->
|
||||
( session, Task.perform toMsg Time.now )
|
||||
|
||||
ScheduleTimer toMsg timer millis ->
|
||||
( session, Timer.schedule toMsg timer millis )
|
||||
|
||||
ApiEffect apiEffect ->
|
||||
performApi ( session, apiEffect )
|
||||
|
||||
SessionEffect sessionEffect ->
|
||||
performSession ( session, sessionEffect )
|
||||
|
||||
|
||||
performApi : ( Session, ApiEffect msg ) -> ( Session, Cmd msg )
|
||||
performApi ( session, effect ) =
|
||||
case effect of
|
||||
DeleteMessage toMsg mailbox id ->
|
||||
( session, Api.deleteMessage session toMsg mailbox id )
|
||||
|
||||
GetGreeting toMsg ->
|
||||
( session, Api.getGreeting session toMsg )
|
||||
|
||||
GetServerConfig toMsg ->
|
||||
( session, Api.getServerConfig session toMsg )
|
||||
|
||||
GetServerMetrics toMsg ->
|
||||
( session, Api.getServerMetrics session toMsg )
|
||||
|
||||
GetHeaderList toMsg mailbox ->
|
||||
( session, Api.getHeaderList session toMsg mailbox )
|
||||
|
||||
GetMessage toMsg mailbox id ->
|
||||
( session, Api.getMessage session toMsg mailbox id )
|
||||
|
||||
MarkMessageSeen toMsg mailbox id ->
|
||||
( session, Api.markMessageSeen session toMsg mailbox id )
|
||||
|
||||
PurgeMailbox toMsg mailbox ->
|
||||
( session, Api.purgeMailbox session toMsg mailbox )
|
||||
|
||||
|
||||
performSession : ( Session, SessionEffect ) -> ( Session, Cmd msg )
|
||||
performSession ( session, effect ) =
|
||||
case effect of
|
||||
RecentAdd mailbox ->
|
||||
( Session.addRecent mailbox session, Cmd.none )
|
||||
|
||||
FlashClear ->
|
||||
( Session.clearFlash session, Cmd.none )
|
||||
|
||||
FlashShow flash ->
|
||||
( Session.showFlash flash session, Cmd.none )
|
||||
|
||||
RoutingDisable ->
|
||||
( Session.disableRouting session, Cmd.none )
|
||||
|
||||
RoutingEnable ->
|
||||
( Session.enableRouting session, Cmd.none )
|
||||
|
||||
|
||||
|
||||
-- EFFECT CONSTRUCTORS
|
||||
|
||||
|
||||
none : Effect msg
|
||||
none =
|
||||
None
|
||||
|
||||
|
||||
{-| Adds specified mailbox to the recently viewed list
|
||||
-}
|
||||
addRecent : String -> Effect msg
|
||||
addRecent mailbox =
|
||||
SessionEffect (RecentAdd mailbox)
|
||||
|
||||
|
||||
disableRouting : Effect msg
|
||||
disableRouting =
|
||||
SessionEffect RoutingDisable
|
||||
|
||||
|
||||
enableRouting : Effect msg
|
||||
enableRouting =
|
||||
SessionEffect RoutingEnable
|
||||
|
||||
|
||||
clearFlash : Effect msg
|
||||
clearFlash =
|
||||
SessionEffect FlashClear
|
||||
|
||||
|
||||
showFlash : Session.Flash -> Effect msg
|
||||
showFlash flash =
|
||||
SessionEffect (FlashShow flash)
|
||||
|
||||
|
||||
deleteMessage : HttpResult msg -> String -> String -> Effect msg
|
||||
deleteMessage toMsg mailboxName id =
|
||||
ApiEffect (DeleteMessage toMsg mailboxName id)
|
||||
|
||||
|
||||
getGreeting : DataResult msg String -> Effect msg
|
||||
getGreeting toMsg =
|
||||
ApiEffect (GetGreeting toMsg)
|
||||
|
||||
|
||||
getHeaderList : DataResult msg (List MessageHeader) -> String -> Effect msg
|
||||
getHeaderList toMsg mailboxName =
|
||||
ApiEffect (GetHeaderList toMsg mailboxName)
|
||||
|
||||
|
||||
getServerConfig : DataResult msg ServerConfig -> Effect msg
|
||||
getServerConfig toMsg =
|
||||
ApiEffect (GetServerConfig toMsg)
|
||||
|
||||
|
||||
getServerMetrics : DataResult msg Metrics -> Effect msg
|
||||
getServerMetrics toMsg =
|
||||
ApiEffect (GetServerMetrics toMsg)
|
||||
|
||||
|
||||
getMessage : DataResult msg Message -> String -> String -> Effect msg
|
||||
getMessage toMsg mailboxName id =
|
||||
ApiEffect (GetMessage toMsg mailboxName id)
|
||||
|
||||
|
||||
markMessageSeen : HttpResult msg -> String -> String -> Effect msg
|
||||
markMessageSeen toMsg mailboxName id =
|
||||
ApiEffect (MarkMessageSeen toMsg mailboxName id)
|
||||
|
||||
|
||||
posixTime : (Time.Posix -> msg) -> Effect msg
|
||||
posixTime toMsg =
|
||||
PosixTime toMsg
|
||||
|
||||
|
||||
purgeMailbox : HttpResult msg -> String -> Effect msg
|
||||
purgeMailbox toMsg mailboxName =
|
||||
ApiEffect (PurgeMailbox toMsg mailboxName)
|
||||
|
||||
|
||||
{-| Schedules a Timer to fire after the specified delay.
|
||||
-}
|
||||
schedule : (Timer -> msg) -> Timer -> Float -> Effect msg
|
||||
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.
|
||||
-}
|
||||
wrap : Cmd msg -> Effect msg
|
||||
wrap cmd =
|
||||
Command cmd
|
||||
|
||||
|
||||
|
||||
-- UTILITY
|
||||
|
||||
|
||||
batchPerform : Effect msg -> ( Session, List (Cmd msg) ) -> ( Session, List (Cmd msg) )
|
||||
batchPerform effect ( session, cmds ) =
|
||||
perform ( session, effect )
|
||||
|> Tuple.mapSecond (\cmd -> cmd :: cmds)
|
||||
100
ui/src/Main.elm
100
ui/src/Main.elm
@@ -4,6 +4,7 @@ import Browser exposing (Document, UrlRequest)
|
||||
import Browser.Navigation as Nav
|
||||
import Data.AppConfig as AppConfig exposing (AppConfig)
|
||||
import Data.Session as Session exposing (Session)
|
||||
import Effect exposing (Effect)
|
||||
import Html exposing (Html)
|
||||
import Json.Decode as D exposing (Value)
|
||||
import Layout
|
||||
@@ -58,6 +59,8 @@ init configValue location key =
|
||||
Session.initError key location (D.errorToString error)
|
||||
|
||||
( subModel, _ ) =
|
||||
-- Home.init effect is discarded because this subModel will be immediately replaced
|
||||
-- when we change routes to the specified location.
|
||||
Home.init session
|
||||
|
||||
initModel =
|
||||
@@ -67,11 +70,9 @@ init configValue location key =
|
||||
|
||||
route =
|
||||
session.router.fromUrl location
|
||||
|
||||
( model, cmd ) =
|
||||
changeRouteTo route initModel
|
||||
in
|
||||
( model, Cmd.batch [ cmd, Task.perform TimeZoneLoaded Time.here ] )
|
||||
changeRouteTo route initModel
|
||||
|> Tuple.mapSecond (\cmd -> Cmd.batch [ cmd, Task.perform TimeZoneLoaded Time.here ])
|
||||
|
||||
|
||||
type Msg
|
||||
@@ -206,12 +207,12 @@ updateMain msg model session =
|
||||
)
|
||||
|
||||
_ ->
|
||||
updatePage msg model
|
||||
updatePage msg model |> performEffects
|
||||
|
||||
|
||||
{-| Delegate incoming messages to their respective sub-pages.
|
||||
-}
|
||||
updatePage : Msg -> Model -> ( Model, Cmd Msg )
|
||||
updatePage : Msg -> Model -> ( Model, Effect Msg )
|
||||
updatePage msg model =
|
||||
case ( msg, model.page ) of
|
||||
( HomeMsg subMsg, Home subModel ) ->
|
||||
@@ -232,61 +233,70 @@ updatePage msg model =
|
||||
|
||||
( _, _ ) ->
|
||||
-- Disregard messages destined for the wrong page.
|
||||
( model, Cmd.none )
|
||||
( model, Effect.none )
|
||||
|
||||
|
||||
changeRouteTo : Route -> Model -> ( Model, Cmd Msg )
|
||||
changeRouteTo route model =
|
||||
let
|
||||
session =
|
||||
getSession model |> Session.clearFlash
|
||||
Session.clearFlash (getSession model)
|
||||
|
||||
newModel =
|
||||
{ model | layout = Layout.reset model.layout }
|
||||
in
|
||||
case route of
|
||||
Route.Home ->
|
||||
Home.init session
|
||||
|> updateWith Home HomeMsg newModel
|
||||
performEffects <|
|
||||
case route of
|
||||
Route.Home ->
|
||||
Home.init session
|
||||
|> updateWith Home HomeMsg newModel
|
||||
|
||||
Route.Mailbox name ->
|
||||
Mailbox.init session name Nothing
|
||||
|> updateWith Mailbox MailboxMsg newModel
|
||||
Route.Mailbox name ->
|
||||
Mailbox.init session name Nothing
|
||||
|> updateWith Mailbox MailboxMsg newModel
|
||||
|
||||
Route.Message mailbox id ->
|
||||
Mailbox.init session mailbox (Just id)
|
||||
|> updateWith Mailbox MailboxMsg newModel
|
||||
Route.Message mailbox id ->
|
||||
Mailbox.init session mailbox (Just id)
|
||||
|> updateWith Mailbox MailboxMsg newModel
|
||||
|
||||
Route.Monitor ->
|
||||
if session.config.monitorVisible then
|
||||
Monitor.init session
|
||||
|> updateWith Monitor MonitorMsg newModel
|
||||
Route.Monitor ->
|
||||
if session.config.monitorVisible then
|
||||
Monitor.init session
|
||||
|> updateWith Monitor MonitorMsg newModel
|
||||
|
||||
else
|
||||
else
|
||||
let
|
||||
flash =
|
||||
{ title = "Disabled route requested"
|
||||
, table = [ ( "Error", "Monitor disabled by configuration." ) ]
|
||||
}
|
||||
in
|
||||
( applyToModelSession (Session.showFlash flash) newModel
|
||||
, Effect.none
|
||||
)
|
||||
|
||||
Route.Status ->
|
||||
Status.init session
|
||||
|> updateWith Status StatusMsg newModel
|
||||
|
||||
Route.Unknown path ->
|
||||
-- Unknown routes display Home with an error flash.
|
||||
let
|
||||
flash =
|
||||
{ title = "Disabled route requested"
|
||||
, table = [ ( "Error", "Monitor disabled by configuration." ) ]
|
||||
{ title = "Unknown route requested"
|
||||
, table = [ ( "Path", path ) ]
|
||||
}
|
||||
in
|
||||
( applyToModelSession (Session.showFlash flash) newModel
|
||||
, Cmd.none
|
||||
)
|
||||
Home.init (Session.showFlash flash session)
|
||||
|> updateWith Home HomeMsg newModel
|
||||
|
||||
Route.Status ->
|
||||
Status.init session
|
||||
|> updateWith Status StatusMsg newModel
|
||||
|
||||
Route.Unknown path ->
|
||||
-- Unknown routes display Home with an error flash.
|
||||
let
|
||||
flash =
|
||||
{ title = "Unknown route requested"
|
||||
, table = [ ( "Path", path ) ]
|
||||
}
|
||||
in
|
||||
Home.init (Session.showFlash flash session)
|
||||
|> updateWith Home HomeMsg newModel
|
||||
{-| Perform effects by updating model and/or producing Cmds to be executed.
|
||||
-}
|
||||
performEffects : ( Model, Effect Msg ) -> ( Model, Cmd Msg )
|
||||
performEffects ( model, effect ) =
|
||||
Effect.perform ( getSession model, effect )
|
||||
|> Tuple.mapFirst (\newSession -> updateSession model newSession)
|
||||
|
||||
|
||||
getSession : Model -> Session
|
||||
@@ -332,11 +342,11 @@ updateWith :
|
||||
(subModel -> PageModel)
|
||||
-> (subMsg -> Msg)
|
||||
-> Model
|
||||
-> ( subModel, Cmd subMsg )
|
||||
-> ( Model, Cmd Msg )
|
||||
updateWith toPage toMsg model ( subModel, subCmd ) =
|
||||
-> ( subModel, Effect subMsg )
|
||||
-> ( Model, Effect Msg )
|
||||
updateWith toPage toMsg model ( subModel, subEffect ) =
|
||||
( { model | page = toPage subModel }
|
||||
, Cmd.map toMsg subCmd
|
||||
, Effect.map toMsg subEffect
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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) )
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -49,6 +49,8 @@ cancel previous =
|
||||
previous
|
||||
|
||||
|
||||
{-| Increments the timer identity, preventing integer overflow.
|
||||
-}
|
||||
next : Int -> Int
|
||||
next index =
|
||||
if index > 2 ^ 30 then
|
||||
|
||||
Reference in New Issue
Block a user