From 8832b3156f09bf3752a5fa6d3169ad76ea086f44 Mon Sep 17 00:00:00 2001 From: Nicolas Perriault Date: Sun, 7 May 2017 14:31:51 +0200 Subject: [PATCH] Closes #132: Split model update functions to their own modules. (#147) --- public/style.css | 3 + src/Init.elm | 35 ++ src/Main.elm | 4 +- src/Mastodon/Helper.elm | 6 + src/Model.elm | 1136 -------------------------------------- src/Subscription.elm | 42 ++ src/Update/Draft.elm | 271 +++++++++ src/Update/Error.elm | 12 + src/Update/Main.elm | 166 ++++++ src/Update/Mastodon.elm | 308 +++++++++++ src/Update/Timeline.elm | 225 ++++++++ src/Update/Viewer.elm | 13 + src/Update/WebSocket.elm | 101 ++++ src/Util.elm | 30 + src/View/Common.elm | 1 - src/View/Draft.elm | 4 +- 16 files changed, 1217 insertions(+), 1140 deletions(-) create mode 100644 src/Init.elm delete mode 100644 src/Model.elm create mode 100644 src/Subscription.elm create mode 100644 src/Update/Draft.elm create mode 100644 src/Update/Error.elm create mode 100644 src/Update/Main.elm create mode 100644 src/Update/Mastodon.elm create mode 100644 src/Update/Timeline.elm create mode 100644 src/Update/Viewer.elm create mode 100644 src/Update/WebSocket.elm create mode 100644 src/Util.elm diff --git a/public/style.css b/public/style.css index 4b93e5d..4bd5444 100644 --- a/public/style.css +++ b/public/style.css @@ -54,6 +54,9 @@ body { overflow-y: scroll; } +li.load-more { + cursor: wait; +} .notifications-panel .timeline { max-height: calc(100vh - 100px); diff --git a/src/Init.elm b/src/Init.elm new file mode 100644 index 0000000..905eec7 --- /dev/null +++ b/src/Init.elm @@ -0,0 +1,35 @@ +module Init exposing (init) + +import Command +import Navigation +import Types exposing (..) +import Update.Draft +import Update.Timeline +import Util + + +init : Flags -> Navigation.Location -> ( Model, Cmd Msg ) +init { registration, client } location = + { server = "" + , currentTime = 0 + , registration = registration + , client = client + , homeTimeline = Update.Timeline.empty "home-timeline" + , localTimeline = Update.Timeline.empty "local-timeline" + , globalTimeline = Update.Timeline.empty "global-timeline" + , accountTimeline = Update.Timeline.empty "account-timeline" + , accountFollowers = [] + , accountFollowing = [] + , accountRelationships = [] + , accountRelationship = Nothing + , notifications = Update.Timeline.empty "notifications" + , draft = Update.Draft.empty + , errors = [] + , location = location + , useGlobalTimeline = False + , viewer = Nothing + , currentView = LocalTimelineView + , currentUser = Nothing + , notificationFilter = NotificationAll + } + ! [ Command.initCommands registration client (Util.extractAuthCode location) ] diff --git a/src/Main.elm b/src/Main.elm index becf5e5..e5edfd9 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -2,8 +2,10 @@ module Main exposing (main) import Navigation import View.App exposing (view) -import Model exposing (..) +import Init exposing (init) +import Subscription exposing (subscriptions) import Types exposing (..) +import Update.Main exposing (update) main : Program Flags Model Msg diff --git a/src/Mastodon/Helper.elm b/src/Mastodon/Helper.elm index e889b94..6f753e9 100644 --- a/src/Mastodon/Helper.elm +++ b/src/Mastodon/Helper.elm @@ -6,6 +6,7 @@ module Mastodon.Helper , getReplyPrefix , notificationToAggregate , sameAccount + , statusReferenced ) import List.Extra exposing (groupWhile, uniqueBy) @@ -170,3 +171,8 @@ sameAccount : Mastodon.Model.Account -> Mastodon.Model.Account -> Bool sameAccount { id, acct, username } account = -- Note: different instances can share the same id for different accounts. id == account.id && acct == account.acct && username == account.username + + +statusReferenced : Int -> Status -> Bool +statusReferenced id status = + status.id == id || (extractReblog status).id == id diff --git a/src/Model.elm b/src/Model.elm deleted file mode 100644 index a504329..0000000 --- a/src/Model.elm +++ /dev/null @@ -1,1136 +0,0 @@ -module Model exposing (..) - -import Autocomplete -import Command -import List.Extra exposing (removeAt) -import Navigation -import Mastodon.Decoder -import Mastodon.Helper -import Mastodon.Http exposing (Links) -import Mastodon.Model exposing (..) -import Mastodon.WebSocket -import String.Extra -import Task -import Time -import Types exposing (..) - - -maxBuffer : Int -maxBuffer = - -- Max number of entries to keep in columns - 100 - - -extractAuthCode : Navigation.Location -> Maybe String -extractAuthCode { search } = - case (String.split "?code=" search) of - [ _, authCode ] -> - Just authCode - - _ -> - Nothing - - -defaultDraft : Draft -defaultDraft = - { status = "" - , inReplyTo = Nothing - , spoilerText = Nothing - , sensitive = False - , visibility = "public" - , statusLength = 0 - , autoState = Autocomplete.empty - , autoAtPosition = Nothing - , autoQuery = "" - , autoCursorPosition = 0 - , autoMaxResults = 4 - , autoAccounts = [] - , showAutoMenu = False - } - - -init : Flags -> Navigation.Location -> ( Model, Cmd Msg ) -init flags location = - let - authCode = - extractAuthCode location - in - { server = "" - , currentTime = 0 - , registration = flags.registration - , client = flags.client - , homeTimeline = emptyTimeline "home-timeline" - , localTimeline = emptyTimeline "local-timeline" - , globalTimeline = emptyTimeline "global-timeline" - , accountTimeline = emptyTimeline "account-timeline" - , accountFollowers = [] - , accountFollowing = [] - , accountRelationships = [] - , accountRelationship = Nothing - , notifications = emptyTimeline "notifications" - , draft = defaultDraft - , errors = [] - , location = location - , useGlobalTimeline = False - , viewer = Nothing - , currentView = LocalTimelineView - , currentUser = Nothing - , notificationFilter = NotificationAll - } - ! [ Command.initCommands flags.registration flags.client authCode ] - - -emptyTimeline : String -> Timeline a -emptyTimeline id = - { id = id - , entries = [] - , links = Links Nothing Nothing - , loading = False - } - - -addErrorNotification : String -> Model -> List ErrorNotification -addErrorNotification message model = - let - error = - { message = message, time = model.currentTime } - in - error :: model.errors - - -preferredTimeline : Model -> CurrentView -preferredTimeline model = - if model.useGlobalTimeline then - GlobalTimelineView - else - LocalTimelineView - - -errorText : Error -> String -errorText error = - case error of - MastodonError statusCode statusMsg errorMsg -> - "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - - ServerError statusCode statusMsg errorMsg -> - "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg - - TimeoutError -> - "Request timed out." - - NetworkError -> - "Unreachable host." - - -toStatusRequestBody : Draft -> StatusRequestBody -toStatusRequestBody draft = - { status = draft.status - , in_reply_to_id = - case draft.inReplyTo of - Just status -> - Just status.id - - Nothing -> - Nothing - , spoiler_text = draft.spoilerText - , sensitive = draft.sensitive - , visibility = draft.visibility - } - - -updateTimelinesWithBoolFlag : Int -> Bool -> (Status -> Status) -> Model -> Model -updateTimelinesWithBoolFlag statusId flag statusUpdater model = - let - updateStatus status = - if (Mastodon.Helper.extractReblog status).id == statusId then - statusUpdater status - else - status - - updateNotification notification = - case notification.status of - Just status -> - { notification | status = Just <| updateStatus status } - - Nothing -> - notification - - updateTimeline updateEntry timeline = - { timeline | entries = List.map updateEntry timeline.entries } - in - { model - | homeTimeline = updateTimeline updateStatus model.homeTimeline - , accountTimeline = updateTimeline updateStatus model.accountTimeline - , localTimeline = updateTimeline updateStatus model.localTimeline - , globalTimeline = updateTimeline updateStatus model.globalTimeline - , notifications = updateTimeline updateNotification model.notifications - , currentView = - case model.currentView of - ThreadView thread -> - ThreadView - { status = updateStatus thread.status - , context = - { ancestors = List.map updateStatus thread.context.ancestors - , descendants = List.map updateStatus thread.context.descendants - } - } - - currentView -> - currentView - } - - -processFavourite : Int -> Bool -> Model -> Model -processFavourite statusId flag model = - updateTimelinesWithBoolFlag statusId - flag - (\s -> - { s - | favourited = Just flag - , favourites_count = - if flag then - s.favourites_count + 1 - else if s.favourites_count > 0 then - s.favourites_count - 1 - else - 0 - } - ) - model - - -processReblog : Int -> Bool -> Model -> Model -processReblog statusId flag model = - updateTimelinesWithBoolFlag statusId - flag - (\s -> - { s - | reblogged = Just flag - , reblogs_count = - if flag then - s.reblogs_count + 1 - else if s.reblogs_count > 0 then - s.reblogs_count - 1 - else - 0 - } - ) - model - - -deleteStatusFromTimeline : Int -> Timeline Status -> Timeline Status -deleteStatusFromTimeline statusId timeline = - let - update status = - status.id - /= statusId - && (Mastodon.Helper.extractReblog status).id - /= statusId - in - { timeline | entries = List.filter update timeline.entries } - - -deleteStatusFromAllTimelines : Int -> Model -> Model -deleteStatusFromAllTimelines id model = - { model - | homeTimeline = deleteStatusFromTimeline id model.homeTimeline - , localTimeline = deleteStatusFromTimeline id model.localTimeline - , globalTimeline = deleteStatusFromTimeline id model.globalTimeline - , accountTimeline = deleteStatusFromTimeline id model.accountTimeline - , notifications = deleteStatusFromNotifications id model.notifications - , currentView = deleteStatusFromCurrentView id model - } - - -deleteStatusFromNotifications : Int -> Timeline NotificationAggregate -> Timeline NotificationAggregate -deleteStatusFromNotifications statusId notifications = - let - update notification = - case notification.status of - Just status -> - status.id - /= statusId - && (Mastodon.Helper.extractReblog status).id - /= statusId - - Nothing -> - True - in - { notifications | entries = List.filter update notifications.entries } - - -deleteStatusFromCurrentView : Int -> Model -> CurrentView -deleteStatusFromCurrentView id model = - -- Note: account timeline is already cleaned in deleteStatusFromAllTimelines - case model.currentView of - ThreadView thread -> - if thread.status.id == id then - -- the current thread status as been deleted, close it - preferredTimeline model - else - let - update statuses = - List.filter (\s -> s.id /= id) statuses - in - ThreadView - { thread - | context = - { ancestors = update thread.context.ancestors - , descendants = update thread.context.descendants - } - } - - currentView -> - currentView - - -{-| Update viewed account relationships as well as the relationship with the -current connected user, both according to the "following" status provided. --} -processFollowEvent : Relationship -> Bool -> Model -> Model -processFollowEvent relationship flag model = - let - updateRelationship r = - if r.id == relationship.id then - { r | following = flag } - else - r - - accountRelationships = - model.accountRelationships |> List.map updateRelationship - - accountRelationship = - case model.accountRelationship of - Just accountRelationship -> - if accountRelationship.id == relationship.id then - Just { relationship | following = flag } - else - model.accountRelationship - - Nothing -> - Nothing - in - { model - | accountRelationships = accountRelationships - , accountRelationship = accountRelationship - } - - -updateDraft : DraftMsg -> Account -> Model -> ( Model, Cmd Msg ) -updateDraft draftMsg currentUser model = - let - draft = - model.draft - in - case draftMsg of - ClearDraft -> - { model | draft = defaultDraft } - ! [ Command.updateDomStatus defaultDraft.status ] - - ToggleSpoiler enabled -> - let - newDraft = - { draft - | spoilerText = - if enabled then - Just "" - else - Nothing - } - in - { model | draft = newDraft } ! [] - - UpdateSensitive sensitive -> - { model | draft = { draft | sensitive = sensitive } } ! [] - - UpdateSpoiler spoilerText -> - { model | draft = { draft | spoilerText = Just spoilerText } } ! [] - - UpdateVisibility visibility -> - { model | draft = { draft | visibility = visibility } } ! [] - - UpdateReplyTo status -> - let - newStatus = - Mastodon.Helper.getReplyPrefix currentUser status - in - { model - | draft = - { draft - | inReplyTo = Just status - , status = newStatus - , sensitive = Maybe.withDefault False status.sensitive - , spoilerText = - if status.spoiler_text == "" then - Nothing - else - Just status.spoiler_text - , visibility = status.visibility - } - } - ! [ Command.focusId "status" - , Command.updateDomStatus newStatus - ] - - UpdateInputInformation { status, selectionStart } -> - let - stringToPos = - String.slice 0 selectionStart status - - atPosition = - case (String.right 1 stringToPos) of - "@" -> - Just selectionStart - - " " -> - Nothing - - _ -> - model.draft.autoAtPosition - - query = - case atPosition of - Just position -> - String.slice position (String.length stringToPos) stringToPos - - Nothing -> - "" - - newDraft = - { draft - | status = status - , statusLength = String.length status - , autoCursorPosition = selectionStart - , autoAtPosition = atPosition - , autoQuery = query - , showAutoMenu = - showAutoMenu - draft.autoAccounts - draft.autoAtPosition - draft.autoQuery - } - in - { model | draft = newDraft } - ! if query /= "" && atPosition /= Nothing then - [ Command.searchAccounts model.client query model.draft.autoMaxResults False ] - else - [] - - SelectAccount id -> - let - account = - List.filter (\account -> toString account.id == id) draft.autoAccounts - |> List.head - - stringToAtPos = - case draft.autoAtPosition of - Just atPosition -> - String.slice 0 atPosition draft.status - - _ -> - "" - - stringToPos = - String.slice 0 draft.autoCursorPosition draft.status - - newStatus = - case draft.autoAtPosition of - Just atPosition -> - String.Extra.replaceSlice - (case account of - Just a -> - a.acct ++ " " - - Nothing -> - "" - ) - atPosition - ((String.length draft.autoQuery) + atPosition) - draft.status - - _ -> - "" - - newDraft = - { draft - | status = newStatus - , autoAtPosition = Nothing - , autoQuery = "" - , autoState = Autocomplete.empty - , autoAccounts = [] - , showAutoMenu = False - } - in - { model | draft = newDraft } - -- As we are using defaultValue, we need to update the textarea - -- using a port. - ! [ Command.updateDomStatus newStatus ] - - SetAutoState autoMsg -> - let - ( newState, maybeMsg ) = - Autocomplete.update - autocompleteUpdateConfig - autoMsg - draft.autoMaxResults - draft.autoState - (acceptableAccounts draft.autoQuery draft.autoAccounts) - - newModel = - { model | draft = { draft | autoState = newState } } - in - case maybeMsg of - Nothing -> - newModel ! [] - - Just updateMsg -> - update updateMsg newModel - - CloseAutocomplete -> - let - newDraft = - { draft - | showAutoMenu = False - , autoState = Autocomplete.reset autocompleteUpdateConfig draft.autoState - } - in - { model | draft = newDraft } ! [] - - ResetAutocomplete toTop -> - let - newDraft = - { draft - | autoState = - if toTop then - Autocomplete.resetToFirstItem - autocompleteUpdateConfig - (acceptableAccounts draft.autoQuery draft.autoAccounts) - draft.autoMaxResults - draft.autoState - else - Autocomplete.resetToLastItem - autocompleteUpdateConfig - (acceptableAccounts draft.autoQuery draft.autoAccounts) - draft.autoMaxResults - draft.autoState - } - in - { model | draft = newDraft } ! [] - - -updateViewer : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg ) -updateViewer viewerMsg viewer = - case viewerMsg of - CloseViewer -> - Nothing ! [] - - OpenViewer attachments attachment -> - (Just <| Viewer attachments attachment) ! [] - - -markTimelineLoading : Bool -> String -> Model -> Model -markTimelineLoading loading id model = - let - mark timeline = - { timeline | loading = loading } - in - case id of - "notifications" -> - { model | notifications = mark model.notifications } - - "home-timeline" -> - { model | homeTimeline = mark model.homeTimeline } - - "local-timeline" -> - { model | localTimeline = mark model.localTimeline } - - "global-timeline" -> - { model | globalTimeline = mark model.globalTimeline } - - "account-timeline" -> - case model.currentView of - AccountView account -> - { model | accountTimeline = mark model.accountTimeline } - - _ -> - model - - _ -> - model - - -updateTimeline : Bool -> List a -> Links -> Timeline a -> Timeline a -updateTimeline append entries links timeline = - let - newEntries = - if append then - List.concat [ timeline.entries, entries ] - else - entries - in - { timeline - | entries = newEntries - , links = links - , loading = False - } - - -prependToTimeline : a -> Timeline a -> Timeline a -prependToTimeline entry timeline = - { timeline | entries = entry :: timeline.entries } - - -processMastodonEvent : MastodonMsg -> Model -> ( Model, Cmd Msg ) -processMastodonEvent msg model = - case msg of - AccessToken result -> - case result of - Ok { decoded } -> - let - client = - Client decoded.server decoded.accessToken - in - { model | client = Just client } - ! [ Command.loadTimelines <| Just client - , Command.saveClient client - , Navigation.modifyUrl model.location.pathname - , Navigation.reload - ] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountFollowed result -> - case result of - Ok { decoded } -> - processFollowEvent decoded True model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountUnfollowed result -> - case result of - Ok { decoded } -> - processFollowEvent decoded False model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AppRegistered result -> - case result of - Ok { decoded } -> - { model | registration = Just decoded } - ! [ Command.saveRegistration decoded - , Command.navigateToAuthUrl decoded - ] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - ContextLoaded status result -> - case result of - Ok { decoded } -> - { model | currentView = ThreadView (Thread status decoded) } - ! [ Command.scrollToThreadStatus <| toString status.id ] - - Err error -> - { model - | currentView = preferredTimeline model - , errors = addErrorNotification (errorText error) model - } - ! [] - - CurrentUser result -> - case result of - Ok { decoded } -> - { model | currentUser = Just decoded } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - FavoriteAdded result -> - case result of - Ok _ -> - model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - FavoriteRemoved result -> - case result of - Ok _ -> - model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - LocalTimeline append result -> - case result of - Ok { decoded, links } -> - { model | localTimeline = updateTimeline append decoded links model.localTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - Notifications append result -> - case result of - Ok { decoded, links } -> - let - aggregated = - Mastodon.Helper.aggregateNotifications decoded - in - { model | notifications = updateTimeline append aggregated links model.notifications } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - GlobalTimeline append result -> - case result of - Ok { decoded, links } -> - { model | globalTimeline = updateTimeline append decoded links model.globalTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - Reblogged result -> - case result of - Ok _ -> - model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - StatusPosted _ -> - { model | draft = defaultDraft } - ! [ Command.scrollColumnToTop "home-timeline" - , Command.updateDomStatus defaultDraft.status - ] - - StatusDeleted result -> - case result of - Ok { decoded } -> - deleteStatusFromAllTimelines decoded model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - Unreblogged result -> - case result of - Ok _ -> - model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountReceived result -> - case result of - Ok { decoded } -> - { model | currentView = AccountView decoded } - ! [ Command.loadAccountTimeline model.client decoded.id model.accountTimeline.links.next ] - - Err error -> - { model - | currentView = preferredTimeline model - , errors = addErrorNotification (errorText error) model - } - ! [] - - AccountTimeline append result -> - case result of - Ok { decoded, links } -> - { model | accountTimeline = updateTimeline append decoded links model.accountTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountFollowers result -> - case result of - Ok { decoded } -> - -- TODO: store next link - { model | accountFollowers = decoded } - ! [ Command.loadRelationships model.client <| List.map .id decoded ] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountFollowing result -> - case result of - Ok { decoded } -> - -- TODO: store next link - { model | accountFollowing = decoded } - ! [ Command.loadRelationships model.client <| List.map .id decoded ] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountRelationship result -> - case result of - Ok { decoded } -> - case decoded of - [ relationship ] -> - { model | accountRelationship = Just relationship } ! [] - - _ -> - model ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AccountRelationships result -> - case result of - Ok { decoded } -> - -- TODO: store next link - { model | accountRelationships = decoded } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - HomeTimeline append result -> - case result of - Ok { decoded, links } -> - { model | homeTimeline = updateTimeline append decoded links model.homeTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification (errorText error) model } ! [] - - AutoSearch result -> - let - draft = - model.draft - in - case result of - Ok { decoded } -> - { model - | draft = - { draft - | showAutoMenu = - showAutoMenu - decoded - draft.autoAtPosition - draft.autoQuery - , autoAccounts = decoded - } - } - -- Force selection of the first item after each - -- Successfull request - ! [ Task.perform identity (Task.succeed ((DraftEvent << ResetAutocomplete) True)) ] - - Err error -> - { model - | draft = { draft | showAutoMenu = False } - , errors = addErrorNotification (errorText error) model - } - ! [] - - -showAutoMenu : List Account -> Maybe Int -> String -> Bool -showAutoMenu accounts atPosition query = - case ( List.isEmpty accounts, atPosition, query ) of - ( _, Nothing, _ ) -> - False - - ( True, _, _ ) -> - False - - ( _, _, "" ) -> - False - - ( False, Just _, _ ) -> - True - - -processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg ) -processWebSocketMsg msg model = - case msg of - NewWebsocketUserMessage message -> - case (Mastodon.Decoder.decodeWebSocketMessage message) of - Mastodon.WebSocket.ErrorEvent error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusUpdateEvent result -> - case result of - Ok status -> - { model | homeTimeline = prependToTimeline status model.homeTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusDeleteEvent result -> - case result of - Ok id -> - deleteStatusFromAllTimelines id model ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.NotificationEvent result -> - case result of - Ok notification -> - let - oldNotifications = - model.notifications - - newNotifications = - { oldNotifications - | entries = - Mastodon.Helper.addNotificationToAggregates - notification - oldNotifications.entries - } - in - { model | notifications = newNotifications } ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - NewWebsocketLocalMessage message -> - case (Mastodon.Decoder.decodeWebSocketMessage message) of - Mastodon.WebSocket.ErrorEvent error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusUpdateEvent result -> - case result of - Ok status -> - { model | localTimeline = prependToTimeline status model.localTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusDeleteEvent result -> - case result of - Ok id -> - deleteStatusFromAllTimelines id model ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - _ -> - model ! [] - - NewWebsocketGlobalMessage message -> - case (Mastodon.Decoder.decodeWebSocketMessage message) of - Mastodon.WebSocket.ErrorEvent error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusUpdateEvent result -> - case result of - Ok status -> - { model | globalTimeline = prependToTimeline status model.globalTimeline } ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - Mastodon.WebSocket.StatusDeleteEvent result -> - case result of - Ok id -> - deleteStatusFromAllTimelines id model ! [] - - Err error -> - { model | errors = addErrorNotification error model } ! [] - - _ -> - model ! [] - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - NoOp -> - model ! [] - - Tick newTime -> - { model - | currentTime = newTime - , errors = List.filter (\{ time } -> model.currentTime - time <= 10000) model.errors - } - ! [] - - ClearError index -> - { model | errors = removeAt index model.errors } ! [] - - MastodonEvent msg -> - let - ( newModel, commands ) = - processMastodonEvent msg model - in - newModel ! [ commands ] - - WebSocketEvent msg -> - let - ( newModel, commands ) = - processWebSocketMsg msg model - in - newModel ! [ commands ] - - ServerChange server -> - { model | server = server } ! [] - - UrlChange location -> - model ! [] - - Register -> - model ! [ Command.registerApp model ] - - OpenThread status -> - model ! [ Command.loadThread model.client status ] - - CloseThread -> - { model | currentView = preferredTimeline model } ! [] - - FollowAccount id -> - model ! [ Command.follow model.client id ] - - UnfollowAccount id -> - model ! [ Command.unfollow model.client id ] - - DeleteStatus id -> - model ! [ Command.deleteStatus model.client id ] - - ReblogStatus id -> - processReblog id True model ! [ Command.reblogStatus model.client id ] - - UnreblogStatus id -> - processReblog id False model ! [ Command.unreblogStatus model.client id ] - - AddFavorite id -> - processFavourite id True model ! [ Command.favouriteStatus model.client id ] - - RemoveFavorite id -> - processFavourite id False model ! [ Command.unfavouriteStatus model.client id ] - - DraftEvent draftMsg -> - case model.currentUser of - Just user -> - updateDraft draftMsg user model - - Nothing -> - model ! [] - - ViewerEvent viewerMsg -> - let - ( viewer, commands ) = - updateViewer viewerMsg model.viewer - in - { model | viewer = viewer } ! [ commands ] - - SubmitDraft -> - model ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ] - - LoadAccount accountId -> - { model - | accountTimeline = emptyTimeline "account-timeline" - , accountFollowers = [] - , accountFollowing = [] - , accountRelationships = [] - , accountRelationship = Nothing - } - ! [ Command.loadAccount model.client accountId ] - - TimelineLoadNext id next -> - markTimelineLoading True id model - ! [ Command.loadNextTimeline model.client model.currentView id next ] - - ViewAccountFollowers account -> - { model | currentView = AccountFollowersView account model.accountFollowers } - ! [ Command.loadAccountFollowers model.client account.id ] - - ViewAccountFollowing account -> - { model | currentView = AccountFollowingView account model.accountFollowing } - ! [ Command.loadAccountFollowing model.client account.id ] - - ViewAccountStatuses account -> - { model | currentView = AccountView account } ! [] - - UseGlobalTimeline flag -> - let - newModel = - { model | useGlobalTimeline = flag } - in - { newModel | currentView = preferredTimeline newModel } ! [] - - CloseAccount -> - { model - | currentView = preferredTimeline model - , accountTimeline = emptyTimeline "account-timeline" - , accountFollowing = [] - , accountFollowers = [] - } - ! [] - - FilterNotifications filter -> - { model | notificationFilter = filter } ! [] - - ScrollColumn ScrollTop column -> - model ! [ Command.scrollColumnToTop column ] - - ScrollColumn ScrollBottom column -> - model ! [ Command.scrollColumnToBottom column ] - - -autocompleteUpdateConfig : Autocomplete.UpdateConfig Msg Account -autocompleteUpdateConfig = - Autocomplete.updateConfig - { toId = .id >> toString - , onKeyDown = - \code maybeId -> - if code == 38 || code == 40 then - Nothing - else if code == 13 then - Maybe.map (DraftEvent << SelectAccount) maybeId - else - Just <| (DraftEvent << ResetAutocomplete) False - , onTooLow = Just <| (DraftEvent << ResetAutocomplete) True - , onTooHigh = Just <| (DraftEvent << ResetAutocomplete) False - , onMouseEnter = \_ -> Nothing - , onMouseLeave = \_ -> Nothing - , onMouseClick = \id -> Just <| (DraftEvent << SelectAccount) id - , separateSelections = False - } - - -acceptableAccounts : String -> List Account -> List Account -acceptableAccounts query accounts = - let - lowerQuery = - String.toLower query - in - if query == "" then - [] - else - List.filter (String.contains lowerQuery << String.toLower << .username) accounts - - -subscriptions : Model -> Sub Msg -subscriptions { client, currentView } = - let - timeSub = - Time.every Time.millisecond Tick - - userWsSub = - Mastodon.WebSocket.subscribeToWebSockets - client - Mastodon.WebSocket.UserStream - NewWebsocketUserMessage - |> Sub.map WebSocketEvent - - otherWsSub = - if currentView == GlobalTimelineView then - Mastodon.WebSocket.subscribeToWebSockets - client - Mastodon.WebSocket.GlobalPublicStream - NewWebsocketGlobalMessage - |> Sub.map WebSocketEvent - else if currentView == LocalTimelineView then - Mastodon.WebSocket.subscribeToWebSockets - client - Mastodon.WebSocket.LocalPublicStream - NewWebsocketLocalMessage - |> Sub.map WebSocketEvent - else - Sub.none - - autoCompleteSub = - Sub.map (DraftEvent << SetAutoState) Autocomplete.subscription - in - [ timeSub, userWsSub, otherWsSub, autoCompleteSub ] - |> Sub.batch diff --git a/src/Subscription.elm b/src/Subscription.elm new file mode 100644 index 0000000..fed00af --- /dev/null +++ b/src/Subscription.elm @@ -0,0 +1,42 @@ +module Subscription exposing (subscriptions) + +import Autocomplete +import Mastodon.WebSocket +import Time +import Types exposing (..) + + +subscriptions : Model -> Sub Msg +subscriptions { client, currentView } = + let + timeSub = + Time.every Time.millisecond Tick + + userWsSub = + Mastodon.WebSocket.subscribeToWebSockets + client + Mastodon.WebSocket.UserStream + NewWebsocketUserMessage + |> Sub.map WebSocketEvent + + otherWsSub = + if currentView == GlobalTimelineView then + Mastodon.WebSocket.subscribeToWebSockets + client + Mastodon.WebSocket.GlobalPublicStream + NewWebsocketGlobalMessage + |> Sub.map WebSocketEvent + else if currentView == LocalTimelineView then + Mastodon.WebSocket.subscribeToWebSockets + client + Mastodon.WebSocket.LocalPublicStream + NewWebsocketLocalMessage + |> Sub.map WebSocketEvent + else + Sub.none + + autoCompleteSub = + Sub.map (DraftEvent << SetAutoState) Autocomplete.subscription + in + [ timeSub, userWsSub, otherWsSub, autoCompleteSub ] + |> Sub.batch diff --git a/src/Update/Draft.elm b/src/Update/Draft.elm new file mode 100644 index 0000000..aa53a41 --- /dev/null +++ b/src/Update/Draft.elm @@ -0,0 +1,271 @@ +module Update.Draft + exposing + ( empty + , showAutoMenu + , update + ) + +import Autocomplete +import Command +import Mastodon.Helper +import Mastodon.Model exposing (..) +import String.Extra +import Types exposing (..) +import Util + + +autocompleteUpdateConfig : Autocomplete.UpdateConfig Msg Account +autocompleteUpdateConfig = + Autocomplete.updateConfig + { toId = .id >> toString + , onKeyDown = + \code maybeId -> + if code == 38 || code == 40 then + Nothing + else if code == 13 then + Maybe.map (DraftEvent << SelectAccount) maybeId + else + Just <| (DraftEvent << ResetAutocomplete) False + , onTooLow = Just <| (DraftEvent << ResetAutocomplete) True + , onTooHigh = Just <| (DraftEvent << ResetAutocomplete) False + , onMouseEnter = \_ -> Nothing + , onMouseLeave = \_ -> Nothing + , onMouseClick = \id -> Just <| (DraftEvent << SelectAccount) id + , separateSelections = False + } + + +empty : Draft +empty = + { status = "" + , inReplyTo = Nothing + , spoilerText = Nothing + , sensitive = False + , visibility = "public" + , statusLength = 0 + , autoState = Autocomplete.empty + , autoAtPosition = Nothing + , autoQuery = "" + , autoCursorPosition = 0 + , autoMaxResults = 4 + , autoAccounts = [] + , showAutoMenu = False + } + + +showAutoMenu : List Account -> Maybe Int -> String -> Bool +showAutoMenu accounts atPosition query = + case ( List.isEmpty accounts, atPosition, query ) of + ( _, Nothing, _ ) -> + False + + ( True, _, _ ) -> + False + + ( _, _, "" ) -> + False + + ( False, Just _, _ ) -> + True + + +update : DraftMsg -> Account -> Model -> ( Model, Cmd Msg ) +update draftMsg currentUser model = + let + draft = + model.draft + in + case draftMsg of + ClearDraft -> + { model | draft = empty } + ! [ Command.updateDomStatus empty.status ] + + ToggleSpoiler enabled -> + let + newDraft = + { draft + | spoilerText = + if enabled then + Just "" + else + Nothing + } + in + { model | draft = newDraft } ! [] + + UpdateSensitive sensitive -> + { model | draft = { draft | sensitive = sensitive } } ! [] + + UpdateSpoiler spoilerText -> + { model | draft = { draft | spoilerText = Just spoilerText } } ! [] + + UpdateVisibility visibility -> + { model | draft = { draft | visibility = visibility } } ! [] + + UpdateReplyTo status -> + let + newStatus = + Mastodon.Helper.getReplyPrefix currentUser status + in + { model + | draft = + { draft + | inReplyTo = Just status + , status = newStatus + , sensitive = Maybe.withDefault False status.sensitive + , spoilerText = + if status.spoiler_text == "" then + Nothing + else + Just status.spoiler_text + , visibility = status.visibility + } + } + ! [ Command.focusId "status" + , Command.updateDomStatus newStatus + ] + + UpdateInputInformation { status, selectionStart } -> + let + stringToPos = + String.slice 0 selectionStart status + + atPosition = + case (String.right 1 stringToPos) of + "@" -> + Just selectionStart + + " " -> + Nothing + + _ -> + model.draft.autoAtPosition + + query = + case atPosition of + Just position -> + String.slice position (String.length stringToPos) stringToPos + + Nothing -> + "" + + newDraft = + { draft + | status = status + , statusLength = String.length status + , autoCursorPosition = selectionStart + , autoAtPosition = atPosition + , autoQuery = query + , showAutoMenu = + showAutoMenu + draft.autoAccounts + draft.autoAtPosition + draft.autoQuery + } + in + { model | draft = newDraft } + ! if query /= "" && atPosition /= Nothing then + [ Command.searchAccounts model.client query model.draft.autoMaxResults False ] + else + [] + + SelectAccount id -> + let + account = + List.filter (\account -> toString account.id == id) draft.autoAccounts + |> List.head + + stringToAtPos = + case draft.autoAtPosition of + Just atPosition -> + String.slice 0 atPosition draft.status + + _ -> + "" + + stringToPos = + String.slice 0 draft.autoCursorPosition draft.status + + newStatus = + case draft.autoAtPosition of + Just atPosition -> + String.Extra.replaceSlice + (case account of + Just a -> + a.acct ++ " " + + Nothing -> + "" + ) + atPosition + ((String.length draft.autoQuery) + atPosition) + draft.status + + _ -> + "" + + newDraft = + { draft + | status = newStatus + , autoAtPosition = Nothing + , autoQuery = "" + , autoState = Autocomplete.empty + , autoAccounts = [] + , showAutoMenu = False + } + in + { model | draft = newDraft } + -- As we are using defaultValue, we need to update the textarea + -- using a port. + ! [ Command.updateDomStatus newStatus ] + + SetAutoState autoMsg -> + let + ( newState, maybeMsg ) = + Autocomplete.update + autocompleteUpdateConfig + autoMsg + draft.autoMaxResults + draft.autoState + (Util.acceptableAccounts draft.autoQuery draft.autoAccounts) + + newModel = + { model | draft = { draft | autoState = newState } } + in + case maybeMsg of + Just (DraftEvent updateMsg) -> + update updateMsg currentUser newModel + + _ -> + newModel ! [] + + CloseAutocomplete -> + let + newDraft = + { draft + | showAutoMenu = False + , autoState = Autocomplete.reset autocompleteUpdateConfig draft.autoState + } + in + { model | draft = newDraft } ! [] + + ResetAutocomplete toTop -> + let + newDraft = + { draft + | autoState = + if toTop then + Autocomplete.resetToFirstItem + autocompleteUpdateConfig + (Util.acceptableAccounts draft.autoQuery draft.autoAccounts) + draft.autoMaxResults + draft.autoState + else + Autocomplete.resetToLastItem + autocompleteUpdateConfig + (Util.acceptableAccounts draft.autoQuery draft.autoAccounts) + draft.autoMaxResults + draft.autoState + } + in + { model | draft = newDraft } ! [] diff --git a/src/Update/Error.elm b/src/Update/Error.elm new file mode 100644 index 0000000..b27739b --- /dev/null +++ b/src/Update/Error.elm @@ -0,0 +1,12 @@ +module Update.Error exposing (addErrorNotification) + +import Types exposing (..) + + +addErrorNotification : String -> Model -> List ErrorNotification +addErrorNotification message model = + let + error = + { message = message, time = model.currentTime } + in + error :: model.errors diff --git a/src/Update/Main.elm b/src/Update/Main.elm new file mode 100644 index 0000000..6713e49 --- /dev/null +++ b/src/Update/Main.elm @@ -0,0 +1,166 @@ +module Update.Main exposing (update) + +import Command +import List.Extra exposing (removeAt) +import Mastodon.Model exposing (..) +import Types exposing (..) +import Update.Draft +import Update.Mastodon +import Update.Timeline +import Update.Viewer +import Update.WebSocket + + +toStatusRequestBody : Draft -> StatusRequestBody +toStatusRequestBody draft = + { status = draft.status + , in_reply_to_id = + case draft.inReplyTo of + Just status -> + Just status.id + + Nothing -> + Nothing + , spoiler_text = draft.spoilerText + , sensitive = draft.sensitive + , visibility = draft.visibility + } + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model ! [] + + Tick newTime -> + { model + | currentTime = newTime + , errors = List.filter (\{ time } -> model.currentTime - time <= 10000) model.errors + } + ! [] + + ClearError index -> + { model | errors = removeAt index model.errors } ! [] + + MastodonEvent msg -> + let + ( newModel, commands ) = + Update.Mastodon.update msg model + in + newModel ! [ commands ] + + WebSocketEvent msg -> + let + ( newModel, commands ) = + Update.WebSocket.update msg model + in + newModel ! [ commands ] + + ServerChange server -> + { model | server = server } ! [] + + UrlChange location -> + model ! [] + + Register -> + model ! [ Command.registerApp model ] + + OpenThread status -> + model ! [ Command.loadThread model.client status ] + + CloseThread -> + { model | currentView = Update.Timeline.preferred model } ! [] + + FollowAccount id -> + model ! [ Command.follow model.client id ] + + UnfollowAccount id -> + model ! [ Command.unfollow model.client id ] + + DeleteStatus id -> + model ! [ Command.deleteStatus model.client id ] + + ReblogStatus id -> + Update.Timeline.processReblog id True model + ! [ Command.reblogStatus model.client id ] + + UnreblogStatus id -> + Update.Timeline.processReblog id False model + ! [ Command.unreblogStatus model.client id ] + + AddFavorite id -> + Update.Timeline.processFavourite id True model + ! [ Command.favouriteStatus model.client id ] + + RemoveFavorite id -> + Update.Timeline.processFavourite id False model + ! [ Command.unfavouriteStatus model.client id ] + + DraftEvent draftMsg -> + case model.currentUser of + Just user -> + Update.Draft.update draftMsg user model + + Nothing -> + model ! [] + + ViewerEvent viewerMsg -> + let + ( viewer, commands ) = + Update.Viewer.update viewerMsg model.viewer + in + { model | viewer = viewer } ! [ commands ] + + SubmitDraft -> + model ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ] + + LoadAccount accountId -> + { model + | accountTimeline = Update.Timeline.empty "account-timeline" + , accountFollowers = [] + , accountFollowing = [] + , accountRelationships = [] + , accountRelationship = Nothing + } + ! [ Command.loadAccount model.client accountId ] + + TimelineLoadNext id next -> + Update.Timeline.markAsLoading True id model + ! [ Command.loadNextTimeline model.client model.currentView id next ] + + ViewAccountFollowers account -> + { model | currentView = AccountFollowersView account model.accountFollowers } + ! [ Command.loadAccountFollowers model.client account.id ] + + ViewAccountFollowing account -> + { model | currentView = AccountFollowingView account model.accountFollowing } + ! [ Command.loadAccountFollowing model.client account.id ] + + ViewAccountStatuses account -> + { model | currentView = AccountView account } ! [] + + UseGlobalTimeline flag -> + let + newModel = + { model | useGlobalTimeline = flag } + in + { newModel | currentView = Update.Timeline.preferred newModel } ! [] + + CloseAccount -> + { model + | currentView = Update.Timeline.preferred model + , accountTimeline = Update.Timeline.empty "account-timeline" + , accountFollowing = [] + , accountFollowers = [] + } + ! [] + + FilterNotifications filter -> + { model | notificationFilter = filter } ! [] + + ScrollColumn ScrollTop column -> + model ! [ Command.scrollColumnToTop column ] + + ScrollColumn ScrollBottom column -> + model ! [ Command.scrollColumnToBottom column ] diff --git a/src/Update/Mastodon.elm b/src/Update/Mastodon.elm new file mode 100644 index 0000000..fd5c498 --- /dev/null +++ b/src/Update/Mastodon.elm @@ -0,0 +1,308 @@ +module Update.Mastodon exposing (update) + +import Command +import Navigation +import Mastodon.Helper +import Mastodon.Model exposing (..) +import Task +import Types exposing (..) +import Update.Draft +import Update.Error exposing (..) +import Update.Timeline + + +errorText : Error -> String +errorText error = + case error of + MastodonError statusCode statusMsg errorMsg -> + "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg + + ServerError statusCode statusMsg errorMsg -> + "HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg + + TimeoutError -> + "Request timed out." + + NetworkError -> + "Unreachable host." + + +update : MastodonMsg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + AccessToken result -> + case result of + Ok { decoded } -> + let + client = + Client decoded.server decoded.accessToken + in + { model | client = Just client } + ! [ Command.loadTimelines <| Just client + , Command.saveClient client + , Navigation.modifyUrl model.location.pathname + , Navigation.reload + ] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountFollowed result -> + case result of + Ok { decoded } -> + processFollowEvent decoded True model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountUnfollowed result -> + case result of + Ok { decoded } -> + processFollowEvent decoded False model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AppRegistered result -> + case result of + Ok { decoded } -> + { model | registration = Just decoded } + ! [ Command.saveRegistration decoded + , Command.navigateToAuthUrl decoded + ] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + ContextLoaded status result -> + case result of + Ok { decoded } -> + { model | currentView = ThreadView (Thread status decoded) } + ! [ Command.scrollToThreadStatus <| toString status.id ] + + Err error -> + { model + | currentView = Update.Timeline.preferred model + , errors = addErrorNotification (errorText error) model + } + ! [] + + CurrentUser result -> + case result of + Ok { decoded } -> + { model | currentUser = Just decoded } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + FavoriteAdded result -> + case result of + Ok _ -> + model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + FavoriteRemoved result -> + case result of + Ok _ -> + model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + LocalTimeline append result -> + case result of + Ok { decoded, links } -> + { model | localTimeline = Update.Timeline.update append decoded links model.localTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + Notifications append result -> + case result of + Ok { decoded, links } -> + let + aggregated = + Mastodon.Helper.aggregateNotifications decoded + in + { model | notifications = Update.Timeline.update append aggregated links model.notifications } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + GlobalTimeline append result -> + case result of + Ok { decoded, links } -> + { model | globalTimeline = Update.Timeline.update append decoded links model.globalTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + Reblogged result -> + case result of + Ok _ -> + model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + StatusPosted _ -> + -- FIXME: here we should rather send a ClearDraft command, and update the + -- ClearDraft message handler to update DOM status + let + draft = + Update.Draft.empty + in + { model | draft = draft } + ! [ Command.scrollColumnToTop "home-timeline" + , Command.updateDomStatus draft.status + ] + + StatusDeleted result -> + case result of + Ok { decoded } -> + Update.Timeline.deleteStatusFromAllTimelines decoded model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + Unreblogged result -> + case result of + Ok _ -> + model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountReceived result -> + case result of + Ok { decoded } -> + { model | currentView = AccountView decoded } + ! [ Command.loadAccountTimeline model.client decoded.id model.accountTimeline.links.next ] + + Err error -> + { model + | currentView = Update.Timeline.preferred model + , errors = addErrorNotification (errorText error) model + } + ! [] + + AccountTimeline append result -> + case result of + Ok { decoded, links } -> + { model | accountTimeline = Update.Timeline.update append decoded links model.accountTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountFollowers result -> + case result of + Ok { decoded } -> + -- TODO: store next link + { model | accountFollowers = decoded } + ! [ Command.loadRelationships model.client <| List.map .id decoded ] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountFollowing result -> + case result of + Ok { decoded } -> + -- TODO: store next link + { model | accountFollowing = decoded } + ! [ Command.loadRelationships model.client <| List.map .id decoded ] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountRelationship result -> + case result of + Ok { decoded } -> + case decoded of + [ relationship ] -> + { model | accountRelationship = Just relationship } ! [] + + _ -> + model ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AccountRelationships result -> + case result of + Ok { decoded } -> + -- TODO: store next link + { model | accountRelationships = decoded } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + HomeTimeline append result -> + case result of + Ok { decoded, links } -> + { model | homeTimeline = Update.Timeline.update append decoded links model.homeTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification (errorText error) model } ! [] + + AutoSearch result -> + let + draft = + model.draft + in + case result of + Ok { decoded } -> + { model + | draft = + { draft + | showAutoMenu = + Update.Draft.showAutoMenu + decoded + draft.autoAtPosition + draft.autoQuery + , autoAccounts = decoded + } + } + -- Force selection of the first item after each + -- Successfull request + ! [ Task.perform identity (Task.succeed ((DraftEvent << ResetAutocomplete) True)) ] + + Err error -> + { model + | draft = { draft | showAutoMenu = False } + , errors = addErrorNotification (errorText error) model + } + ! [] + + +{-| Update viewed account relationships as well as the relationship with the +current connected user, both according to the "following" status provided. +-} +processFollowEvent : Relationship -> Bool -> Model -> Model +processFollowEvent relationship flag model = + let + updateRelationship r = + if r.id == relationship.id then + { r | following = flag } + else + r + + accountRelationships = + model.accountRelationships |> List.map updateRelationship + + accountRelationship = + case model.accountRelationship of + Just accountRelationship -> + if accountRelationship.id == relationship.id then + Just { relationship | following = flag } + else + model.accountRelationship + + Nothing -> + Nothing + in + { model + | accountRelationships = accountRelationships + , accountRelationship = accountRelationship + } diff --git a/src/Update/Timeline.elm b/src/Update/Timeline.elm new file mode 100644 index 0000000..3a75445 --- /dev/null +++ b/src/Update/Timeline.elm @@ -0,0 +1,225 @@ +module Update.Timeline + exposing + ( deleteStatusFromAllTimelines + , deleteStatus + , empty + , markAsLoading + , preferred + , prepend + , processReblog + , processFavourite + , update + , updateWithBoolFlag + ) + +import Mastodon.Helper +import Mastodon.Http exposing (Links) +import Mastodon.Model exposing (..) +import Types exposing (..) + + +deleteStatusFromCurrentView : Int -> Model -> CurrentView +deleteStatusFromCurrentView id model = + -- Note: account timeline is already cleaned in deleteStatusFromAllTimelines + case model.currentView of + ThreadView thread -> + if thread.status.id == id then + -- the current thread status as been deleted, close it + preferred model + else + let + update statuses = + List.filter (\s -> s.id /= id) statuses + in + ThreadView + { thread + | context = + { ancestors = update thread.context.ancestors + , descendants = update thread.context.descendants + } + } + + currentView -> + currentView + + +deleteStatusFromAllTimelines : Int -> Model -> Model +deleteStatusFromAllTimelines id model = + { model + | homeTimeline = deleteStatus id model.homeTimeline + , localTimeline = deleteStatus id model.localTimeline + , globalTimeline = deleteStatus id model.globalTimeline + , accountTimeline = deleteStatus id model.accountTimeline + , notifications = deleteStatusFromNotifications id model.notifications + , currentView = deleteStatusFromCurrentView id model + } + + +deleteStatusFromNotifications : Int -> Timeline NotificationAggregate -> Timeline NotificationAggregate +deleteStatusFromNotifications statusId notifications = + let + update notification = + case notification.status of + Just status -> + not <| Mastodon.Helper.statusReferenced statusId status + + Nothing -> + True + in + { notifications | entries = List.filter update notifications.entries } + + +deleteStatus : Int -> Timeline Status -> Timeline Status +deleteStatus statusId ({ entries } as timeline) = + { timeline + | entries = List.filter (not << Mastodon.Helper.statusReferenced statusId) entries + } + + +empty : String -> Timeline a +empty id = + { id = id + , entries = [] + , links = Links Nothing Nothing + , loading = False + } + + +markAsLoading : Bool -> String -> Model -> Model +markAsLoading loading id model = + let + mark timeline = + { timeline | loading = loading } + in + case id of + "notifications" -> + { model | notifications = mark model.notifications } + + "home-timeline" -> + { model | homeTimeline = mark model.homeTimeline } + + "local-timeline" -> + { model | localTimeline = mark model.localTimeline } + + "global-timeline" -> + { model | globalTimeline = mark model.globalTimeline } + + "account-timeline" -> + case model.currentView of + AccountView account -> + { model | accountTimeline = mark model.accountTimeline } + + _ -> + model + + _ -> + model + + +preferred : Model -> CurrentView +preferred model = + if model.useGlobalTimeline then + GlobalTimelineView + else + LocalTimelineView + + +prepend : a -> Timeline a -> Timeline a +prepend entry timeline = + { timeline | entries = entry :: timeline.entries } + + +processFavourite : Int -> Bool -> Model -> Model +processFavourite statusId flag model = + updateWithBoolFlag statusId + flag + (\s -> + { s + | favourited = Just flag + , favourites_count = + if flag then + s.favourites_count + 1 + else if s.favourites_count > 0 then + s.favourites_count - 1 + else + 0 + } + ) + model + + +processReblog : Int -> Bool -> Model -> Model +processReblog statusId flag model = + updateWithBoolFlag statusId + flag + (\s -> + { s + | reblogged = Just flag + , reblogs_count = + if flag then + s.reblogs_count + 1 + else if s.reblogs_count > 0 then + s.reblogs_count - 1 + else + 0 + } + ) + model + + +update : Bool -> List a -> Links -> Timeline a -> Timeline a +update append entries links timeline = + let + newEntries = + if append then + List.concat [ timeline.entries, entries ] + else + entries + in + { timeline + | entries = newEntries + , links = links + , loading = False + } + + +updateWithBoolFlag : Int -> Bool -> (Status -> Status) -> Model -> Model +updateWithBoolFlag statusId flag statusUpdater model = + let + updateStatus status = + if (Mastodon.Helper.extractReblog status).id == statusId then + statusUpdater status + else + status + + updateNotification notification = + case notification.status of + Just status -> + { notification | status = Just <| updateStatus status } + + Nothing -> + notification + + updateTimeline updateEntry timeline = + { timeline | entries = List.map updateEntry timeline.entries } + in + { model + | homeTimeline = updateTimeline updateStatus model.homeTimeline + , accountTimeline = updateTimeline updateStatus model.accountTimeline + , localTimeline = updateTimeline updateStatus model.localTimeline + , globalTimeline = updateTimeline updateStatus model.globalTimeline + , notifications = updateTimeline updateNotification model.notifications + , currentView = + case model.currentView of + ThreadView thread -> + ThreadView + { status = updateStatus thread.status + , context = + { ancestors = List.map updateStatus thread.context.ancestors + , descendants = List.map updateStatus thread.context.descendants + } + } + + currentView -> + currentView + } diff --git a/src/Update/Viewer.elm b/src/Update/Viewer.elm new file mode 100644 index 0000000..cb068fc --- /dev/null +++ b/src/Update/Viewer.elm @@ -0,0 +1,13 @@ +module Update.Viewer exposing (update) + +import Types exposing (..) + + +update : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg ) +update viewerMsg viewer = + case viewerMsg of + CloseViewer -> + Nothing ! [] + + OpenViewer attachments attachment -> + (Just <| Viewer attachments attachment) ! [] diff --git a/src/Update/WebSocket.elm b/src/Update/WebSocket.elm new file mode 100644 index 0000000..4abb77b --- /dev/null +++ b/src/Update/WebSocket.elm @@ -0,0 +1,101 @@ +module Update.WebSocket exposing (update) + +import Mastodon.Decoder +import Mastodon.Helper +import Mastodon.WebSocket +import Types exposing (..) +import Update.Error exposing (..) +import Update.Timeline + + +update : WebSocketMsg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NewWebsocketUserMessage message -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusUpdateEvent result -> + case result of + Ok status -> + { model | homeTimeline = Update.Timeline.prepend status model.homeTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusDeleteEvent result -> + case result of + Ok id -> + Update.Timeline.deleteStatusFromAllTimelines id model ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.NotificationEvent result -> + case result of + Ok notification -> + let + oldNotifications = + model.notifications + + newNotifications = + { oldNotifications + | entries = + Mastodon.Helper.addNotificationToAggregates + notification + oldNotifications.entries + } + in + { model | notifications = newNotifications } ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + NewWebsocketLocalMessage message -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusUpdateEvent result -> + case result of + Ok status -> + { model | localTimeline = Update.Timeline.prepend status model.localTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusDeleteEvent result -> + case result of + Ok id -> + Update.Timeline.deleteStatusFromAllTimelines id model ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + _ -> + model ! [] + + NewWebsocketGlobalMessage message -> + case (Mastodon.Decoder.decodeWebSocketMessage message) of + Mastodon.WebSocket.ErrorEvent error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusUpdateEvent result -> + case result of + Ok status -> + { model | globalTimeline = Update.Timeline.prepend status model.globalTimeline } ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + Mastodon.WebSocket.StatusDeleteEvent result -> + case result of + Ok id -> + Update.Timeline.deleteStatusFromAllTimelines id model ! [] + + Err error -> + { model | errors = addErrorNotification error model } ! [] + + _ -> + model ! [] diff --git a/src/Util.elm b/src/Util.elm new file mode 100644 index 0000000..93564c0 --- /dev/null +++ b/src/Util.elm @@ -0,0 +1,30 @@ +module Util + exposing + ( acceptableAccounts + , extractAuthCode + ) + +import Mastodon.Model exposing (..) +import Navigation + + +acceptableAccounts : String -> List Account -> List Account +acceptableAccounts query accounts = + let + lowerQuery = + String.toLower query + in + if query == "" then + [] + else + List.filter (String.contains lowerQuery << String.toLower << .username) accounts + + +extractAuthCode : Navigation.Location -> Maybe String +extractAuthCode { search } = + case (String.split "?code=" search) of + [ _, authCode ] -> + Just authCode + + _ -> + Nothing diff --git a/src/View/Common.elm b/src/View/Common.elm index 0813352..a0fc448 100644 --- a/src/View/Common.elm +++ b/src/View/Common.elm @@ -85,7 +85,6 @@ justifiedButtonGroup cls buttons = loadMoreBtn : { timeline | id : String, links : Links, loading : Bool } -> Html Msg loadMoreBtn { id, links, loading } = if loading then - -- TODO: proper spinner li [ class "list-group-item load-more text-center" ] [ text "Loading..." ] else diff --git a/src/View/Draft.elm b/src/View/Draft.elm index 7e5689e..a6341fb 100644 --- a/src/View/Draft.elm +++ b/src/View/Draft.elm @@ -8,8 +8,8 @@ import Html.Lazy as Lazy import Json.Encode as Encode import Json.Decode as Decode import Mastodon.Model exposing (..) -import Model import Types exposing (..) +import Util import View.Common as Common import View.Events exposing (..) import View.Formatter exposing (formatContent) @@ -36,7 +36,7 @@ viewAutocompleteMenu draft = (Autocomplete.view viewConfig draft.autoMaxResults draft.autoState - (Model.acceptableAccounts draft.autoQuery draft.autoAccounts) + (Util.acceptableAccounts draft.autoQuery draft.autoAccounts) ) ]