diff --git a/elm-package.json b/elm-package.json index 7ce3961..7ddb9db 100644 --- a/elm-package.json +++ b/elm-package.json @@ -9,6 +9,7 @@ "exposed-modules": [], "dependencies": { "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", + "elm-community/dict-extra": "1.5.0 <= v < 2.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0", "elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", diff --git a/src/Command.elm b/src/Command.elm index e62d7ea..c2485ff 100644 --- a/src/Command.elm +++ b/src/Command.elm @@ -8,9 +8,13 @@ module Command , loadNotifications , loadUserAccount , loadAccount - , loadAccountTimeline , loadAccountFollowers , loadAccountFollowing + , loadUserTimeline + , loadLocalTimeline + , loadGlobalTimeline + , loadAccountTimeline + , loadNextTimeline , loadRelationships , loadThread , loadTimelines @@ -33,9 +37,13 @@ module Command import Dom import Dom.Scroll import Json.Encode as Encode +import Json.Decode as Decode +import HttpBuilder +import Mastodon.ApiUrl as ApiUrl +import Mastodon.Decoder exposing (..) +import Mastodon.Encoder exposing (..) +import Mastodon.Http exposing (..) import Mastodon.Model exposing (..) -import Mastodon.Encoder -import Mastodon.Http import Navigation import Ports import Task @@ -49,9 +57,7 @@ initCommands registration client authCode = Just authCode -> case registration of Just registration -> - [ Mastodon.Http.getAccessToken registration authCode - |> Mastodon.Http.send (MastodonEvent << AccessToken) - ] + [ getAccessToken registration authCode ] Nothing -> [] @@ -60,15 +66,23 @@ initCommands registration client authCode = [ loadUserAccount client, loadTimelines client ] +getAccessToken : AppRegistration -> String -> Cmd Msg +getAccessToken registration authCode = + HttpBuilder.post (registration.server ++ ApiUrl.oauthToken) + |> HttpBuilder.withJsonBody (authorizationCodeEncoder registration authCode) + |> withBodyDecoder (accessTokenDecoder registration) + |> send (MastodonEvent << AccessToken) + + navigateToAuthUrl : AppRegistration -> Cmd Msg navigateToAuthUrl registration = - Navigation.load <| Mastodon.Http.getAuthorizationUrl registration + Navigation.load <| getAuthorizationUrl registration registerApp : Model -> Cmd Msg registerApp { server, location } = let - appUrl = + redirectUri = location.origin ++ location.pathname cleanServer = @@ -76,36 +90,46 @@ registerApp { server, location } = String.dropRight 1 server else server - in - Mastodon.Http.register - cleanServer + + clientName = "tooty" - appUrl + + scope = "read write follow" + + website = "https://github.com/n1k0/tooty" - |> Mastodon.Http.send (MastodonEvent << AppRegistered) + in + HttpBuilder.post (cleanServer ++ ApiUrl.apps) + |> withBodyDecoder (appRegistrationDecoder cleanServer scope) + |> HttpBuilder.withJsonBody + (appRegistrationEncoder clientName redirectUri scope website) + |> send (MastodonEvent << AppRegistered) saveClient : Client -> Cmd Msg saveClient client = - Mastodon.Encoder.clientEncoder client + clientEncoder client |> Encode.encode 0 |> Ports.saveClient saveRegistration : AppRegistration -> Cmd Msg saveRegistration registration = - Mastodon.Encoder.registrationEncoder registration + registrationEncoder registration |> Encode.encode 0 |> Ports.saveRegistration loadNotifications : Maybe Client -> Cmd Msg loadNotifications client = + -- TODO: handle link (see loadUserTimeline) case client of Just client -> - Mastodon.Http.fetchNotifications client - |> Mastodon.Http.send (MastodonEvent << Notifications) + HttpBuilder.get ApiUrl.notifications + |> withClient client + |> withBodyDecoder (Decode.list notificationDecoder) + |> send (MastodonEvent << Notifications) Nothing -> Cmd.none @@ -115,8 +139,10 @@ loadUserAccount : Maybe Client -> Cmd Msg loadUserAccount client = case client of Just client -> - Mastodon.Http.userAccount client - |> Mastodon.Http.send (MastodonEvent << CurrentUser) + HttpBuilder.get ApiUrl.userAccount + |> withClient client + |> withBodyDecoder accountDecoder + |> send (MastodonEvent << CurrentUser) Nothing -> Cmd.none @@ -127,33 +153,26 @@ loadAccount client accountId = case client of Just client -> Cmd.batch - [ Mastodon.Http.fetchAccount client accountId - |> Mastodon.Http.send (MastodonEvent << AccountReceived) - , Mastodon.Http.fetchRelationships client [ accountId ] - |> Mastodon.Http.send (MastodonEvent << AccountRelationship) + [ HttpBuilder.get (ApiUrl.account accountId) + |> withClient client + |> withBodyDecoder accountDecoder + |> send (MastodonEvent << AccountReceived) + , requestRelationships client [ accountId ] + |> send (MastodonEvent << AccountRelationship) ] Nothing -> Cmd.none -loadAccountTimeline : Maybe Client -> Int -> Cmd Msg -loadAccountTimeline client accountId = - case client of - Just client -> - Mastodon.Http.fetchAccountTimeline client accountId - |> Mastodon.Http.send (MastodonEvent << AccountTimeline) - - Nothing -> - Cmd.none - - loadAccountFollowers : Maybe Client -> Int -> Cmd Msg loadAccountFollowers client accountId = case client of Just client -> - Mastodon.Http.fetchAccountFollowers client accountId - |> Mastodon.Http.send (MastodonEvent << AccountFollowers) + HttpBuilder.get (ApiUrl.followers accountId) + |> withClient client + |> withBodyDecoder (Decode.list accountDecoder) + |> send (MastodonEvent << AccountFollowers) Nothing -> Cmd.none @@ -163,8 +182,10 @@ loadAccountFollowing : Maybe Client -> Int -> Cmd Msg loadAccountFollowing client accountId = case client of Just client -> - Mastodon.Http.fetchAccountFollowing client accountId - |> Mastodon.Http.send (MastodonEvent << AccountFollowing) + HttpBuilder.get (ApiUrl.following accountId) + |> withClient client + |> withBodyDecoder (Decode.list accountDecoder) + |> send (MastodonEvent << AccountFollowing) Nothing -> Cmd.none @@ -177,19 +198,43 @@ searchAccounts client query limit resolve = else case client of Just client -> - Mastodon.Http.searchAccounts client query limit resolve - |> Mastodon.Http.send (MastodonEvent << AutoSearch) + let + qs = + [ ( "q", query ) + , ( "limit", toString limit ) + , ( "resolve" + , if resolve then + "true" + else + "false" + ) + ] + in + HttpBuilder.get ApiUrl.searchAccount + |> withClient client + |> withBodyDecoder (Decode.list accountDecoder) + |> withQueryParams qs + |> send (MastodonEvent << AutoSearch) Nothing -> Cmd.none +requestRelationships : Client -> List Int -> Request (List Relationship) +requestRelationships client ids = + HttpBuilder.get ApiUrl.relationships + |> withClient client + |> withBodyDecoder (Decode.list relationshipDecoder) + |> withQueryParams + (List.map (\id -> ( "id[]", toString id )) ids) + + loadRelationships : Maybe Client -> List Int -> Cmd Msg -loadRelationships client accountIds = +loadRelationships client ids = case client of Just client -> - Mastodon.Http.fetchRelationships client accountIds - |> Mastodon.Http.send (MastodonEvent << AccountRelationships) + requestRelationships client ids + |> send (MastodonEvent << AccountRelationships) Nothing -> Cmd.none @@ -199,8 +244,63 @@ loadThread : Maybe Client -> Status -> Cmd Msg loadThread client status = case client of Just client -> - Mastodon.Http.context client status.id - |> Mastodon.Http.send (MastodonEvent << (ContextLoaded status)) + HttpBuilder.get (ApiUrl.context status.id) + |> withClient client + |> withBodyDecoder contextDecoder + |> send (MastodonEvent << (ContextLoaded status)) + + Nothing -> + Cmd.none + + +loadUserTimeline : Maybe Client -> Maybe String -> Cmd Msg +loadUserTimeline client url = + case client of + Just client -> + HttpBuilder.get (Maybe.withDefault ApiUrl.homeTimeline url) + |> withClient client + |> withBodyDecoder (Decode.list statusDecoder) + |> send (MastodonEvent << UserTimeline (url /= Nothing)) + + Nothing -> + Cmd.none + + +loadLocalTimeline : Maybe Client -> Maybe String -> Cmd Msg +loadLocalTimeline client url = + case client of + Just client -> + HttpBuilder.get (Maybe.withDefault ApiUrl.publicTimeline url) + |> withClient client + |> withBodyDecoder (Decode.list statusDecoder) + |> withQueryParams [ ( "local", "true" ) ] + |> send (MastodonEvent << LocalTimeline (url /= Nothing)) + + Nothing -> + Cmd.none + + +loadGlobalTimeline : Maybe Client -> Maybe String -> Cmd Msg +loadGlobalTimeline client url = + case client of + Just client -> + HttpBuilder.get (Maybe.withDefault ApiUrl.publicTimeline url) + |> withClient client + |> withBodyDecoder (Decode.list statusDecoder) + |> send (MastodonEvent << GlobalTimeline (url /= Nothing)) + + Nothing -> + Cmd.none + + +loadAccountTimeline : Maybe Client -> Int -> Maybe String -> Cmd Msg +loadAccountTimeline client accountId url = + case client of + Just client -> + HttpBuilder.get (Maybe.withDefault (ApiUrl.accountTimeline accountId) url) + |> withClient client + |> withBodyDecoder (Decode.list statusDecoder) + |> send (MastodonEvent << AccountTimeline (url /= Nothing)) Nothing -> Cmd.none @@ -208,19 +308,35 @@ loadThread client status = loadTimelines : Maybe Client -> Cmd Msg loadTimelines client = - case client of - Just client -> - Cmd.batch - [ Mastodon.Http.fetchUserTimeline client - |> Mastodon.Http.send (MastodonEvent << UserTimeline) - , Mastodon.Http.fetchLocalTimeline client - |> Mastodon.Http.send (MastodonEvent << LocalTimeline) - , Mastodon.Http.fetchGlobalTimeline client - |> Mastodon.Http.send (MastodonEvent << GlobalTimeline) - , loadNotifications <| Just client - ] + Cmd.batch + [ loadUserTimeline client Nothing + , loadLocalTimeline client Nothing + , loadGlobalTimeline client Nothing + , loadNotifications client + ] - Nothing -> + +loadNextTimeline : Maybe Client -> CurrentView -> Timeline -> Cmd Msg +loadNextTimeline client currentView { id, links } = + case id of + "home-timeline" -> + loadUserTimeline client links.next + + "local-timeline" -> + loadLocalTimeline client links.next + + "global-timeline" -> + loadGlobalTimeline client links.next + + "account-timeline" -> + case currentView of + AccountView account -> + loadAccountTimeline client account.id links.next + + _ -> + Cmd.none + + _ -> Cmd.none @@ -228,8 +344,11 @@ postStatus : Maybe Client -> StatusRequestBody -> Cmd Msg postStatus client draft = case client of Just client -> - Mastodon.Http.postStatus client draft - |> Mastodon.Http.send (MastodonEvent << StatusPosted) + HttpBuilder.post ApiUrl.statuses + |> withClient client + |> HttpBuilder.withJsonBody (statusRequestBodyEncoder draft) + |> withBodyDecoder statusDecoder + |> send (MastodonEvent << StatusPosted) Nothing -> Cmd.none @@ -244,8 +363,10 @@ deleteStatus : Maybe Client -> Int -> Cmd Msg deleteStatus client id = case client of Just client -> - Mastodon.Http.deleteStatus client id - |> Mastodon.Http.send (MastodonEvent << StatusDeleted) + HttpBuilder.delete (ApiUrl.status id) + |> withClient client + |> withBodyDecoder (Decode.succeed id) + |> send (MastodonEvent << StatusDeleted) Nothing -> Cmd.none @@ -255,8 +376,10 @@ reblogStatus : Maybe Client -> Int -> Cmd Msg reblogStatus client statusId = case client of Just client -> - Mastodon.Http.reblog client statusId - |> Mastodon.Http.send (MastodonEvent << Reblogged) + HttpBuilder.post (ApiUrl.reblog statusId) + |> withClient client + |> withBodyDecoder statusDecoder + |> send (MastodonEvent << Reblogged) Nothing -> Cmd.none @@ -266,8 +389,10 @@ unreblogStatus : Maybe Client -> Int -> Cmd Msg unreblogStatus client statusId = case client of Just client -> - Mastodon.Http.unreblog client statusId - |> Mastodon.Http.send (MastodonEvent << Unreblogged) + HttpBuilder.post (ApiUrl.unreblog statusId) + |> withClient client + |> withBodyDecoder statusDecoder + |> send (MastodonEvent << Unreblogged) Nothing -> Cmd.none @@ -277,8 +402,10 @@ favouriteStatus : Maybe Client -> Int -> Cmd Msg favouriteStatus client statusId = case client of Just client -> - Mastodon.Http.favourite client statusId - |> Mastodon.Http.send (MastodonEvent << FavoriteAdded) + HttpBuilder.post (ApiUrl.favourite statusId) + |> withClient client + |> withBodyDecoder statusDecoder + |> send (MastodonEvent << FavoriteAdded) Nothing -> Cmd.none @@ -288,8 +415,10 @@ unfavouriteStatus : Maybe Client -> Int -> Cmd Msg unfavouriteStatus client statusId = case client of Just client -> - Mastodon.Http.unfavourite client statusId - |> Mastodon.Http.send (MastodonEvent << FavoriteRemoved) + HttpBuilder.post (ApiUrl.unfavourite statusId) + |> withClient client + |> withBodyDecoder statusDecoder + |> send (MastodonEvent << FavoriteRemoved) Nothing -> Cmd.none @@ -299,8 +428,10 @@ follow : Maybe Client -> Int -> Cmd Msg follow client id = case client of Just client -> - Mastodon.Http.follow client id - |> Mastodon.Http.send (MastodonEvent << AccountFollowed) + HttpBuilder.post (ApiUrl.follow id) + |> withClient client + |> withBodyDecoder relationshipDecoder + |> send (MastodonEvent << AccountFollowed) Nothing -> Cmd.none @@ -310,8 +441,10 @@ unfollow : Maybe Client -> Int -> Cmd Msg unfollow client id = case client of Just client -> - Mastodon.Http.unfollow client id - |> Mastodon.Http.send (MastodonEvent << AccountUnfollowed) + HttpBuilder.post (ApiUrl.unfollow id) + |> withClient client + |> withBodyDecoder relationshipDecoder + |> send (MastodonEvent << AccountUnfollowed) Nothing -> Cmd.none diff --git a/src/Mastodon/Http.elm b/src/Mastodon/Http.elm index e44ce16..6ece168 100644 --- a/src/Mastodon/Http.elm +++ b/src/Mastodon/Http.elm @@ -1,32 +1,19 @@ module Mastodon.Http exposing - ( Request - , context - , reblog - , unreblog - , favourite - , unfavourite - , follow - , unfollow - , register + ( Links + , Action(..) + , Request + , Response + , extractLinks , getAuthorizationUrl - , getAccessToken - , fetchAccount - , fetchAccountTimeline - , fetchAccountFollowers - , fetchAccountFollowing - , fetchLocalTimeline - , fetchNotifications - , fetchGlobalTimeline - , fetchUserTimeline - , fetchRelationships - , postStatus - , deleteStatus - , userAccount , send - , searchAccounts + , withClient + , withBodyDecoder + , withQueryParams ) +import Dict +import Dict.Extra exposing (mapKeys) import Http import HttpBuilder as Build import Json.Decode as Decode @@ -36,14 +23,32 @@ import Mastodon.Encoder exposing (..) import Mastodon.Model exposing (..) -type Method - = GET - | POST - | DELETE +type Action + = GET String + | POST String + | DELETE String + + +type Link + = Prev + | Next + | None + + +type alias Links = + { prev : Maybe String + , next : Maybe String + } type alias Request a = - Build.RequestBuilder a + Build.RequestBuilder (Response a) + + +type alias Response a = + { decoded : a + , links : Links + } extractMastodonError : Int -> String -> String -> Error @@ -80,40 +85,70 @@ toResponse result = Result.mapError extractError result -request : String -> Method -> String -> Decode.Decoder a -> Request a -request server method endpoint decoder = +extractLinks : Dict.Dict String String -> Links +extractLinks headers = + -- The link header content is this form: + -- ; rel="next", ; rel="prev" + -- Note: Chrome and Firefox don't expose header names the same way. Firefox + -- will use "Link" when Chrome uses "link"; that's why we lowercase them. let - httpMethod = - case method of - GET -> - Build.get + crop = + (String.dropLeft 1) >> (String.dropRight 1) - POST -> - Build.post + parseDef parts = + case parts of + [ url, "rel=\"next\"" ] -> + [ ( "next", crop url ) ] - DELETE -> - Build.delete + [ url, "rel=\"prev\"" ] -> + [ ( "prev", crop url ) ] + + _ -> + [] + + parseLink link = + link + |> String.split ";" + |> List.map String.trim + |> parseDef + + parseLinks content = + content + |> String.split "," + |> List.map String.trim + |> List.map parseLink + |> List.concat + |> Dict.fromList in - httpMethod (server ++ endpoint) - |> Build.withExpect (Http.expectJson decoder) + case (headers |> mapKeys String.toLower |> Dict.get "link") of + Nothing -> + { prev = Nothing, next = Nothing } + + Just content -> + let + links = + parseLinks content + in + { prev = (Dict.get "prev" links) + , next = (Dict.get "next" links) + } -authRequest : Client -> Method -> String -> Decode.Decoder a -> Request a -authRequest client method endpoint decoder = - request client.server method endpoint decoder - |> Build.withHeader "Authorization" ("Bearer " ++ client.token) +decodeResponse : Decode.Decoder a -> Http.Response String -> Result.Result String (Response a) +decodeResponse decoder response = + let + decoded = + Decode.decodeString decoder response.body + links = + extractLinks response.headers + in + case decoded of + Ok decoded -> + Ok <| Response decoded links -register : String -> String -> String -> String -> String -> Request AppRegistration -register server clientName redirectUri scope website = - request server POST ApiUrl.apps (appRegistrationDecoder server scope) - |> Build.withJsonBody (appRegistrationEncoder clientName redirectUri scope website) - - -getAccessToken : AppRegistration -> String -> Request AccessTokenResult -getAccessToken registration authCode = - request registration.server POST ApiUrl.oauthToken (accessTokenDecoder registration) - |> Build.withJsonBody (authorizationCodeEncoder registration authCode) + Err error -> + Err error getAuthorizationUrl : AppRegistration -> String @@ -126,119 +161,38 @@ getAuthorizationUrl registration = ] -send : (Result Error a -> msg) -> Request a -> Cmd msg -send tagger builder = - Build.send (toResponse >> tagger) builder +send : (Result Error a -> msg) -> Build.RequestBuilder a -> Cmd msg +send tagger request = + Build.send (toResponse >> tagger) request -fetchAccount : Client -> Int -> Request Account -fetchAccount client accountId = - authRequest client GET (ApiUrl.account accountId) accountDecoder +isLinkUrl : String -> Bool +isLinkUrl url = + String.contains "max_id=" url || String.contains "since_id=" url -fetchUserTimeline : Client -> Request (List Status) -fetchUserTimeline client = - authRequest client GET ApiUrl.homeTimeline <| Decode.list statusDecoder +withClient : Client -> Build.RequestBuilder a -> Build.RequestBuilder a +withClient { server, token } builder = + let + finalUrl = + if isLinkUrl builder.url then + builder.url + else + server ++ builder.url + in + { builder | url = finalUrl } + |> Build.withHeader "Authorization" ("Bearer " ++ token) -fetchRelationships : Client -> List Int -> Request (List Relationship) -fetchRelationships client ids = - authRequest client GET ApiUrl.relationships (Decode.list relationshipDecoder) - |> Build.withQueryParams (List.map (\id -> ( "id[]", toString id )) ids) +withBodyDecoder : Decode.Decoder b -> Build.RequestBuilder a -> Request b +withBodyDecoder decoder builder = + Build.withExpect (Http.expectStringResponse (decodeResponse decoder)) builder -fetchLocalTimeline : Client -> Request (List Status) -fetchLocalTimeline client = - authRequest client GET ApiUrl.publicTimeline (Decode.list statusDecoder) - |> Build.withQueryParams [ ( "local", "true" ) ] - - -fetchGlobalTimeline : Client -> Request (List Status) -fetchGlobalTimeline client = - authRequest client GET ApiUrl.publicTimeline <| Decode.list statusDecoder - - -fetchAccountTimeline : Client -> Int -> Request (List Status) -fetchAccountTimeline client id = - authRequest client GET (ApiUrl.accountTimeline id) <| Decode.list statusDecoder - - -fetchNotifications : Client -> Request (List Notification) -fetchNotifications client = - authRequest client GET (ApiUrl.notifications) <| Decode.list notificationDecoder - - -fetchAccountFollowers : Client -> Int -> Request (List Account) -fetchAccountFollowers client accountId = - authRequest client GET (ApiUrl.followers accountId) <| Decode.list accountDecoder - - -fetchAccountFollowing : Client -> Int -> Request (List Account) -fetchAccountFollowing client accountId = - authRequest client GET (ApiUrl.following accountId) <| Decode.list accountDecoder - - -searchAccounts : Client -> String -> Int -> Bool -> Request (List Account) -searchAccounts client query limit resolve = - authRequest client GET ApiUrl.searchAccount (Decode.list accountDecoder) - |> Build.withQueryParams - [ ( "q", query ) - , ( "limit", toString limit ) - , ( "resolve" - , if resolve then - "true" - else - "false" - ) - ] - - -userAccount : Client -> Request Account -userAccount client = - authRequest client GET ApiUrl.userAccount accountDecoder - - -postStatus : Client -> StatusRequestBody -> Request Status -postStatus client statusRequestBody = - authRequest client POST ApiUrl.statuses statusDecoder - |> Build.withJsonBody (statusRequestBodyEncoder statusRequestBody) - - -deleteStatus : Client -> Int -> Request Int -deleteStatus client id = - authRequest client DELETE (ApiUrl.status id) <| Decode.succeed id - - -context : Client -> Int -> Request Context -context client id = - authRequest client GET (ApiUrl.context id) contextDecoder - - -reblog : Client -> Int -> Request Status -reblog client id = - authRequest client POST (ApiUrl.reblog id) statusDecoder - - -unreblog : Client -> Int -> Request Status -unreblog client id = - authRequest client POST (ApiUrl.unreblog id) statusDecoder - - -favourite : Client -> Int -> Request Status -favourite client id = - authRequest client POST (ApiUrl.favourite id) statusDecoder - - -unfavourite : Client -> Int -> Request Status -unfavourite client id = - authRequest client POST (ApiUrl.unfavourite id) statusDecoder - - -follow : Client -> Int -> Request Relationship -follow client id = - authRequest client POST (ApiUrl.follow id) relationshipDecoder - - -unfollow : Client -> Int -> Request Relationship -unfollow client id = - authRequest client POST (ApiUrl.unfollow id) relationshipDecoder +withQueryParams : List ( String, String ) -> Build.RequestBuilder a -> Build.RequestBuilder a +withQueryParams params builder = + if isLinkUrl builder.url then + -- that's a link url, don't append any query string + builder + else + Build.withQueryParams params builder diff --git a/src/Model.elm b/src/Model.elm index 0f6b53b..e95d7d0 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -5,6 +5,7 @@ import Command import Navigation import Mastodon.Decoder import Mastodon.Helper +import Mastodon.Http exposing (Links) import Mastodon.Model exposing (..) import Mastodon.WebSocket import String.Extra @@ -55,10 +56,10 @@ init flags location = { server = "" , registration = flags.registration , client = flags.client - , userTimeline = [] - , localTimeline = [] - , globalTimeline = [] - , accountTimeline = [] + , userTimeline = emptyTimeline "home-timeline" + , localTimeline = emptyTimeline "local-timeline" + , globalTimeline = emptyTimeline "global-timeline" + , accountTimeline = emptyTimeline "account-timeline" , accountFollowers = [] , accountFollowing = [] , accountRelationships = [] @@ -76,6 +77,14 @@ init flags location = ! [ Command.initCommands flags.registration flags.client authCode ] +emptyTimeline : String -> Timeline +emptyTimeline id = + { id = id + , statuses = [] + , links = Links Nothing Nothing + } + + preferredTimeline : Model -> CurrentView preferredTimeline model = if model.useGlobalTimeline then @@ -84,11 +93,6 @@ preferredTimeline model = LocalTimelineView -truncate : List a -> List a -truncate entries = - List.take maxBuffer entries - - errorText : Error -> String errorText error = case error of @@ -129,12 +133,15 @@ updateTimelinesWithBoolFlag statusId flag statusUpdater model = statusUpdater status else status + + updateTimeline timeline = + { timeline | statuses = List.map update timeline.statuses } in { model - | userTimeline = List.map update model.userTimeline - , accountTimeline = List.map update model.accountTimeline - , localTimeline = List.map update model.localTimeline - , globalTimeline = List.map update model.globalTimeline + | userTimeline = updateTimeline model.userTimeline + , accountTimeline = updateTimeline model.accountTimeline + , localTimeline = updateTimeline model.localTimeline + , globalTimeline = updateTimeline model.globalTimeline , currentView = case model.currentView of ThreadView thread -> @@ -191,16 +198,16 @@ processReblog statusId flag model = model -deleteStatusFromTimeline : Int -> List Status -> List Status +deleteStatusFromTimeline : Int -> Timeline -> Timeline deleteStatusFromTimeline statusId timeline = - timeline - |> List.filter - (\s -> - s.id - /= statusId - && (Mastodon.Helper.extractReblog s).id - /= statusId - ) + let + update status = + status.id + /= statusId + && (Mastodon.Helper.extractReblog status).id + /= statusId + in + { timeline | statuses = List.filter update timeline.statuses } deleteStatusFromAllTimelines : Int -> Model -> Model @@ -473,15 +480,32 @@ updateViewer viewerMsg viewer = (Just <| Viewer attachments attachment) ! [] +updateTimeline : Bool -> List Status -> Links -> Timeline -> Timeline +updateTimeline append statuses links timeline = + let + newStatuses = + if append then + List.concat [ timeline.statuses, statuses ] + else + statuses + in + { timeline | statuses = newStatuses, links = links } + + +prependStatusToTimeline : Status -> Timeline -> Timeline +prependStatusToTimeline status timeline = + { timeline | statuses = status :: timeline.statuses } + + processMastodonEvent : MastodonMsg -> Model -> ( Model, Cmd Msg ) processMastodonEvent msg model = case msg of AccessToken result -> case result of - Ok { server, accessToken } -> + Ok { decoded } -> let client = - Client server accessToken + Client decoded.server decoded.accessToken in { model | client = Just client } ! [ Command.loadTimelines <| Just client @@ -495,26 +519,26 @@ processMastodonEvent msg model = AccountFollowed result -> case result of - Ok relationship -> - processFollowEvent relationship True model ! [] + Ok { decoded } -> + processFollowEvent decoded True model ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AccountUnfollowed result -> case result of - Ok relationship -> - processFollowEvent relationship False model ! [] + Ok { decoded } -> + processFollowEvent decoded False model ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AppRegistered result -> case result of - Ok registration -> - { model | registration = Just registration } - ! [ Command.saveRegistration registration - , Command.navigateToAuthUrl registration + Ok { decoded } -> + { model | registration = Just decoded } + ! [ Command.saveRegistration decoded + , Command.navigateToAuthUrl decoded ] Err error -> @@ -522,8 +546,8 @@ processMastodonEvent msg model = ContextLoaded status result -> case result of - Ok context -> - { model | currentView = ThreadView (Thread status context) } + Ok { decoded } -> + { model | currentView = ThreadView (Thread status decoded) } ! [ Command.scrollToThreadStatus <| toString status.id ] Err error -> @@ -535,15 +559,15 @@ processMastodonEvent msg model = CurrentUser result -> case result of - Ok currentUser -> - { model | currentUser = Just currentUser } ! [] + Ok { decoded } -> + { model | currentUser = Just decoded } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] FavoriteAdded result -> case result of - Ok status -> + Ok _ -> model ! [ Command.loadNotifications model.client ] Err error -> @@ -551,39 +575,40 @@ processMastodonEvent msg model = FavoriteRemoved result -> case result of - Ok status -> + Ok _ -> model ! [ Command.loadNotifications model.client ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] - LocalTimeline result -> + LocalTimeline append result -> case result of - Ok localTimeline -> - { model | localTimeline = localTimeline } ! [] + Ok { decoded, links } -> + { model | localTimeline = updateTimeline append decoded links model.localTimeline } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] Notifications result -> case result of - Ok notifications -> - { model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! [] + Ok { decoded } -> + -- TODO: store next link + { model | notifications = Mastodon.Helper.aggregateNotifications decoded } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] - GlobalTimeline result -> + GlobalTimeline append result -> case result of - Ok globalTimeline -> - { model | globalTimeline = globalTimeline } ! [] + Ok { decoded, links } -> + { model | globalTimeline = updateTimeline append decoded links model.globalTimeline } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] Reblogged result -> case result of - Ok status -> + Ok _ -> model ! [ Command.loadNotifications model.client ] Err error -> @@ -591,21 +616,21 @@ processMastodonEvent msg model = StatusPosted _ -> { model | draft = defaultDraft } - ! [ Command.scrollColumnToTop "home" + ! [ Command.scrollColumnToTop "home-timeline" , Command.updateDomStatus defaultDraft.status ] StatusDeleted result -> case result of - Ok id -> - deleteStatusFromAllTimelines id model ! [] + Ok { decoded } -> + deleteStatusFromAllTimelines decoded model ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] Unreblogged result -> case result of - Ok status -> + Ok _ -> model ! [ Command.loadNotifications model.client ] Err error -> @@ -613,9 +638,9 @@ processMastodonEvent msg model = AccountReceived result -> case result of - Ok account -> - { model | currentView = AccountView account } - ! [ Command.loadAccountTimeline model.client account.id ] + Ok { decoded } -> + { model | currentView = AccountView decoded } + ! [ Command.loadAccountTimeline model.client decoded.id model.userTimeline.links.next ] Err error -> { model @@ -624,55 +649,60 @@ processMastodonEvent msg model = } ! [] - AccountTimeline result -> + AccountTimeline append result -> case result of - Ok statuses -> - { model | accountTimeline = statuses } ! [] + Ok { decoded, links } -> + { model | accountTimeline = updateTimeline append decoded links model.accountTimeline } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AccountFollowers result -> case result of - Ok followers -> - { model | accountFollowers = followers } - ! [ Command.loadRelationships model.client <| List.map .id followers ] + Ok { decoded } -> + -- TODO: store next link + { model | accountFollowers = decoded } + ! [ Command.loadRelationships model.client <| List.map .id decoded ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AccountFollowing result -> case result of - Ok following -> - { model | accountFollowing = following } - ! [ Command.loadRelationships model.client <| List.map .id following ] + Ok { decoded } -> + -- TODO: store next link + { model | accountFollowing = decoded } + ! [ Command.loadRelationships model.client <| List.map .id decoded ] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AccountRelationship result -> case result of - Ok [ relationship ] -> - { model | accountRelationship = Just relationship } ! [] + Ok { decoded } -> + case decoded of + [ relationship ] -> + { model | accountRelationship = Just relationship } ! [] - Ok _ -> - model ! [] + _ -> + model ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] AccountRelationships result -> case result of - Ok relationships -> - { model | accountRelationships = relationships } ! [] + Ok { decoded } -> + -- TODO: store next link + { model | accountRelationships = decoded } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] - UserTimeline result -> + UserTimeline append result -> case result of - Ok userTimeline -> - { model | userTimeline = userTimeline } ! [] + Ok { decoded, links } -> + { model | userTimeline = updateTimeline append decoded links model.userTimeline } ! [] Err error -> { model | errors = (errorText error) :: model.errors } ! [] @@ -683,16 +713,16 @@ processMastodonEvent msg model = model.draft in case result of - Ok accounts -> + Ok { decoded } -> { model | draft = { draft | showAutoMenu = showAutoMenu - accounts + decoded draft.autoAtPosition draft.autoQuery - , autoAccounts = accounts + , autoAccounts = decoded } } -- Force selection of the first item after each @@ -734,7 +764,7 @@ processWebSocketMsg msg model = Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> - { model | userTimeline = truncate (status :: model.userTimeline) } ! [] + { model | userTimeline = prependStatusToTimeline status model.userTimeline } ! [] Err error -> { model | errors = error :: model.errors } ! [] @@ -756,7 +786,7 @@ processWebSocketMsg msg model = notification model.notifications in - { model | notifications = truncate notifications } ! [] + { model | notifications = notifications } ! [] Err error -> { model | errors = error :: model.errors } ! [] @@ -769,7 +799,7 @@ processWebSocketMsg msg model = Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> - { model | localTimeline = truncate (status :: model.localTimeline) } ! [] + { model | localTimeline = prependStatusToTimeline status model.localTimeline } ! [] Err error -> { model | errors = error :: model.errors } ! [] @@ -793,7 +823,7 @@ processWebSocketMsg msg model = Mastodon.WebSocket.StatusUpdateEvent result -> case result of Ok status -> - { model | globalTimeline = truncate (status :: model.globalTimeline) } ! [] + { model | globalTimeline = prependStatusToTimeline status model.globalTimeline } ! [] Err error -> { model | errors = error :: model.errors } ! [] @@ -886,7 +916,7 @@ update msg model = LoadAccount accountId -> { model - | accountTimeline = [] + | accountTimeline = emptyTimeline "account-timeline" , accountFollowers = [] , accountFollowing = [] , accountRelationships = [] @@ -894,6 +924,9 @@ update msg model = } ! [ Command.loadAccount model.client accountId ] + LoadNext timeline -> + model ! [ Command.loadNextTimeline model.client model.currentView timeline ] + ViewAccountFollowers account -> { model | currentView = AccountFollowersView account model.accountFollowers } ! [ Command.loadAccountFollowers model.client account.id ] @@ -915,7 +948,7 @@ update msg model = CloseAccount -> { model | currentView = preferredTimeline model - , accountTimeline = [] + , accountTimeline = emptyTimeline "account-timeline" , accountFollowing = [] , accountFollowers = [] } diff --git a/src/Types.elm b/src/Types.elm index 6d6d10f..8d5aff3 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,6 +1,7 @@ module Types exposing (..) import Autocomplete +import Mastodon.Http exposing (Response, Links) import Mastodon.Model exposing (..) import Navigation @@ -29,30 +30,34 @@ type ViewerMsg | OpenViewer (List Attachment) Attachment +type alias MastodonResult a = + Result Error (Response a) + + type MastodonMsg - = AccessToken (Result Error AccessTokenResult) - | AccountFollowed (Result Error Relationship) - | AccountFollowers (Result Error (List Account)) - | AccountFollowing (Result Error (List Account)) - | AccountReceived (Result Error Account) - | AccountRelationship (Result Error (List Relationship)) - | AccountRelationships (Result Error (List Relationship)) - | AccountTimeline (Result Error (List Status)) - | AccountUnfollowed (Result Error Relationship) - | AppRegistered (Result Error AppRegistration) - | ContextLoaded Status (Result Error Context) - | CurrentUser (Result Error Account) - | FavoriteAdded (Result Error Status) - | FavoriteRemoved (Result Error Status) - | GlobalTimeline (Result Error (List Status)) - | LocalTimeline (Result Error (List Status)) - | Notifications (Result Error (List Notification)) - | Reblogged (Result Error Status) - | StatusDeleted (Result Error Int) - | StatusPosted (Result Error Status) - | Unreblogged (Result Error Status) - | UserTimeline (Result Error (List Status)) - | AutoSearch (Result Error (List Account)) + = AccessToken (MastodonResult AccessTokenResult) + | AccountFollowed (MastodonResult Relationship) + | AccountFollowers (MastodonResult (List Account)) + | AccountFollowing (MastodonResult (List Account)) + | AccountReceived (MastodonResult Account) + | AccountRelationship (MastodonResult (List Relationship)) + | AccountRelationships (MastodonResult (List Relationship)) + | AccountTimeline Bool (MastodonResult (List Status)) + | AccountUnfollowed (MastodonResult Relationship) + | AppRegistered (MastodonResult AppRegistration) + | AutoSearch (MastodonResult (List Account)) + | ContextLoaded Status (MastodonResult Context) + | CurrentUser (MastodonResult Account) + | FavoriteAdded (MastodonResult Status) + | FavoriteRemoved (MastodonResult Status) + | GlobalTimeline Bool (MastodonResult (List Status)) + | LocalTimeline Bool (MastodonResult (List Status)) + | Notifications (MastodonResult (List Notification)) + | Reblogged (MastodonResult Status) + | StatusDeleted (MastodonResult Int) + | StatusPosted (MastodonResult Status) + | Unreblogged (MastodonResult Status) + | UserTimeline Bool (MastodonResult (List Status)) type WebSocketMsg @@ -70,6 +75,7 @@ type Msg | FilterNotifications NotificationFilter | FollowAccount Int | LoadAccount Int + | LoadNext Timeline | MastodonEvent MastodonMsg | NoOp | OpenThread Status @@ -90,14 +96,6 @@ type Msg | WebSocketEvent WebSocketMsg -type alias AccountViewInfo = - { account : Account - , timeline : List Status - , folowers : List Account - , following : List Account - } - - type CurrentView = -- Basically, what we should be displaying in the fourth column AccountFollowersView Account (List Account) @@ -152,14 +150,21 @@ type alias Viewer = } +type alias Timeline = + { id : String + , statuses : List Status + , links : Links + } + + type alias Model = { server : String , registration : Maybe AppRegistration , client : Maybe Client - , userTimeline : List Status - , localTimeline : List Status - , globalTimeline : List Status - , accountTimeline : List Status + , userTimeline : Timeline + , localTimeline : Timeline + , globalTimeline : Timeline + , accountTimeline : Timeline , accountFollowers : List Account , accountFollowing : List Account , accountRelationships : List Relationship diff --git a/src/View/Account.elm b/src/View/Account.elm index 3c75067..19a35f5 100644 --- a/src/View/Account.elm +++ b/src/View/Account.elm @@ -122,18 +122,21 @@ accountFollowView currentUser accounts relationships relationship account = List.map keyedEntry accounts -accountTimelineView : CurrentUser -> List Status -> CurrentUserRelation -> Account -> Html Msg -accountTimelineView currentUser statuses relationship account = +accountTimelineView : CurrentUser -> Timeline -> CurrentUserRelation -> Account -> Html Msg +accountTimelineView currentUser timeline relationship account = let keyedEntry status = ( toString status.id , li [ class "list-group-item status" ] [ Lazy.lazy2 statusView "account" status ] ) + + entries = + List.map keyedEntry timeline.statuses in accountView currentUser account relationship <| - Keyed.ul [ class "list-group" ] <| - List.map keyedEntry statuses + Keyed.ul [ id timeline.id, class "list-group" ] <| + (entries ++ [ ( "load-more", Common.loadMoreBtn timeline ) ]) accountView : CurrentUser -> Account -> CurrentUserRelation -> Html Msg -> Html Msg diff --git a/src/View/App.elm b/src/View/App.elm index bc249f4..c781257 100644 --- a/src/View/App.elm +++ b/src/View/App.elm @@ -27,23 +27,56 @@ type alias CurrentUserRelation = Maybe Relationship -timelineView : ( String, String, String, CurrentUser, List Status ) -> Html Msg -timelineView ( label, iconName, context, currentUser, statuses ) = +timelineView : ( String, String, CurrentUser, Timeline ) -> Html Msg +timelineView ( label, iconName, currentUser, timeline ) = let keyedEntry status = - ( toString id, statusEntryView context "" currentUser status ) + ( toString id, statusEntryView timeline.id "" currentUser status ) + + entries = + List.map keyedEntry timeline.statuses in div [ class "col-md-3 column" ] [ div [ class "panel panel-default" ] [ a - [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop context ] + [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop timeline.id ] [ div [ class "panel-heading" ] [ Common.icon iconName, text label ] ] - , Keyed.ul [ id context, class "list-group timeline" ] <| - List.map keyedEntry statuses + , Keyed.ul [ id timeline.id, class "list-group timeline" ] <| + (entries ++ [ ( "load-more", Common.loadMoreBtn timeline ) ]) ] ] +userTimelineView : CurrentUser -> Timeline -> Html Msg +userTimelineView currentUser timeline = + Lazy.lazy timelineView + ( "Home timeline" + , "home" + , currentUser + , timeline + ) + + +localTimelineView : CurrentUser -> Timeline -> Html Msg +localTimelineView currentUser timeline = + Lazy.lazy timelineView + ( "Local timeline" + , "th-large" + , currentUser + , timeline + ) + + +globalTimelineView : CurrentUser -> Timeline -> Html Msg +globalTimelineView currentUser timeline = + Lazy.lazy timelineView + ( "Global timeline" + , "globe" + , currentUser + , timeline + ) + + sidebarView : Model -> Html Msg sidebarView model = div [ class "col-md-3 column" ] @@ -61,13 +94,7 @@ homepageView model = Just currentUser -> div [ class "row" ] [ Lazy.lazy sidebarView model - , Lazy.lazy timelineView - ( "Home timeline" - , "home" - , "home" - , currentUser - , model.userTimeline - ) + , userTimelineView currentUser model.userTimeline , Lazy.lazy3 notificationListView currentUser @@ -75,22 +102,10 @@ homepageView model = model.notifications , case model.currentView of LocalTimelineView -> - Lazy.lazy timelineView - ( "Local timeline" - , "th-large" - , "local" - , currentUser - , model.localTimeline - ) + localTimelineView currentUser model.localTimeline GlobalTimelineView -> - Lazy.lazy timelineView - ( "Global timeline" - , "globe" - , "global" - , currentUser - , model.globalTimeline - ) + globalTimelineView currentUser model.globalTimeline AccountView account -> accountTimelineView diff --git a/src/View/Common.elm b/src/View/Common.elm index 15bc103..3a07d59 100644 --- a/src/View/Common.elm +++ b/src/View/Common.elm @@ -5,6 +5,7 @@ module View.Common , closeablePanelheading , icon , justifiedButtonGroup + , loadMoreBtn ) import Html exposing (..) @@ -78,3 +79,19 @@ justifiedButtonGroup : String -> List (Html Msg) -> Html Msg justifiedButtonGroup cls buttons = div [ class <| "btn-group btn-group-justified " ++ cls ] <| List.map (\b -> div [ class "btn-group" ] [ b ]) buttons + + +loadMoreBtn : Timeline -> Html Msg +loadMoreBtn timeline = + case timeline.links.next of + Just next -> + li [ class "list-group-item load-more text-center" ] + [ a + [ href next + , onClickWithPreventAndStop <| LoadNext timeline + ] + [ text "Load more" ] + ] + + Nothing -> + text "" diff --git a/tests/Main.elm b/tests/Main.elm index 613fae9..6a023e0 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -1,13 +1,19 @@ port module Main exposing (..) import MastodonTest.HelperTest +import MastodonTest.HttpTest +import Test import Test.Runner.Node exposing (run, TestProgram) import Json.Encode exposing (Value) main : TestProgram main = - run emit MastodonTest.HelperTest.all + run emit <| + Test.concat + [ MastodonTest.HelperTest.all + , MastodonTest.HttpTest.all + ] port emit : ( String, Value ) -> Cmd msg diff --git a/tests/MastodonTest/HttpTest.elm b/tests/MastodonTest/HttpTest.elm new file mode 100644 index 0000000..879624c --- /dev/null +++ b/tests/MastodonTest/HttpTest.elm @@ -0,0 +1,62 @@ +module MastodonTest.HttpTest exposing (..) + +import Dict +import Test exposing (..) +import Expect +import Mastodon.Http exposing (..) + + +all : Test +all = + describe "Mastodon.Http" + [ describe "extractLinks" + [ test "should handle absence of link header" <| + \() -> + extractLinks (Dict.fromList []) + |> Expect.equal { prev = Nothing, next = Nothing } + , test "should parse a link header" <| + \() -> + let + headers = + Dict.fromList + [ ( "link", "; rel=\"next\", ; rel=\"prev\"" ) + ] + in + extractLinks headers + |> Expect.equal { prev = Just "prevLinkUrl", next = Just "nextLinkUrl" } + , test "should handle link header name case appropriately" <| + \() -> + let + headers = + Dict.fromList + [ ( "Link", "; rel=\"next\", ; rel=\"prev\"" ) + ] + in + extractLinks headers + |> Expect.equal { prev = Just "prevLinkUrl", next = Just "nextLinkUrl" } + , test "should extract a single prev link" <| + \() -> + let + headers = + Dict.fromList [ ( "link", "; rel=\"prev\"" ) ] + in + extractLinks headers + |> Expect.equal { prev = Just "prevLinkUrl", next = Nothing } + , test "should extract a single next link" <| + \() -> + let + headers = + Dict.fromList [ ( "link", "; rel=\"next\"" ) ] + in + extractLinks headers + |> Expect.equal { prev = Nothing, next = Just "nextLinkUrl" } + , test "should only extract prev and next links" <| + \() -> + let + headers = + Dict.fromList [ ( "link", "; rel=\"next\", ; rel=\"blop\"" ) ] + in + extractLinks headers + |> Expect.equal { prev = Nothing, next = Just "nextLinkUrl" } + ] + ] diff --git a/tests/elm-package.json b/tests/elm-package.json index 7465143..f59b3a0 100644 --- a/tests/elm-package.json +++ b/tests/elm-package.json @@ -17,6 +17,7 @@ "rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0", "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", + "elm-community/dict-extra": "1.5.0 <= v < 2.0.0", "elm-community/list-extra": "6.0.0 <= v < 7.0.0", "elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0",