Fix #64: Handle paginations. (#131)

* Extract link header values.
* Expose response link header to a new type.
* Add tests for Mastodon.http.extractLinks.
* WiP
* Wrap decoded content and links into a new Response type.
* Update MastodonMsg handlers so they handle responses.
* Remove debug statements.
* Add edge case to tests.
* Add missing TODO comment.
* Simplifies Mastodon.Http signatures
* Paginate the user timeline.
* I lost my mind. May revert.
* Updated Http API to be more explicit.
* Fuck namespaces.
* Cosmetics.
* I'm burnt out, lost 10 pounds, but it works.
* Fix qs param for local tl was appended to link url.
* Fix my own mediocrity.
* Fix oauth endpoints.
* Fix Link header case handling with Firefox.
* Add test case for link header name case handling.
This commit is contained in:
Nicolas Perriault 2017-05-05 17:26:49 +02:00 committed by GitHub
parent f542bcfc3b
commit 2b74533960
11 changed files with 613 additions and 383 deletions

View File

@ -9,6 +9,7 @@
"exposed-modules": [], "exposed-modules": [],
"dependencies": { "dependencies": {
"NoRedInk/elm-decode-pipeline": "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/list-extra": "6.0.0 <= v < 7.0.0",
"elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-community/string-extra": "1.3.3 <= v < 2.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0",

View File

@ -8,9 +8,13 @@ module Command
, loadNotifications , loadNotifications
, loadUserAccount , loadUserAccount
, loadAccount , loadAccount
, loadAccountTimeline
, loadAccountFollowers , loadAccountFollowers
, loadAccountFollowing , loadAccountFollowing
, loadUserTimeline
, loadLocalTimeline
, loadGlobalTimeline
, loadAccountTimeline
, loadNextTimeline
, loadRelationships , loadRelationships
, loadThread , loadThread
, loadTimelines , loadTimelines
@ -33,9 +37,13 @@ module Command
import Dom import Dom
import Dom.Scroll import Dom.Scroll
import Json.Encode as Encode 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.Model exposing (..)
import Mastodon.Encoder
import Mastodon.Http
import Navigation import Navigation
import Ports import Ports
import Task import Task
@ -49,9 +57,7 @@ initCommands registration client authCode =
Just authCode -> Just authCode ->
case registration of case registration of
Just registration -> Just registration ->
[ Mastodon.Http.getAccessToken registration authCode [ getAccessToken registration authCode ]
|> Mastodon.Http.send (MastodonEvent << AccessToken)
]
Nothing -> Nothing ->
[] []
@ -60,15 +66,23 @@ initCommands registration client authCode =
[ loadUserAccount client, loadTimelines client ] [ 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 : AppRegistration -> Cmd Msg
navigateToAuthUrl registration = navigateToAuthUrl registration =
Navigation.load <| Mastodon.Http.getAuthorizationUrl registration Navigation.load <| getAuthorizationUrl registration
registerApp : Model -> Cmd Msg registerApp : Model -> Cmd Msg
registerApp { server, location } = registerApp { server, location } =
let let
appUrl = redirectUri =
location.origin ++ location.pathname location.origin ++ location.pathname
cleanServer = cleanServer =
@ -76,36 +90,46 @@ registerApp { server, location } =
String.dropRight 1 server String.dropRight 1 server
else else
server server
in
Mastodon.Http.register clientName =
cleanServer
"tooty" "tooty"
appUrl
scope =
"read write follow" "read write follow"
website =
"https://github.com/n1k0/tooty" "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 -> Cmd Msg
saveClient client = saveClient client =
Mastodon.Encoder.clientEncoder client clientEncoder client
|> Encode.encode 0 |> Encode.encode 0
|> Ports.saveClient |> Ports.saveClient
saveRegistration : AppRegistration -> Cmd Msg saveRegistration : AppRegistration -> Cmd Msg
saveRegistration registration = saveRegistration registration =
Mastodon.Encoder.registrationEncoder registration registrationEncoder registration
|> Encode.encode 0 |> Encode.encode 0
|> Ports.saveRegistration |> Ports.saveRegistration
loadNotifications : Maybe Client -> Cmd Msg loadNotifications : Maybe Client -> Cmd Msg
loadNotifications client = loadNotifications client =
-- TODO: handle link (see loadUserTimeline)
case client of case client of
Just client -> Just client ->
Mastodon.Http.fetchNotifications client HttpBuilder.get ApiUrl.notifications
|> Mastodon.Http.send (MastodonEvent << Notifications) |> withClient client
|> withBodyDecoder (Decode.list notificationDecoder)
|> send (MastodonEvent << Notifications)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -115,8 +139,10 @@ loadUserAccount : Maybe Client -> Cmd Msg
loadUserAccount client = loadUserAccount client =
case client of case client of
Just client -> Just client ->
Mastodon.Http.userAccount client HttpBuilder.get ApiUrl.userAccount
|> Mastodon.Http.send (MastodonEvent << CurrentUser) |> withClient client
|> withBodyDecoder accountDecoder
|> send (MastodonEvent << CurrentUser)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -127,33 +153,26 @@ loadAccount client accountId =
case client of case client of
Just client -> Just client ->
Cmd.batch Cmd.batch
[ Mastodon.Http.fetchAccount client accountId [ HttpBuilder.get (ApiUrl.account accountId)
|> Mastodon.Http.send (MastodonEvent << AccountReceived) |> withClient client
, Mastodon.Http.fetchRelationships client [ accountId ] |> withBodyDecoder accountDecoder
|> Mastodon.Http.send (MastodonEvent << AccountRelationship) |> send (MastodonEvent << AccountReceived)
, requestRelationships client [ accountId ]
|> send (MastodonEvent << AccountRelationship)
] ]
Nothing -> Nothing ->
Cmd.none 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 : Maybe Client -> Int -> Cmd Msg
loadAccountFollowers client accountId = loadAccountFollowers client accountId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.fetchAccountFollowers client accountId HttpBuilder.get (ApiUrl.followers accountId)
|> Mastodon.Http.send (MastodonEvent << AccountFollowers) |> withClient client
|> withBodyDecoder (Decode.list accountDecoder)
|> send (MastodonEvent << AccountFollowers)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -163,8 +182,10 @@ loadAccountFollowing : Maybe Client -> Int -> Cmd Msg
loadAccountFollowing client accountId = loadAccountFollowing client accountId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.fetchAccountFollowing client accountId HttpBuilder.get (ApiUrl.following accountId)
|> Mastodon.Http.send (MastodonEvent << AccountFollowing) |> withClient client
|> withBodyDecoder (Decode.list accountDecoder)
|> send (MastodonEvent << AccountFollowing)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -177,19 +198,43 @@ searchAccounts client query limit resolve =
else else
case client of case client of
Just client -> Just client ->
Mastodon.Http.searchAccounts client query limit resolve let
|> Mastodon.Http.send (MastodonEvent << AutoSearch) 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 -> Nothing ->
Cmd.none 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 : Maybe Client -> List Int -> Cmd Msg
loadRelationships client accountIds = loadRelationships client ids =
case client of case client of
Just client -> Just client ->
Mastodon.Http.fetchRelationships client accountIds requestRelationships client ids
|> Mastodon.Http.send (MastodonEvent << AccountRelationships) |> send (MastodonEvent << AccountRelationships)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -199,8 +244,63 @@ loadThread : Maybe Client -> Status -> Cmd Msg
loadThread client status = loadThread client status =
case client of case client of
Just client -> Just client ->
Mastodon.Http.context client status.id HttpBuilder.get (ApiUrl.context status.id)
|> Mastodon.Http.send (MastodonEvent << (ContextLoaded status)) |> 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 -> Nothing ->
Cmd.none Cmd.none
@ -208,19 +308,35 @@ loadThread client status =
loadTimelines : Maybe Client -> Cmd Msg loadTimelines : Maybe Client -> Cmd Msg
loadTimelines client = loadTimelines client =
case client of Cmd.batch
Just client -> [ loadUserTimeline client Nothing
Cmd.batch , loadLocalTimeline client Nothing
[ Mastodon.Http.fetchUserTimeline client , loadGlobalTimeline client Nothing
|> Mastodon.Http.send (MastodonEvent << UserTimeline) , loadNotifications client
, Mastodon.Http.fetchLocalTimeline client ]
|> Mastodon.Http.send (MastodonEvent << LocalTimeline)
, Mastodon.Http.fetchGlobalTimeline client
|> Mastodon.Http.send (MastodonEvent << GlobalTimeline)
, loadNotifications <| Just 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 Cmd.none
@ -228,8 +344,11 @@ postStatus : Maybe Client -> StatusRequestBody -> Cmd Msg
postStatus client draft = postStatus client draft =
case client of case client of
Just client -> Just client ->
Mastodon.Http.postStatus client draft HttpBuilder.post ApiUrl.statuses
|> Mastodon.Http.send (MastodonEvent << StatusPosted) |> withClient client
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder draft)
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << StatusPosted)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -244,8 +363,10 @@ deleteStatus : Maybe Client -> Int -> Cmd Msg
deleteStatus client id = deleteStatus client id =
case client of case client of
Just client -> Just client ->
Mastodon.Http.deleteStatus client id HttpBuilder.delete (ApiUrl.status id)
|> Mastodon.Http.send (MastodonEvent << StatusDeleted) |> withClient client
|> withBodyDecoder (Decode.succeed id)
|> send (MastodonEvent << StatusDeleted)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -255,8 +376,10 @@ reblogStatus : Maybe Client -> Int -> Cmd Msg
reblogStatus client statusId = reblogStatus client statusId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.reblog client statusId HttpBuilder.post (ApiUrl.reblog statusId)
|> Mastodon.Http.send (MastodonEvent << Reblogged) |> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << Reblogged)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -266,8 +389,10 @@ unreblogStatus : Maybe Client -> Int -> Cmd Msg
unreblogStatus client statusId = unreblogStatus client statusId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.unreblog client statusId HttpBuilder.post (ApiUrl.unreblog statusId)
|> Mastodon.Http.send (MastodonEvent << Unreblogged) |> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << Unreblogged)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -277,8 +402,10 @@ favouriteStatus : Maybe Client -> Int -> Cmd Msg
favouriteStatus client statusId = favouriteStatus client statusId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.favourite client statusId HttpBuilder.post (ApiUrl.favourite statusId)
|> Mastodon.Http.send (MastodonEvent << FavoriteAdded) |> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << FavoriteAdded)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -288,8 +415,10 @@ unfavouriteStatus : Maybe Client -> Int -> Cmd Msg
unfavouriteStatus client statusId = unfavouriteStatus client statusId =
case client of case client of
Just client -> Just client ->
Mastodon.Http.unfavourite client statusId HttpBuilder.post (ApiUrl.unfavourite statusId)
|> Mastodon.Http.send (MastodonEvent << FavoriteRemoved) |> withClient client
|> withBodyDecoder statusDecoder
|> send (MastodonEvent << FavoriteRemoved)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -299,8 +428,10 @@ follow : Maybe Client -> Int -> Cmd Msg
follow client id = follow client id =
case client of case client of
Just client -> Just client ->
Mastodon.Http.follow client id HttpBuilder.post (ApiUrl.follow id)
|> Mastodon.Http.send (MastodonEvent << AccountFollowed) |> withClient client
|> withBodyDecoder relationshipDecoder
|> send (MastodonEvent << AccountFollowed)
Nothing -> Nothing ->
Cmd.none Cmd.none
@ -310,8 +441,10 @@ unfollow : Maybe Client -> Int -> Cmd Msg
unfollow client id = unfollow client id =
case client of case client of
Just client -> Just client ->
Mastodon.Http.unfollow client id HttpBuilder.post (ApiUrl.unfollow id)
|> Mastodon.Http.send (MastodonEvent << AccountUnfollowed) |> withClient client
|> withBodyDecoder relationshipDecoder
|> send (MastodonEvent << AccountUnfollowed)
Nothing -> Nothing ->
Cmd.none Cmd.none

