go-inbucket/ui/src/Effect.elm

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)