go-inbucket/ui/src/Main.elm

module Main exposing
    ( Model
    , Msg(..)
    , Page(..)
    , applySession
    , init
    , main
    , pageSubscriptions
    , sessionChange
    , setRoute
    , subscriptions
    , update
    , updatePage
    , view
    )

import Browser exposing (Document, UrlRequest)
import Browser.Navigation as Nav
import Data.Session as Session exposing (Session, decoder)
import Html exposing (..)
import Json.Decode as D exposing (Value)
import Page.Home as Home
import Page.Mailbox as Mailbox
import Page.Monitor as Monitor
import Page.Status as Status
import Ports
import Route exposing (Route)
import Url exposing (Url)
import Views.Page as Page exposing (ActivePage(..), frame)



-- MODEL


type Page
    = Home Home.Model
    | Mailbox Mailbox.Model
    | Monitor Monitor.Model
    | Status Status.Model


type alias Model =
    { page : Page
    , session : Session
    , mailboxName : String
    }


init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init sessionValue location key =
    let
        session =
            Session.init key location (Session.decodeValueWithDefault sessionValue)

        ( subModel, _ ) =
            Home.init

        model =
            { page = Home subModel
            , session = session
            , mailboxName = ""
            }

        route =
            Route.fromUrl location
    in
    applySession (setRoute route model)


type Msg
    = SetRoute Route
    | UrlChanged Url
    | LinkClicked UrlRequest
    | UpdateSession (Result D.Error Session.Persistent)
    | MailboxNameInput String
    | ViewMailbox String
    | HomeMsg Home.Msg
    | MailboxMsg Mailbox.Msg
    | MonitorMsg Monitor.Msg
    | StatusMsg Status.Msg



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ pageSubscriptions model.page
        , Sub.map UpdateSession sessionChange
        ]


sessionChange : Sub (Result D.Error Session.Persistent)
sessionChange =
    Ports.onSessionChange (D.decodeValue Session.decoder)


pageSubscriptions : Page -> Sub Msg
pageSubscriptions page =
    case page of
        Mailbox subModel ->
            Sub.map MailboxMsg (Mailbox.subscriptions subModel)

        Monitor subModel ->
            Sub.map MonitorMsg (Monitor.subscriptions subModel)

        Status subModel ->
            Sub.map StatusMsg (Status.subscriptions subModel)

        _ ->
            Sub.none



-- UPDATE


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    applySession <|
        case msg of
            LinkClicked req ->
                case req of
                    Browser.Internal url ->
                        ( model, Nav.pushUrl model.session.key (Url.toString url), Session.none )

                    _ ->
                        Debug.todo "implement external links"

            UrlChanged url ->
                -- Responds to new browser URL.
                if model.session.routing then
                    setRoute (Route.fromUrl url) model

                else
                    -- Skip once, but re-enable routing.
                    ( model, Cmd.none, Session.EnableRouting )

            SetRoute route ->
                -- Updates broser URL to requested route.
                ( model, Route.newUrl model.session.key route, Session.none )

            UpdateSession (Ok persistent) ->
                let
                    session =
                        model.session
                in
                ( { model | session = { session | persistent = persistent } }
                , Cmd.none
                , Session.none
                )

            UpdateSession (Err error) ->
                let
                    _ =
                        Debug.log "Error decoding session" error
                in
                ( model, Cmd.none, Session.none )

            MailboxNameInput name ->
                ( { model | mailboxName = name }, Cmd.none, Session.none )

            ViewMailbox name ->
                ( { model | mailboxName = "" }
                , Route.newUrl model.session.key (Route.Mailbox name)
                , Session.none
                )

            _ ->
                updatePage msg model


