From 8bb9adb307906c2e3644d1ced43b3ce75a066837 Mon Sep 17 00:00:00 2001 From: Nicolas Perriault Date: Sun, 30 Apr 2017 11:08:30 +0200 Subject: [PATCH] Add more scroll events when navigating timelines. --- src/Command.elm | 21 +++++++++++++++++++++ src/Model.elm | 18 ++++++++++-------- src/Types.elm | 27 ++++++++++++++++----------- src/View.elm | 10 +++------- 4 files changed, 50 insertions(+), 26 deletions(-) diff --git a/src/Command.elm b/src/Command.elm index aa6a059..2d9689b 100644 --- a/src/Command.elm +++ b/src/Command.elm @@ -22,14 +22,20 @@ module Command , unfavouriteStatus , follow , unfollow + , focusId + , scrollColumnToTop + , scrollColumnToBottom ) +import Dom +import Dom.Scroll import Json.Encode as Encode import Mastodon.Model exposing (..) import Mastodon.Encoder import Mastodon.Http import Navigation import Ports +import Task import Types exposing (..) @@ -287,3 +293,18 @@ unfollow client id = Nothing -> Cmd.none + + +focusId : String -> Cmd Msg +focusId id = + Dom.focus id |> Task.attempt (always NoOp) + + +scrollColumnToTop : String -> Cmd Msg +scrollColumnToTop column = + Task.attempt (always NoOp) <| Dom.Scroll.toTop column + + +scrollColumnToBottom : String -> Cmd Msg +scrollColumnToBottom column = + Task.attempt (always NoOp) <| Dom.Scroll.toBottom column diff --git a/src/Model.elm b/src/Model.elm index 4ba0b3c..6834f83 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -1,14 +1,11 @@ module Model exposing (..) import Command -import Dom -import Dom.Scroll import Navigation import Mastodon.Decoder import Mastodon.Helper import Mastodon.Model exposing (..) import Mastodon.WebSocket -import Task import Types exposing (..) @@ -224,7 +221,7 @@ updateDraft draftMsg currentUser draft = Just status.spoiler_text , visibility = status.visibility } - ! [ Dom.focus "status" |> Task.attempt (always NoOp) ] + ! [ Command.focusId "status" ] updateViewer : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg ) @@ -286,7 +283,8 @@ processMastodonEvent msg model = ContextLoaded status result -> case result of Ok context -> - { model | currentView = ThreadView (Thread status context) } ! [] + { model | currentView = ThreadView (Thread status context) } + ! [ Command.scrollColumnToBottom "thread" ] Err error -> { model @@ -352,7 +350,8 @@ processMastodonEvent msg model = { model | errors = (errorText error) :: model.errors } ! [] StatusPosted _ -> - { model | draft = defaultDraft } ! [] + { model | draft = defaultDraft } + ! [ Command.scrollColumnToTop "home" ] StatusDeleted result -> case result of @@ -644,8 +643,11 @@ update msg model = } ! [] - ScrollColumn context -> - model ! [ Task.attempt (always NoOp) <| Dom.Scroll.toTop context ] + ScrollColumn ScrollTop column -> + model ! [ Command.scrollColumnToTop column ] + + ScrollColumn ScrollBottom column -> + model ! [ Command.scrollColumnToBottom column ] subscriptions : Model -> Sub Msg diff --git a/src/Types.elm b/src/Types.elm index d5ce6b4..7ce9882 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -70,7 +70,7 @@ type Msg | ReblogStatus Int | Register | RemoveFavorite Int - | ScrollColumn String + | ScrollColumn ScrollDirection String | ServerChange String | SubmitDraft | UnfollowAccount Int @@ -92,6 +92,16 @@ type alias AccountViewInfo = } +type CurrentView + = -- Basically, what we should be displaying in the fourth column + AccountFollowersView Account (List Account) + | AccountFollowingView Account (List Account) + | AccountView Account + | GlobalTimelineView + | LocalTimelineView + | ThreadView Thread + + type alias Draft = { status : String , in_reply_to : Maybe Status @@ -101,6 +111,11 @@ type alias Draft = } +type ScrollDirection + = ScrollTop + | ScrollBottom + + type alias Thread = { status : Status , context : Context @@ -113,16 +128,6 @@ type alias Viewer = } -type CurrentView - = -- Basically, what we should be displaying in the fourth column - AccountFollowersView Account (List Account) - | AccountFollowingView Account (List Account) - | AccountView Account - | GlobalTimelineView - | LocalTimelineView - | ThreadView Thread - - type alias Model = { server : String , registration : Maybe AppRegistration diff --git a/src/View.elm b/src/View.elm index 6ba47e8..8deeab5 100644 --- a/src/View.elm +++ b/src/View.elm @@ -178,10 +178,6 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as let accountLinkAttributes = [ href account.url - - -- When clicking on a status, we should not let the browser - -- redirect to a new page. That's why we're preventing the default - -- behavior here , onClickWithPreventAndStop (LoadAccount account.id) ] in @@ -433,7 +429,7 @@ timelineView label iconName context currentUser statuses = div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] [ a - [ href "", onClickWithPreventAndStop <| ScrollColumn context ] + [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop context ] [ div [ class "panel-heading" ] [ icon iconName, text label ] ] , ul [ id context, class "list-group timeline" ] <| List.map (statusEntryView context "" currentUser) statuses @@ -509,7 +505,7 @@ notificationListView currentUser notifications = div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] [ a - [ href "", onClickWithPreventAndStop <| ScrollColumn "notifications" ] + [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop "notifications" ] [ div [ class "panel-heading" ] [ icon "bell", text "Notifications" ] ] , ul [ id "notifications", class "list-group timeline" ] <| List.map (notificationEntryView currentUser) notifications @@ -692,7 +688,7 @@ threadView currentUser thread = div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] [ closeablePanelheading "list" "Thread" CloseThread - , ul [ class "list-group timeline" ] <| + , ul [ id "thread", class "list-group timeline" ] <| List.map threadEntry statuses ] ]