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:
James Hillyerd
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)
|
||||
Reference in New Issue
Block a user