{-| Delegates incoming messages to their respective sub-pages.
-}
updatePage : Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
updatePage msg model =
    let
        -- Handles sub-model update by calling toUpdate with subMsg & subModel, then packing the
        -- updated sub-model back into model.page.
        modelUpdate toPage toMsg subUpdate subMsg subModel =
            let
                ( newModel, subCmd, sessionMsg ) =
                    subUpdate model.session subMsg subModel
            in
            ( { model | page = toPage newModel }, Cmd.map toMsg subCmd, sessionMsg )
    in
    case ( msg, model.page ) of
        ( HomeMsg subMsg, Home subModel ) ->
            modelUpdate Home HomeMsg Home.update subMsg subModel

        ( MailboxMsg subMsg, Mailbox subModel ) ->
            modelUpdate Mailbox MailboxMsg Mailbox.update subMsg subModel

        ( MonitorMsg subMsg, Monitor subModel ) ->
            modelUpdate Monitor MonitorMsg Monitor.update subMsg subModel

        ( StatusMsg subMsg, Status subModel ) ->
            modelUpdate Status StatusMsg Status.update subMsg subModel

        ( _, _ ) ->
            -- Disregard messages destined for the wrong page.
            ( model, Cmd.none, Session.none )


setRoute : Route -> Model -> ( Model, Cmd Msg, Session.Msg )
setRoute route model =
    let
        ( newModel, newCmd, newSession ) =
            case route of
                Route.Unknown hash ->
                    ( model, Cmd.none, Session.SetFlash ("Unknown route requested: " ++ hash) )

                Route.Home ->
                    let
                        ( subModel, subCmd ) =
                            Home.init
                    in
                    ( { model | page = Home subModel }
                    , Cmd.map HomeMsg subCmd
                    , Session.none
                    )

                Route.Mailbox name ->
                    let
                        ( subModel, subCmd ) =
                            Mailbox.init name Nothing
                    in
                    ( { model | page = Mailbox subModel }
                    , Cmd.map MailboxMsg subCmd
                    , Session.none
                    )

                Route.Message mailbox id ->
                    let
                        ( subModel, subCmd ) =
                            Mailbox.init mailbox (Just id)
                    in
                    ( { model | page = Mailbox subModel }
                    , Cmd.map MailboxMsg subCmd
                    , Session.none
                    )

                Route.Monitor ->
                    let
                        ( subModel, subCmd ) =
                            Monitor.init
                    in
                    ( { model | page = Monitor subModel }
                    , Cmd.map MonitorMsg subCmd
                    , Session.none
                    )

                Route.Status ->
                    ( { model | page = Status Status.init }
                    , Cmd.map StatusMsg Status.load
                    , Session.none
                    )
    in
    case model.page of
        Monitor _ ->
            -- Leaving Monitor page, shut down the web socket.
            ( newModel, Cmd.batch [ Ports.monitorCommand False, newCmd ], newSession )

        _ ->
            ( newModel, newCmd, newSession )


applySession : ( Model, Cmd Msg, Session.Msg ) -> ( Model, Cmd Msg )
applySession ( model, cmd, sessionMsg ) =
    let
        session =
            Session.update sessionMsg model.session

        newModel =
            { model | session = session }
    in
    if session.persistent == model.session.persistent then
        -- No change
        ( newModel, cmd )

    else
        ( newModel
        , Cmd.batch [ cmd, Ports.storeSession session.persistent ]
        )



-- VIEW


view : Model -> Document Msg
view model =
    let
        mailbox =
            case model.page of
                Mailbox subModel ->
                    subModel.mailboxName

                _ ->
                    ""

        controls =
            { viewMailbox = ViewMailbox
            , mailboxOnInput = MailboxNameInput
            , mailboxValue = model.mailboxName
            , recentOptions = model.session.persistent.recentMailboxes
            , recentActive = mailbox
            }

        framePage :
            ActivePage
            -> (msg -> Msg)
            -> { title : String, content : Html msg }
            -> Document Msg
        framePage page toMsg { title, content } =
            Document title
                [ content
                    |> Html.map toMsg
                    |> Page.frame controls model.session page
                ]
    in
    case model.page of
        Home subModel ->
            framePage Page.Other HomeMsg (Home.view model.session subModel)

        Mailbox subModel ->
            framePage Page.Mailbox MailboxMsg (Mailbox.view model.session subModel)

        Monitor subModel ->
            framePage Page.Monitor MonitorMsg (Monitor.view model.session subModel)

        Status subModel ->
            framePage Page.Status StatusMsg (Status.view model.session subModel)



-- MAIN


main : Program Value Model Msg
main =
    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        , onUrlChange = UrlChanged
        , onUrlRequest = LinkClicked
        }