View File

@ -1,32 +1,19 @@
module Mastodon.Http module Mastodon.Http
exposing exposing
( Request ( Links
, context , Action(..)
, reblog , Request
, unreblog , Response
, favourite , extractLinks
, unfavourite
, follow
, unfollow
, register
, getAuthorizationUrl , getAuthorizationUrl
, getAccessToken
, fetchAccount
, fetchAccountTimeline
, fetchAccountFollowers
, fetchAccountFollowing
, fetchLocalTimeline
, fetchNotifications
, fetchGlobalTimeline
, fetchUserTimeline
, fetchRelationships
, postStatus
, deleteStatus
, userAccount
, send , send
, searchAccounts , withClient
, withBodyDecoder
, withQueryParams
) )
import Dict
import Dict.Extra exposing (mapKeys)
import Http import Http
import HttpBuilder as Build import HttpBuilder as Build
import Json.Decode as Decode import Json.Decode as Decode
@ -36,14 +23,32 @@ import Mastodon.Encoder exposing (..)
import Mastodon.Model exposing (..) import Mastodon.Model exposing (..)
type Method type Action
= GET = GET String
| POST | POST String
| DELETE | DELETE String
type Link
= Prev
| Next
| None
type alias Links =
{ prev : Maybe String
, next : Maybe String
}
type alias Request a = type alias Request a =
Build.RequestBuilder a Build.RequestBuilder (Response a)
type alias Response a =
{ decoded : a
, links : Links
}
extractMastodonError : Int -> String -> String -> Error extractMastodonError : Int -> String -> String -> Error
@ -80,40 +85,70 @@ toResponse result =
Result.mapError extractError result Result.mapError extractError result
request : String -> Method -> String -> Decode.Decoder a -> Request a extractLinks : Dict.Dict String String -> Links
request server method endpoint decoder = extractLinks headers =
-- The link header content is this form:
-- <https://...&max_id=123456>; rel="next", <https://...&since_id=123456>; 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 let
httpMethod = crop =
case method of (String.dropLeft 1) >> (String.dropRight 1)
GET ->
Build.get
POST -> parseDef parts =
Build.post case parts of
[ url, "rel=\"next\"" ] ->
[ ( "next", crop url ) ]
DELETE -> [ url, "rel=\"prev\"" ] ->
Build.delete [ ( "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 in
httpMethod (server ++ endpoint) case (headers |> mapKeys String.toLower |> Dict.get "link") of
|> Build.withExpect (Http.expectJson decoder) 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 decodeResponse : Decode.Decoder a -> Http.Response String -> Result.Result String (Response a)
authRequest client method endpoint decoder = decodeResponse decoder response =
request client.server method endpoint decoder let
|> Build.withHeader "Authorization" ("Bearer " ++ client.token) 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 Err error ->
register server clientName redirectUri scope website = Err error
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)
getAuthorizationUrl : AppRegistration -> String getAuthorizationUrl : AppRegistration -> String
@ -126,119 +161,38 @@ getAuthorizationUrl registration =
] ]
send : (Result Error a -> msg) -> Request a -> Cmd msg send : (Result Error a -> msg) -> Build.RequestBuilder a -> Cmd msg
send tagger builder = send tagger request =
Build.send (toResponse >> tagger) builder Build.send (toResponse >> tagger) request
fetchAccount : Client -> Int -> Request Account isLinkUrl : String -> Bool
fetchAccount client accountId = isLinkUrl url =
authRequest client GET (ApiUrl.account accountId) accountDecoder String.contains "max_id=" url || String.contains "since_id=" url
fetchUserTimeline : Client -> Request (List Status) withClient : Client -> Build.RequestBuilder a -> Build.RequestBuilder a
fetchUserTimeline client = withClient { server, token } builder =
authRequest client GET ApiUrl.homeTimeline <| Decode.list statusDecoder 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) withBodyDecoder : Decode.Decoder b -> Build.RequestBuilder a -> Request b
fetchRelationships client ids = withBodyDecoder decoder builder =
authRequest client GET ApiUrl.relationships (Decode.list relationshipDecoder) Build.withExpect (Http.expectStringResponse (decodeResponse decoder)) builder
|> Build.withQueryParams (List.map (\id -> ( "id[]", toString id )) ids)
fetchLocalTimeline : Client -> Request (List Status) withQueryParams : List ( String, String ) -> Build.RequestBuilder a -> Build.RequestBuilder a
fetchLocalTimeline client = withQueryParams params builder =
authRequest client GET ApiUrl.publicTimeline (Decode.list statusDecoder) if isLinkUrl builder.url then
|> Build.withQueryParams [ ( "local", "true" ) ] -- that's a link url, don't append any query string
builder
else
fetchGlobalTimeline : Client -> Request (List Status) Build.withQueryParams params builder
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

