From 407ae87a3bb1cea52320812a6abb76f8e1ac096f Mon Sep 17 00:00:00 2001 From: James Hillyerd Date: Mon, 21 Sep 2020 20:11:32 -0700 Subject: [PATCH] ui: Add refresh button to mailbox page (#179) `socketConnected` is not implemented, but will be used when we implement #92 --- ui/src/Effect.elm | 8 +++ ui/src/Page/Mailbox.elm | 136 ++++++++++++++++++++++++++++------------ 2 files changed, 103 insertions(+), 41 deletions(-) diff --git a/ui/src/Effect.elm b/ui/src/Effect.elm index 2907417..60bdbe9 100644 --- a/ui/src/Effect.elm +++ b/ui/src/Effect.elm @@ -1,6 +1,7 @@ module Effect exposing ( Effect , addRecent + , append , batch , deleteMessage , disableRouting @@ -68,6 +69,13 @@ type SessionEffect | RoutingEnable +{-| Appends a new effect to a model/effect tuple. +-} +append : Effect msg -> ( a, Effect msg ) -> ( a, Effect msg ) +append e ( model, effect ) = + ( model, batch [ effect, e ] ) + + {-| Packs a List of Effects into a single Effect -} batch : List (Effect msg) -> Effect msg diff --git a/ui/src/Page/Mailbox.elm b/ui/src/Page/Mailbox.elm index a3a8ce9..5ebe183 100644 --- a/ui/src/Page/Mailbox.elm +++ b/ui/src/Page/Mailbox.elm @@ -94,6 +94,7 @@ type alias Model = { session : Session , mailboxName : String , state : State + , socketConnected : Bool , bodyMode : Body , searchInput : String , promptPurge : Bool @@ -107,6 +108,7 @@ init session mailboxName selection = ( { session = session , mailboxName = mailboxName , state = LoadingList selection + , socketConnected = False , bodyMode = SafeHtmlBody , searchInput = "" , promptPurge = False @@ -136,6 +138,7 @@ subscriptions _ = type Msg = ListLoaded (Result HttpUtil.Error (List MessageHeader)) | ClickMessage MessageID + | ClickRefresh | ListKeyPress String Int | CloseMessage | MessageLoaded (Result HttpUtil.Error Message) @@ -165,6 +168,21 @@ update msg model = ] ) + ClickRefresh -> + let + selection = + case model.state of + ShowingList _ (ShowingMessage message) -> + Just message.id + + _ -> + Nothing + in + -- Reset to loading state, preserving the current message selection. + ( { model | state = LoadingList selection } + , Effect.getHeaderList ListLoaded model.mailboxName + ) + CloseMessage -> case model.state of ShowingList list _ -> @@ -191,23 +209,7 @@ update msg model = ( model, Effect.none ) ListLoaded (Ok headers) -> - case model.state of - LoadingList selection -> - let - newModel = - { model - | state = ShowingList (MessageList headers Nothing "") NoMessage - } - in - case selection of - Just id -> - updateOpenMessage newModel id - - Nothing -> - ( newModel, Effect.addRecent newModel.mailboxName ) - - _ -> - ( model, Effect.none ) + updateListLoaded model headers ListLoaded (Err err) -> ( model, Effect.showFlash (HttpUtil.errorFlash err) ) @@ -262,6 +264,33 @@ update msg model = ( { model | now = now }, Effect.none ) +updateListLoaded : Model -> List MessageHeader -> ( Model, Effect Msg ) +updateListLoaded model headers = + case model.state of + LoadingList selection -> + let + newModel = + { model + | state = ShowingList (MessageList headers Nothing "") NoMessage + } + in + Effect.append (Effect.addRecent newModel.mailboxName) <| + case selection of + Just id -> + -- Don't try to load selected message if not present in headers. + if List.any (\header -> Just header.id == selection) headers then + updateOpenMessage newModel id + + else + ( newModel, Effect.updateRoute (Route.Mailbox model.mailboxName) ) + + Nothing -> + ( newModel, Effect.none ) + + _ -> + ( model, Effect.none ) + + {-| Replace the currently displayed message. -} updateMessageResult : Model -> Message -> ( Model, Effect Msg ) @@ -412,10 +441,7 @@ updateMarkMessageSeen model = updateOpenMessage : Model -> String -> ( Model, Effect Msg ) updateOpenMessage model id = ( updateSelected model id - , Effect.batch - [ Effect.addRecent model.mailboxName - , Effect.getMessage MessageLoaded model.mailboxName id - ] + , Effect.getMessage MessageLoaded model.mailboxName id ) @@ -438,26 +464,7 @@ view model = , modal = viewModal model.promptPurge , content = [ div [ class ("mailbox " ++ mode) ] - [ aside [ class "message-list-controls" ] - [ input - [ type_ "text" - , placeholder "search" - , Events.onInput OnSearchInput - , value model.searchInput - ] - [] - , button - [ Events.onClick (OnSearchInput "") - , disabled (model.searchInput == "") - , alt "Clear Search" - ] - [ i [ class "fas fa-times" ] [] ] - , button - [ Events.onClick PurgeMailboxPrompt - , alt "Purge Mailbox" - ] - [ i [ class "fas fa-trash" ] [] ] - ] + [ viewMessageListControls model , viewMessageList model , main_ [ class "message" ] @@ -498,6 +505,53 @@ viewModal promptPurge = Nothing +viewMessageListControls : Model -> Html Msg +viewMessageListControls model = + let + clearButton = + Just <| + button + [ Events.onClick (OnSearchInput "") + , disabled (model.searchInput == "") + , alt "Clear Search" + ] + [ i [ class "fas fa-times" ] [] ] + + purgeButton = + Just <| + button + [ Events.onClick PurgeMailboxPrompt + , alt "Purge Mailbox" + ] + [ i [ class "fas fa-trash" ] [] ] + + refreshButton = + if model.socketConnected then + Nothing + + else + Just <| + button + [ Events.onClick ClickRefresh + , alt "Refresh Mailbox" + ] + [ i [ class "fas fa-sync" ] [] ] + + searchInput = + Just <| + input + [ type_ "text" + , placeholder "search" + , Events.onInput OnSearchInput + , value model.searchInput + ] + [] + in + [ searchInput, clearButton, refreshButton, purgeButton ] + |> List.filterMap identity + |> aside [ class "message-list-controls" ] + + viewMessageList : Model -> Html Msg viewMessageList model = aside [ class "message-list" ] <|