View File

@ -5,6 +5,7 @@ import Command
import Navigation import Navigation
import Mastodon.Decoder import Mastodon.Decoder
import Mastodon.Helper import Mastodon.Helper
import Mastodon.Http exposing (Links)
import Mastodon.Model exposing (..) import Mastodon.Model exposing (..)
import Mastodon.WebSocket import Mastodon.WebSocket
import String.Extra import String.Extra
@ -55,10 +56,10 @@ init flags location =
{ server = "" { server = ""
, registration = flags.registration , registration = flags.registration
, client = flags.client , client = flags.client
, userTimeline = [] , userTimeline = emptyTimeline "home-timeline"
, localTimeline = [] , localTimeline = emptyTimeline "local-timeline"
, globalTimeline = [] , globalTimeline = emptyTimeline "global-timeline"
, accountTimeline = [] , accountTimeline = emptyTimeline "account-timeline"
, accountFollowers = [] , accountFollowers = []
, accountFollowing = [] , accountFollowing = []
, accountRelationships = [] , accountRelationships = []
@ -76,6 +77,14 @@ init flags location =
! [ Command.initCommands flags.registration flags.client authCode ] ! [ Command.initCommands flags.registration flags.client authCode ]
emptyTimeline : String -> Timeline
emptyTimeline id =
{ id = id
, statuses = []
, links = Links Nothing Nothing
}
preferredTimeline : Model -> CurrentView preferredTimeline : Model -> CurrentView
preferredTimeline model = preferredTimeline model =
if model.useGlobalTimeline then if model.useGlobalTimeline then
@ -84,11 +93,6 @@ preferredTimeline model =
LocalTimelineView LocalTimelineView
truncate : List a -> List a
truncate entries =
List.take maxBuffer entries
errorText : Error -> String errorText : Error -> String
errorText error = errorText error =
case error of case error of
@ -129,12 +133,15 @@ updateTimelinesWithBoolFlag statusId flag statusUpdater model =
statusUpdater status statusUpdater status
else else
status status
updateTimeline timeline =
{ timeline | statuses = List.map update timeline.statuses }
in in
{ model { model
| userTimeline = List.map update model.userTimeline | userTimeline = updateTimeline model.userTimeline
, accountTimeline = List.map update model.accountTimeline , accountTimeline = updateTimeline model.accountTimeline
, localTimeline = List.map update model.localTimeline , localTimeline = updateTimeline model.localTimeline
, globalTimeline = List.map update model.globalTimeline , globalTimeline = updateTimeline model.globalTimeline
, currentView = , currentView =
case model.currentView of case model.currentView of
ThreadView thread -> ThreadView thread ->
@ -191,16 +198,16 @@ processReblog statusId flag model =
model model
deleteStatusFromTimeline : Int -> List Status -> List Status deleteStatusFromTimeline : Int -> Timeline -> Timeline
deleteStatusFromTimeline statusId timeline = deleteStatusFromTimeline statusId timeline =
timeline let
|> List.filter update status =
(\s -> status.id
s.id /= statusId
/= statusId && (Mastodon.Helper.extractReblog status).id
&& (Mastodon.Helper.extractReblog s).id /= statusId
/= statusId in
) { timeline | statuses = List.filter update timeline.statuses }
deleteStatusFromAllTimelines : Int -> Model -> Model deleteStatusFromAllTimelines : Int -> Model -> Model
@ -473,15 +480,32 @@ updateViewer viewerMsg viewer =
(Just <| Viewer attachments attachment) ! [] (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 : MastodonMsg -> Model -> ( Model, Cmd Msg )
processMastodonEvent msg model = processMastodonEvent msg model =
case msg of case msg of
AccessToken result -> AccessToken result ->
case result of case result of
Ok { server, accessToken } -> Ok { decoded } ->
let let
client = client =
Client server accessToken Client decoded.server decoded.accessToken
in in
{ model | client = Just client } { model | client = Just client }
! [ Command.loadTimelines <| Just client ! [ Command.loadTimelines <| Just client
@ -495,26 +519,26 @@ processMastodonEvent msg model =
AccountFollowed result -> AccountFollowed result ->
case result of case result of
Ok relationship -> Ok { decoded } ->
processFollowEvent relationship True model ! [] processFollowEvent decoded True model ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AccountUnfollowed result -> AccountUnfollowed result ->
case result of case result of
Ok relationship -> Ok { decoded } ->
processFollowEvent relationship False model ! [] processFollowEvent decoded False model ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AppRegistered result -> AppRegistered result ->
case result of case result of
Ok registration -> Ok { decoded } ->
{ model | registration = Just registration } { model | registration = Just decoded }
! [ Command.saveRegistration registration ! [ Command.saveRegistration decoded
, Command.navigateToAuthUrl registration , Command.navigateToAuthUrl decoded
] ]
Err error -> Err error ->
@ -522,8 +546,8 @@ processMastodonEvent msg model =
ContextLoaded status result -> ContextLoaded status result ->
case result of case result of
Ok context -> Ok { decoded } ->
{ model | currentView = ThreadView (Thread status context) } { model | currentView = ThreadView (Thread status decoded) }
! [ Command.scrollToThreadStatus <| toString status.id ] ! [ Command.scrollToThreadStatus <| toString status.id ]
Err error -> Err error ->
@ -535,15 +559,15 @@ processMastodonEvent msg model =
CurrentUser result -> CurrentUser result ->
case result of case result of
Ok currentUser -> Ok { decoded } ->
{ model | currentUser = Just currentUser } ! [] { model | currentUser = Just decoded } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
FavoriteAdded result -> FavoriteAdded result ->
case result of case result of
Ok status -> Ok _ ->
model ! [ Command.loadNotifications model.client ] model ! [ Command.loadNotifications model.client ]
Err error -> Err error ->
@ -551,39 +575,40 @@ processMastodonEvent msg model =
FavoriteRemoved result -> FavoriteRemoved result ->
case result of case result of
Ok status -> Ok _ ->
model ! [ Command.loadNotifications model.client ] model ! [ Command.loadNotifications model.client ]
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
LocalTimeline result -> LocalTimeline append result ->
case result of case result of
Ok localTimeline -> Ok { decoded, links } ->
{ model | localTimeline = localTimeline } ! [] { model | localTimeline = updateTimeline append decoded links model.localTimeline } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
Notifications result -> Notifications result ->
case result of case result of
Ok notifications -> Ok { decoded } ->
{ model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! [] -- TODO: store next link
{ model | notifications = Mastodon.Helper.aggregateNotifications decoded } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
GlobalTimeline result -> GlobalTimeline append result ->
case result of case result of
Ok globalTimeline -> Ok { decoded, links } ->
{ model | globalTimeline = globalTimeline } ! [] { model | globalTimeline = updateTimeline append decoded links model.globalTimeline } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
Reblogged result -> Reblogged result ->
case result of case result of
Ok status -> Ok _ ->
model ! [ Command.loadNotifications model.client ] model ! [ Command.loadNotifications model.client ]
Err error -> Err error ->
@ -591,21 +616,21 @@ processMastodonEvent msg model =
StatusPosted _ -> StatusPosted _ ->
{ model | draft = defaultDraft } { model | draft = defaultDraft }
! [ Command.scrollColumnToTop "home" ! [ Command.scrollColumnToTop "home-timeline"
, Command.updateDomStatus defaultDraft.status , Command.updateDomStatus defaultDraft.status
] ]
StatusDeleted result -> StatusDeleted result ->
case result of case result of
Ok id -> Ok { decoded } ->
deleteStatusFromAllTimelines id model ! [] deleteStatusFromAllTimelines decoded model ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
Unreblogged result -> Unreblogged result ->
case result of case result of
Ok status -> Ok _ ->
model ! [ Command.loadNotifications model.client ] model ! [ Command.loadNotifications model.client ]
Err error -> Err error ->
@ -613,9 +638,9 @@ processMastodonEvent msg model =
AccountReceived result -> AccountReceived result ->
case result of case result of
Ok account -> Ok { decoded } ->
{ model | currentView = AccountView account } { model | currentView = AccountView decoded }
! [ Command.loadAccountTimeline model.client account.id ] ! [ Command.loadAccountTimeline model.client decoded.id model.userTimeline.links.next ]
Err error -> Err error ->
{ model { model
@ -624,55 +649,60 @@ processMastodonEvent msg model =
} }
! [] ! []
AccountTimeline result -> AccountTimeline append result ->
case result of case result of
Ok statuses -> Ok { decoded, links } ->
{ model | accountTimeline = statuses } ! [] { model | accountTimeline = updateTimeline append decoded links model.accountTimeline } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AccountFollowers result -> AccountFollowers result ->
case result of case result of
Ok followers -> Ok { decoded } ->
{ model | accountFollowers = followers } -- TODO: store next link
! [ Command.loadRelationships model.client <| List.map .id followers ] { model | accountFollowers = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AccountFollowing result -> AccountFollowing result ->
case result of case result of
Ok following -> Ok { decoded } ->
{ model | accountFollowing = following } -- TODO: store next link
! [ Command.loadRelationships model.client <| List.map .id following ] { model | accountFollowing = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AccountRelationship result -> AccountRelationship result ->
case result of case result of
Ok [ relationship ] -> Ok { decoded } ->
{ model | accountRelationship = Just relationship } ! [] case decoded of
[ relationship ] ->
{ model | accountRelationship = Just relationship } ! []
Ok _ -> _ ->
model ! [] model ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
AccountRelationships result -> AccountRelationships result ->
case result of case result of
Ok relationships -> Ok { decoded } ->
{ model | accountRelationships = relationships } ! [] -- TODO: store next link
{ model | accountRelationships = decoded } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
UserTimeline result -> UserTimeline append result ->
case result of case result of
Ok userTimeline -> Ok { decoded, links } ->
{ model | userTimeline = userTimeline } ! [] { model | userTimeline = updateTimeline append decoded links model.userTimeline } ! []
Err error -> Err error ->
{ model | errors = (errorText error) :: model.errors } ! [] { model | errors = (errorText error) :: model.errors } ! []
@ -683,16 +713,16 @@ processMastodonEvent msg model =
model.draft model.draft
in in
case result of case result of
Ok accounts -> Ok { decoded } ->
{ model { model
| draft = | draft =
{ draft { draft
| showAutoMenu = | showAutoMenu =
showAutoMenu showAutoMenu
accounts decoded
draft.autoAtPosition draft.autoAtPosition
draft.autoQuery draft.autoQuery
, autoAccounts = accounts , autoAccounts = decoded
} }
} }
-- Force selection of the first item after each -- Force selection of the first item after each
@ -734,7 +764,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | userTimeline = truncate (status :: model.userTimeline) } ! [] { model | userTimeline = prependStatusToTimeline status model.userTimeline } ! []
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
@ -756,7 +786,7 @@ processWebSocketMsg msg model =
notification notification
model.notifications model.notifications
in in
{ model | notifications = truncate notifications } ! [] { model | notifications = notifications } ! []
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
@ -769,7 +799,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | localTimeline = truncate (status :: model.localTimeline) } ! [] { model | localTimeline = prependStatusToTimeline status model.localTimeline } ! []
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
@ -793,7 +823,7 @@ processWebSocketMsg msg model =
Mastodon.WebSocket.StatusUpdateEvent result -> Mastodon.WebSocket.StatusUpdateEvent result ->
case result of case result of
Ok status -> Ok status ->
{ model | globalTimeline = truncate (status :: model.globalTimeline) } ! [] { model | globalTimeline = prependStatusToTimeline status model.globalTimeline } ! []
Err error -> Err error ->
{ model | errors = error :: model.errors } ! [] { model | errors = error :: model.errors } ! []
@ -886,7 +916,7 @@ update msg model =
LoadAccount accountId -> LoadAccount accountId ->
{ model { model
| accountTimeline = [] | accountTimeline = emptyTimeline "account-timeline"
, accountFollowers = [] , accountFollowers = []
, accountFollowing = [] , accountFollowing = []
, accountRelationships = [] , accountRelationships = []
@ -894,6 +924,9 @@ update msg model =
} }
! [ Command.loadAccount model.client accountId ] ! [ Command.loadAccount model.client accountId ]
LoadNext timeline ->
model ! [ Command.loadNextTimeline model.client model.currentView timeline ]
ViewAccountFollowers account -> ViewAccountFollowers account ->
{ model | currentView = AccountFollowersView account model.accountFollowers } { model | currentView = AccountFollowersView account model.accountFollowers }
! [ Command.loadAccountFollowers model.client account.id ] ! [ Command.loadAccountFollowers model.client account.id ]
@ -915,7 +948,7 @@ update msg model =
CloseAccount -> CloseAccount ->
{ model { model
| currentView = preferredTimeline model | currentView = preferredTimeline model
, accountTimeline = [] , accountTimeline = emptyTimeline "account-timeline"
, accountFollowing = [] , accountFollowing = []
, accountFollowers = [] , accountFollowers = []
} }

View File

@ -1,6 +1,7 @@
module Types exposing (..) module Types exposing (..)
import Autocomplete import Autocomplete
import Mastodon.Http exposing (Response, Links)
import Mastodon.Model exposing (..) import Mastodon.Model exposing (..)
import Navigation import Navigation
@ -29,30 +30,34 @@ type ViewerMsg
| OpenViewer (List Attachment) Attachment | OpenViewer (List Attachment) Attachment
type alias MastodonResult a =
Result Error (Response a)
type MastodonMsg type MastodonMsg
= AccessToken (Result Error AccessTokenResult) = AccessToken (MastodonResult AccessTokenResult)
| AccountFollowed (Result Error Relationship) | AccountFollowed (MastodonResult Relationship)
| AccountFollowers (Result Error (List Account)) | AccountFollowers (MastodonResult (List Account))
| AccountFollowing (Result Error (List Account)) | AccountFollowing (MastodonResult (List Account))
| AccountReceived (Result Error Account) | AccountReceived (MastodonResult Account)
| AccountRelationship (Result Error (List Relationship)) | AccountRelationship (MastodonResult (List Relationship))
| AccountRelationships (Result Error (List Relationship)) | AccountRelationships (MastodonResult (List Relationship))
| AccountTimeline (Result Error (List Status)) | AccountTimeline Bool (MastodonResult (List Status))
| AccountUnfollowed (Result Error Relationship) | AccountUnfollowed (MastodonResult Relationship)
| AppRegistered (Result Error AppRegistration) | AppRegistered (MastodonResult AppRegistration)
| ContextLoaded Status (Result Error Context) | AutoSearch (MastodonResult (List Account))
| CurrentUser (Result Error Account) | ContextLoaded Status (MastodonResult Context)
| FavoriteAdded (Result Error Status) | CurrentUser (MastodonResult Account)
| FavoriteRemoved (Result Error Status) | FavoriteAdded (MastodonResult Status)
| GlobalTimeline (Result Error (List Status)) | FavoriteRemoved (MastodonResult Status)
| LocalTimeline (Result Error (List Status)) | GlobalTimeline Bool (MastodonResult (List Status))
| Notifications (Result Error (List Notification)) | LocalTimeline Bool (MastodonResult (List Status))
| Reblogged (Result Error Status) | Notifications (MastodonResult (List Notification))
| StatusDeleted (Result Error Int) | Reblogged (MastodonResult Status)
| StatusPosted (Result Error Status) | StatusDeleted (MastodonResult Int)
| Unreblogged (Result Error Status) | StatusPosted (MastodonResult Status)
| UserTimeline (Result Error (List Status)) | Unreblogged (MastodonResult Status)
| AutoSearch (Result Error (List Account)) | UserTimeline Bool (MastodonResult (List Status))
type WebSocketMsg type WebSocketMsg
@ -70,6 +75,7 @@ type Msg
| FilterNotifications NotificationFilter | FilterNotifications NotificationFilter
| FollowAccount Int | FollowAccount Int
| LoadAccount Int | LoadAccount Int
| LoadNext Timeline
| MastodonEvent MastodonMsg | MastodonEvent MastodonMsg
| NoOp | NoOp
| OpenThread Status | OpenThread Status
@ -90,14 +96,6 @@ type Msg
| WebSocketEvent WebSocketMsg | WebSocketEvent WebSocketMsg
type alias AccountViewInfo =
{ account : Account
, timeline : List Status
, folowers : List Account
, following : List Account
}
type CurrentView type CurrentView
= -- Basically, what we should be displaying in the fourth column = -- Basically, what we should be displaying in the fourth column
AccountFollowersView Account (List Account) AccountFollowersView Account (List Account)
@ -152,14 +150,21 @@ type alias Viewer =
} }
type alias Timeline =
{ id : String
, statuses : List Status
, links : Links
}
type alias Model = type alias Model =
{ server : String { server : String
, registration : Maybe AppRegistration , registration : Maybe AppRegistration
, client : Maybe Client , client : Maybe Client
, userTimeline : List Status , userTimeline : Timeline
, localTimeline : List Status , localTimeline : Timeline
, globalTimeline : List Status , globalTimeline : Timeline
, accountTimeline : List Status , accountTimeline : Timeline
, accountFollowers : List Account , accountFollowers : List Account
, accountFollowing : List Account , accountFollowing : List Account
, accountRelationships : List Relationship , accountRelationships : List Relationship

View File

@ -122,18 +122,21 @@ accountFollowView currentUser accounts relationships relationship account =
List.map keyedEntry accounts List.map keyedEntry accounts
accountTimelineView : CurrentUser -> List Status -> CurrentUserRelation -> Account -> Html Msg accountTimelineView : CurrentUser -> Timeline -> CurrentUserRelation -> Account -> Html Msg
accountTimelineView currentUser statuses relationship account = accountTimelineView currentUser timeline relationship account =
let let
keyedEntry status = keyedEntry status =
( toString status.id ( toString status.id
, li [ class "list-group-item status" ] , li [ class "list-group-item status" ]
[ Lazy.lazy2 statusView "account" status ] [ Lazy.lazy2 statusView "account" status ]
) )
entries =
List.map keyedEntry timeline.statuses
in in
accountView currentUser account relationship <| accountView currentUser account relationship <|
Keyed.ul [ class "list-group" ] <| Keyed.ul [ id timeline.id, class "list-group" ] <|
List.map keyedEntry statuses (entries ++ [ ( "load-more", Common.loadMoreBtn timeline ) ])
accountView : CurrentUser -> Account -> CurrentUserRelation -> Html Msg -> Html Msg accountView : CurrentUser -> Account -> CurrentUserRelation -> Html Msg -> Html Msg

View File

@ -27,23 +27,56 @@ type alias CurrentUserRelation =
Maybe Relationship Maybe Relationship
timelineView : ( String, String, String, CurrentUser, List Status ) -> Html Msg timelineView : ( String, String, CurrentUser, Timeline ) -> Html Msg
timelineView ( label, iconName, context, currentUser, statuses ) = timelineView ( label, iconName, currentUser, timeline ) =
let let
keyedEntry status = keyedEntry status =
( toString id, statusEntryView context "" currentUser status ) ( toString id, statusEntryView timeline.id "" currentUser status )
entries =
List.map keyedEntry timeline.statuses
in in
div [ class "col-md-3 column" ] div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ] [ div [ class "panel panel-default" ]
[ a [ a
[ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop context ] [ href "", onClickWithPreventAndStop <| ScrollColumn ScrollTop timeline.id ]
[ div [ class "panel-heading" ] [ Common.icon iconName, text label ] ] [ div [ class "panel-heading" ] [ Common.icon iconName, text label ] ]
, Keyed.ul [ id context, class "list-group timeline" ] <| , Keyed.ul [ id timeline.id, class "list-group timeline" ] <|
List.map keyedEntry statuses (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 -> Html Msg
sidebarView model = sidebarView model =
div [ class "col-md-3 column" ] div [ class "col-md-3 column" ]
@ -61,13 +94,7 @@ homepageView model =
Just currentUser -> Just currentUser ->
div [ class "row" ] div [ class "row" ]
[ Lazy.lazy sidebarView model [ Lazy.lazy sidebarView model
, Lazy.lazy timelineView , userTimelineView currentUser model.userTimeline
( "Home timeline"
, "home"
, "home"
, currentUser
, model.userTimeline
)
, Lazy.lazy3 , Lazy.lazy3
notificationListView notificationListView
currentUser currentUser
@ -75,22 +102,10 @@ homepageView model =
model.notifications model.notifications
, case model.currentView of , case model.currentView of
LocalTimelineView -> LocalTimelineView ->
Lazy.lazy timelineView localTimelineView currentUser model.localTimeline
( "Local timeline"
, "th-large"
, "local"
, currentUser
, model.localTimeline
)
GlobalTimelineView -> GlobalTimelineView ->
Lazy.lazy timelineView globalTimelineView currentUser model.globalTimeline
( "Global timeline"
, "globe"
, "global"
, currentUser
, model.globalTimeline
)
AccountView account -> AccountView account ->
accountTimelineView accountTimelineView

View File

@ -5,6 +5,7 @@ module View.Common
, closeablePanelheading , closeablePanelheading
, icon , icon
, justifiedButtonGroup , justifiedButtonGroup
, loadMoreBtn
) )
import Html exposing (..) import Html exposing (..)
@ -78,3 +79,19 @@ justifiedButtonGroup : String -> List (Html Msg) -> Html Msg
justifiedButtonGroup cls buttons = justifiedButtonGroup cls buttons =
div [ class <| "btn-group btn-group-justified " ++ cls ] <| div [ class <| "btn-group btn-group-justified " ++ cls ] <|
List.map (\b -> div [ class "btn-group" ] [ b ]) buttons 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 ""

View File

@ -1,13 +1,19 @@
port module Main exposing (..) port module Main exposing (..)
import MastodonTest.HelperTest import MastodonTest.HelperTest
import MastodonTest.HttpTest
import Test
import Test.Runner.Node exposing (run, TestProgram) import Test.Runner.Node exposing (run, TestProgram)
import Json.Encode exposing (Value) import Json.Encode exposing (Value)
main : TestProgram main : TestProgram
main = main =
run emit MastodonTest.HelperTest.all run emit <|
Test.concat
[ MastodonTest.HelperTest.all
, MastodonTest.HttpTest.all
]
port emit : ( String, Value ) -> Cmd msg port emit : ( String, Value ) -> Cmd msg

View File

@ -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", "<nextLinkUrl>; rel=\"next\", <prevLinkUrl>; 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", "<nextLinkUrl>; rel=\"next\", <prevLinkUrl>; 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", "<prevLinkUrl>; rel=\"prev\"" ) ]
in
extractLinks headers
|> Expect.equal { prev = Just "prevLinkUrl", next = Nothing }
, test "should extract a single next link" <|
\() ->
let
headers =
Dict.fromList [ ( "link", "<nextLinkUrl>; 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", "<nextLinkUrl>; rel=\"next\", <blurp>; rel=\"blop\"" ) ]
in
extractLinks headers
|> Expect.equal { prev = Nothing, next = Just "nextLinkUrl" }
]
]

View File

@ -17,6 +17,7 @@
"rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0", "rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0",
"NoRedInk/elm-decode-pipeline": "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/list-extra": "6.0.0 <= v < 7.0.0",
"elm-community/string-extra": "1.3.3 <= v < 2.0.0", "elm-community/string-extra": "1.3.3 <= v < 2.0.0",
"elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0",