Fix #81: Account followers and followings (#104)

This commit is contained in:
Nicolas Perriault 2017-04-29 18:05:06 +02:00 committed by GitHub
parent 017f07d45d
commit 57f7f0cc7c
9 changed files with 621 additions and 443 deletions

View File

@ -92,12 +92,29 @@ body {
margin-top: 2px;
}
.username {
.status .username,
.current-user .username {
font-weight: bold;
margin-left: 65px;
margin-bottom: 4px;
}
.follow-entry {
min-height: 38px;
}
.follow-entry .avatar {
width: 38px;
height: 38px;
}
.follow-entry .username {
font-weight: normal;
font-size: 97%;
margin-left: 50px;
overflow: hidden;
text-overflow: ellipsis;
}
.acct {
font-size: 97%;
font-weight: normal;
@ -334,6 +351,17 @@ body {
padding: 15px;
}
.account-infos a {
color: #c8c8c8;
}
.account-infos a:hover,
.account-infos a:focus,
.account-infos a:active {
text-decoration: none;
color: #fff;
}
/* Viewer */
.viewer {

231
src/Command.elm Normal file
View File

@ -0,0 +1,231 @@
module Command
exposing
( initCommands
, navigateToAuthUrl
, registerApp
, saveClient
, saveRegistration
, loadNotifications
, loadUserAccount
, loadAccount
, loadAccountInfo
, loadThread
, loadTimelines
, postStatus
, deleteStatus
, reblogStatus
, unreblogStatus
, favouriteStatus
, unfavouriteStatus
)
import Json.Encode as Encode
import Mastodon.Model exposing (..)
import Mastodon.Encoder
import Mastodon.Http
import Navigation
import Ports
import Types exposing (..)
initCommands : Maybe AppRegistration -> Maybe Client -> Maybe String -> Cmd Msg
initCommands registration client authCode =
Cmd.batch <|
case authCode of
Just authCode ->
case registration of
Just registration ->
[ Mastodon.Http.getAccessToken registration authCode
|> Mastodon.Http.send (MastodonEvent << AccessToken)
]
Nothing ->
[]
Nothing ->
[ loadUserAccount client, loadTimelines client ]
navigateToAuthUrl : AppRegistration -> Cmd Msg
navigateToAuthUrl registration =
Navigation.load <| Mastodon.Http.getAuthorizationUrl registration
registerApp : Model -> Cmd Msg
registerApp { server, location } =
let
appUrl =
location.origin ++ location.pathname
cleanServer =
if String.endsWith "/" server then
String.dropRight 1 server
else
server
in
Mastodon.Http.register
cleanServer
"tooty"
appUrl
"read write follow"
"https://github.com/n1k0/tooty"
|> Mastodon.Http.send (MastodonEvent << AppRegistered)
saveClient : Client -> Cmd Msg
saveClient client =
Mastodon.Encoder.clientEncoder client
|> Encode.encode 0
|> Ports.saveClient
saveRegistration : AppRegistration -> Cmd Msg
saveRegistration registration =
Mastodon.Encoder.registrationEncoder registration
|> Encode.encode 0
|> Ports.saveRegistration
loadNotifications : Maybe Client -> Cmd Msg
loadNotifications client =
case client of
Just client ->
Mastodon.Http.fetchNotifications client
|> Mastodon.Http.send (MastodonEvent << Notifications)
Nothing ->
Cmd.none
loadUserAccount : Maybe Client -> Cmd Msg
loadUserAccount client =
case client of
Just client ->
Mastodon.Http.userAccount client
|> Mastodon.Http.send (MastodonEvent << CurrentUser)
Nothing ->
Cmd.none
loadAccount : Maybe Client -> Int -> Cmd Msg
loadAccount client accountId =
case client of
Just client ->
Mastodon.Http.fetchAccount client accountId
|> Mastodon.Http.send (MastodonEvent << AccountReceived)
Nothing ->
Cmd.none
loadAccountInfo : Maybe Client -> Int -> Cmd Msg
loadAccountInfo client accountId =
case client of
Just client ->
Cmd.batch
[ Mastodon.Http.fetchAccountTimeline client accountId
|> Mastodon.Http.send (MastodonEvent << AccountTimeline)
, Mastodon.Http.fetchAccountFollowers client accountId
|> Mastodon.Http.send (MastodonEvent << AccountFollowers)
, Mastodon.Http.fetchAccountFollowing client accountId
|> Mastodon.Http.send (MastodonEvent << AccountFollowing)
]
Nothing ->
Cmd.none
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))
Nothing ->
Cmd.none
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
]
Nothing ->
Cmd.none
postStatus : Maybe Client -> StatusRequestBody -> Cmd Msg
postStatus client draft =
case client of
Just client ->
Mastodon.Http.postStatus client draft
|> Mastodon.Http.send (MastodonEvent << StatusPosted)
Nothing ->
Cmd.none
deleteStatus : Maybe Client -> Int -> Cmd Msg
deleteStatus client id =
case client of
Just client ->
Mastodon.Http.deleteStatus client id
|> Mastodon.Http.send (MastodonEvent << StatusDeleted)
Nothing ->
Cmd.none
reblogStatus : Maybe Client -> Int -> Cmd Msg
reblogStatus client statusId =
case client of
Just client ->
Mastodon.Http.reblog client statusId
|> Mastodon.Http.send (MastodonEvent << Reblogged)
Nothing ->
Cmd.none
unreblogStatus : Maybe Client -> Int -> Cmd Msg
unreblogStatus client statusId =
case client of
Just client ->
Mastodon.Http.unreblog client statusId
|> Mastodon.Http.send (MastodonEvent << Unreblogged)
Nothing ->
Cmd.none
favouriteStatus : Maybe Client -> Int -> Cmd Msg
favouriteStatus client statusId =
case client of
Just client ->
Mastodon.Http.favourite client statusId
|> Mastodon.Http.send (MastodonEvent << FavoriteAdded)
Nothing ->
Cmd.none
unfavouriteStatus : Maybe Client -> Int -> Cmd Msg
unfavouriteStatus client statusId =
case client of
Just client ->
Mastodon.Http.unfavourite client statusId
|> Mastodon.Http.send (MastodonEvent << FavoriteRemoved)
Nothing ->
Cmd.none

View File

@ -2,7 +2,8 @@ module Main exposing (..)
import Navigation
import View exposing (view)
import Model exposing (Flags, Model, Msg(..), init, update, subscriptions)
import Model exposing (..)
import Types exposing (..)
main : Program Flags Model Msg

View File

@ -6,6 +6,8 @@ module Mastodon.ApiUrl
, userAccount
, account
, accountTimeline
, followers
, following
, status
, homeTimeline
, publicTimeline
@ -54,6 +56,16 @@ userAccount server =
server ++ accounts ++ "verify_credentials"
followers : Int -> String
followers id =
(account id) ++ "/followers"
following : Int -> String
following id =
(account id) ++ "/following"
homeTimeline : String
homeTimeline =
"/api/v1/timelines/home"

View File

@ -11,6 +11,8 @@ module Mastodon.Http
, getAccessToken
, fetchAccount
, fetchAccountTimeline
, fetchAccountFollowers
, fetchAccountFollowing
, fetchLocalTimeline
, fetchNotifications
, fetchGlobalTimeline
@ -134,6 +136,16 @@ fetchNotifications client =
fetch client (ApiUrl.notifications) <| Decode.list notificationDecoder
fetchAccountFollowers : Client -> Int -> Request (List Account)
fetchAccountFollowers client accountId =
fetch client (ApiUrl.followers accountId) <| Decode.list accountDecoder
fetchAccountFollowing : Client -> Int -> Request (List Account)
fetchAccountFollowing client accountId =
fetch client (ApiUrl.following accountId) <| Decode.list accountDecoder
userAccount : Client -> Request Account
userAccount client =
HttpBuilder.get (ApiUrl.userAccount client.server)

View File

@ -1,17 +1,15 @@
module Model exposing (..)
import Command
import Dom
import Json.Encode as Encode
import Dom.Scroll
import Navigation
import Mastodon.Decoder
import Mastodon.Encoder
import Mastodon.Helper
import Mastodon.Http
import Mastodon.Model
import Mastodon.Model exposing (..)
import Mastodon.WebSocket
import Ports
import Task
import Dom.Scroll
import Types exposing (..)
maxBuffer : Int
@ -20,124 +18,6 @@ maxBuffer =
100
type alias Flags =
{ client : Maybe Mastodon.Model.Client
, registration : Maybe Mastodon.Model.AppRegistration
}
type DraftMsg
= ClearDraft
| UpdateSensitive Bool
| UpdateSpoiler String
| UpdateStatus String
| UpdateVisibility String
| UpdateReplyTo Mastodon.Model.Status
| ToggleSpoiler Bool
type ViewerMsg
= CloseViewer
| OpenViewer (List Mastodon.Model.Attachment) Mastodon.Model.Attachment
type MastodonMsg
= AccessToken (Result Mastodon.Model.Error Mastodon.Model.AccessTokenResult)
| AppRegistered (Result Mastodon.Model.Error Mastodon.Model.AppRegistration)
| ContextLoaded Mastodon.Model.Status (Result Mastodon.Model.Error Mastodon.Model.Context)
| CurrentUser (Result Mastodon.Model.Error Mastodon.Model.Account)
| FavoriteAdded (Result Mastodon.Model.Error Mastodon.Model.Status)
| FavoriteRemoved (Result Mastodon.Model.Error Mastodon.Model.Status)
| LocalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
| Notifications (Result Mastodon.Model.Error (List Mastodon.Model.Notification))
| GlobalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
| Reblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
| StatusDeleted (Result Mastodon.Model.Error Int)
| StatusPosted (Result Mastodon.Model.Error Mastodon.Model.Status)
| Unreblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
| Account (Result Mastodon.Model.Error Mastodon.Model.Account)
| AccountTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
| UserTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
type WebSocketMsg
= NewWebsocketUserMessage String
| NewWebsocketGlobalMessage String
| NewWebsocketLocalMessage String
type Msg
= AddFavorite Int
| ClearOpenedAccount
| CloseThread
| DomResult (Result Dom.Error ())
| DeleteStatus Int
| DraftEvent DraftMsg
| LoadAccount Int
| MastodonEvent MastodonMsg
| NoOp
| OpenThread Mastodon.Model.Status
| Reblog Int
| Register
| RemoveFavorite Int
| ServerChange String
| SubmitDraft
| UrlChange Navigation.Location
| UseGlobalTimeline Bool
| Unreblog Int
| ViewerEvent ViewerMsg
| WebSocketEvent WebSocketMsg
| ScrollColumn String
type alias Draft =
{ status : String
, in_reply_to : Maybe Mastodon.Model.Status
, spoiler_text : Maybe String
, sensitive : Bool
, visibility : String
}
type alias Thread =
{ status : Mastodon.Model.Status
, context : Mastodon.Model.Context
}
type alias Viewer =
{ attachments : List Mastodon.Model.Attachment
, attachment : Mastodon.Model.Attachment
}
type CurrentView
= -- Basically, what we should be displaying in the fourth column
AccountView Mastodon.Model.Account
| ThreadView Thread
| LocalTimelineView
| GlobalTimelineView
type alias Model =
{ server : String
, registration : Maybe Mastodon.Model.AppRegistration
, client : Maybe Mastodon.Model.Client
, userTimeline : List Mastodon.Model.Status
, localTimeline : List Mastodon.Model.Status
, globalTimeline : List Mastodon.Model.Status
, accountTimeline : List Mastodon.Model.Status
, notifications : List Mastodon.Model.NotificationAggregate
, draft : Draft
, errors : List String
, location : Navigation.Location
, useGlobalTimeline : Bool
, viewer : Maybe Viewer
, currentUser : Maybe Mastodon.Model.Account
, currentView : CurrentView
}
extractAuthCode : Navigation.Location -> Maybe String
extractAuthCode { search } =
case (String.split "?code=" search) of
@ -171,6 +51,8 @@ init flags location =
, localTimeline = []
, globalTimeline = []
, accountTimeline = []
, accountFollowers = []
, accountFollowing = []
, notifications = []
, draft = defaultDraft
, errors = []
@ -180,100 +62,7 @@ init flags location =
, currentView = LocalTimelineView
, currentUser = Nothing
}
! [ initCommands flags.registration flags.client authCode ]
initCommands : Maybe Mastodon.Model.AppRegistration -> Maybe Mastodon.Model.Client -> Maybe String -> Cmd Msg
initCommands registration client authCode =
Cmd.batch <|
case authCode of
Just authCode ->
case registration of
Just registration ->
[ Mastodon.Http.getAccessToken registration authCode
|> Mastodon.Http.send (MastodonEvent << AccessToken)
]
Nothing ->
[]
Nothing ->
[ loadUserAccount client, loadTimelines client ]
registerApp : Model -> Cmd Msg
registerApp { server, location } =
let
appUrl =
location.origin ++ location.pathname
cleanServer =
if String.endsWith "/" server then
String.dropRight 1 server
else
server
in
Mastodon.Http.register
cleanServer
"tooty"
appUrl
"read write follow"
"https://github.com/n1k0/tooty"
|> Mastodon.Http.send (MastodonEvent << AppRegistered)
saveClient : Mastodon.Model.Client -> Cmd Msg
saveClient client =
Mastodon.Encoder.clientEncoder client
|> Encode.encode 0
|> Ports.saveClient
saveRegistration : Mastodon.Model.AppRegistration -> Cmd Msg
saveRegistration registration =
Mastodon.Encoder.registrationEncoder registration
|> Encode.encode 0
|> Ports.saveRegistration
loadNotifications : Maybe Mastodon.Model.Client -> Cmd Msg
loadNotifications client =
case client of
Just client ->
Mastodon.Http.fetchNotifications client
|> Mastodon.Http.send (MastodonEvent << Notifications)
Nothing ->
Cmd.none
loadUserAccount : Maybe Mastodon.Model.Client -> Cmd Msg
loadUserAccount client =
case client of
Just client ->
Mastodon.Http.userAccount client
|> Mastodon.Http.send (MastodonEvent << CurrentUser)
Nothing ->
Cmd.none
loadTimelines : Maybe Mastodon.Model.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
]
Nothing ->
Cmd.none
! [ Command.initCommands flags.registration flags.client authCode ]
preferredTimeline : Model -> CurrentView
@ -289,35 +78,23 @@ truncate entries =
List.take maxBuffer entries
postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg
postStatus client draft =
Mastodon.Http.postStatus client draft
|> Mastodon.Http.send (MastodonEvent << StatusPosted)
deleteStatus : Mastodon.Model.Client -> Int -> Cmd Msg
deleteStatus client id =
Mastodon.Http.deleteStatus client id
|> Mastodon.Http.send (MastodonEvent << StatusDeleted)
errorText : Mastodon.Model.Error -> String
errorText : Error -> String
errorText error =
case error of
Mastodon.Model.MastodonError statusCode statusMsg errorMsg ->
MastodonError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
Mastodon.Model.ServerError statusCode statusMsg errorMsg ->
ServerError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
Mastodon.Model.TimeoutError ->
TimeoutError ->
"Request timed out."
Mastodon.Model.NetworkError ->
NetworkError ->
"Unreachable host."
toStatusRequestBody : Draft -> Mastodon.Model.StatusRequestBody
toStatusRequestBody : Draft -> StatusRequestBody
toStatusRequestBody draft =
{ status = draft.status
, in_reply_to_id =
@ -333,7 +110,7 @@ toStatusRequestBody draft =
}
updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Model.Status -> Mastodon.Model.Status) -> Model -> Model
updateTimelinesWithBoolFlag : Int -> Bool -> (Status -> Status) -> Model -> Model
updateTimelinesWithBoolFlag statusId flag statusUpdater model =
let
update flag status =
@ -351,15 +128,17 @@ updateTimelinesWithBoolFlag statusId flag statusUpdater model =
processFavourite : Int -> Bool -> Model -> Model
processFavourite statusId flag model =
-- TODO: update notifications too
updateTimelinesWithBoolFlag statusId flag (\s -> { s | favourited = Just flag }) model
processReblog : Int -> Bool -> Model -> Model
processReblog statusId flag model =
-- TODO: update notifications too
updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model
deleteStatusFromTimeline : Int -> List Mastodon.Model.Status -> List Mastodon.Model.Status
deleteStatusFromTimeline : Int -> List Status -> List Status
deleteStatusFromTimeline statusId timeline =
timeline
|> List.filter
@ -371,7 +150,7 @@ deleteStatusFromTimeline statusId timeline =
)
updateDraft : DraftMsg -> Mastodon.Model.Account -> Draft -> ( Draft, Cmd Msg )
updateDraft : DraftMsg -> Account -> Draft -> ( Draft, Cmd Msg )
updateDraft draftMsg currentUser draft =
case draftMsg of
ClearDraft ->
@ -432,12 +211,12 @@ processMastodonEvent msg model =
Ok { server, accessToken } ->
let
client =
Mastodon.Model.Client server accessToken
Client server accessToken
in
{ model | client = Just client }
! [ loadTimelines <| Just client
! [ Command.loadTimelines <| Just client
, Navigation.modifyUrl model.location.pathname
, saveClient client
, Command.saveClient client
]
Err error ->
@ -447,8 +226,8 @@ processMastodonEvent msg model =
case result of
Ok registration ->
{ model | registration = Just registration }
! [ saveRegistration registration
, Navigation.load <| Mastodon.Http.getAuthorizationUrl registration
! [ Command.saveRegistration registration
, Command.navigateToAuthUrl registration
]
Err error ->
@ -457,11 +236,7 @@ processMastodonEvent msg model =
ContextLoaded status result ->
case result of
Ok context ->
let
thread =
Thread status context
in
{ model | currentView = ThreadView thread } ! []
{ model | currentView = ThreadView (Thread status context) } ! []
Err error ->
{ model
@ -481,7 +256,7 @@ processMastodonEvent msg model =
FavoriteAdded result ->
case result of
Ok status ->
processFavourite status.id True model ! [ loadNotifications model.client ]
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
@ -489,7 +264,7 @@ processMastodonEvent msg model =
FavoriteRemoved result ->
case result of
Ok status ->
processFavourite status.id False model ! [ loadNotifications model.client ]
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
@ -500,7 +275,7 @@ processMastodonEvent msg model =
{ model | localTimeline = localTimeline } ! []
Err error ->
{ model | localTimeline = [], errors = (errorText error) :: model.errors } ! []
{ model | errors = (errorText error) :: model.errors } ! []
Notifications result ->
case result of
@ -508,7 +283,7 @@ processMastodonEvent msg model =
{ model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! []
Err error ->
{ model | notifications = [], errors = (errorText error) :: model.errors } ! []
{ model | errors = (errorText error) :: model.errors } ! []
GlobalTimeline result ->
case result of
@ -516,12 +291,12 @@ processMastodonEvent msg model =
{ model | globalTimeline = globalTimeline } ! []
Err error ->
{ model | globalTimeline = [], errors = (errorText error) :: model.errors } ! []
{ model | errors = (errorText error) :: model.errors } ! []
Reblogged result ->
case result of
Ok status ->
model ! [ loadNotifications model.client ]
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
@ -545,15 +320,16 @@ processMastodonEvent msg model =
Unreblogged result ->
case result of
Ok status ->
model ! [ loadNotifications model.client ]
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Account result ->
AccountReceived result ->
case result of
Ok account ->
{ model | currentView = AccountView account } ! []
{ model | currentView = AccountView account }
! [ Command.loadAccountInfo model.client account.id ]
Err error ->
{ model
@ -570,13 +346,29 @@ processMastodonEvent msg model =
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowers result ->
case result of
Ok statuses ->
{ model | accountFollowers = statuses } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowing result ->
case result of
Ok statuses ->
{ model | accountFollowing = statuses } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
UserTimeline result ->
case result of
Ok userTimeline ->
{ model | userTimeline = userTimeline } ! []
Err error ->
{ model | userTimeline = [], errors = (errorText error) :: model.errors } ! []
{ model | errors = (errorText error) :: model.errors } ! []
processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg )
@ -672,9 +464,6 @@ update msg model =
NoOp ->
model ! []
DomResult result ->
model ! []
MastodonEvent msg ->
let
( newModel, commands ) =
@ -696,76 +485,28 @@ update msg model =
model ! []
Register ->
model ! [ registerApp model ]
model ! [ Command.registerApp model ]
OpenThread status ->
case model.client of
Just client ->
model
! [ Mastodon.Http.context client status.id
|> Mastodon.Http.send (MastodonEvent << (ContextLoaded status))
]
Nothing ->
model ! []
model ! [ Command.loadThread model.client status ]
CloseThread ->
{ model | currentView = preferredTimeline model } ! []
DeleteStatus id ->
case model.client of
Just client ->
model ! [ deleteStatus client id ]
model ! [ Command.deleteStatus model.client id ]
Nothing ->
model ! []
ReblogStatus id ->
processReblog id True model ! [ Command.reblogStatus model.client id ]
Reblog id ->
-- Note: The case of reblogging is specific as it seems the server
-- response takes a lot of time to be received by the client, so we
-- perform optimistic updates here.
case model.client of
Just client ->
processReblog id True model
! [ Mastodon.Http.reblog client id
|> Mastodon.Http.send (MastodonEvent << Reblogged)
]
Nothing ->
model ! []
Unreblog id ->
case model.client of
Just client ->
processReblog id False model
! [ Mastodon.Http.unfavourite client id
|> Mastodon.Http.send (MastodonEvent << Unreblogged)
]
Nothing ->
model ! []
UnreblogStatus id ->
processReblog id False model ! [ Command.unreblogStatus model.client id ]
AddFavorite id ->
model
! case model.client of
Just client ->
[ Mastodon.Http.favourite client id
|> Mastodon.Http.send (MastodonEvent << FavoriteAdded)
]
Nothing ->
[]
processFavourite id True model ! [ Command.favouriteStatus model.client id ]
RemoveFavorite id ->
model
! case model.client of
Just client ->
[ Mastodon.Http.unfavourite client id
|> Mastodon.Http.send (MastodonEvent << FavoriteRemoved)
]
Nothing ->
[]
processFavourite id False model ! [ Command.unfavouriteStatus model.client id ]
DraftEvent draftMsg ->
case model.currentUser of
@ -787,31 +528,20 @@ update msg model =
{ model | viewer = viewer } ! [ commands ]
SubmitDraft ->
model
! case model.client of
Just client ->
[ postStatus client <| toStatusRequestBody model.draft ]
Nothing ->
[]
model ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ]
LoadAccount accountId ->
{-
@TODO
When requesting a user profile, we should load a new "page"
so that the URL in the browser matches the user displayed
-}
{ model | currentView = preferredTimeline model }
! case model.client of
Just client ->
[ Mastodon.Http.fetchAccount client accountId
|> Mastodon.Http.send (MastodonEvent << Account)
, Mastodon.Http.fetchAccountTimeline client accountId
|> Mastodon.Http.send (MastodonEvent << AccountTimeline)
]
! [ Command.loadAccount model.client accountId ]
Nothing ->
[]
ViewAccountFollowers account ->
{ model | currentView = AccountFollowersView account model.accountFollowers } ! []
ViewAccountFollowing account ->
{ model | currentView = AccountFollowingView account model.accountFollowing } ! []
ViewAccountStatuses account ->
{ model | currentView = AccountView account } ! []
UseGlobalTimeline flag ->
let
@ -820,11 +550,17 @@ update msg model =
in
{ model | currentView = preferredTimeline newModel } ! []
ClearOpenedAccount ->
{ model | currentView = preferredTimeline model } ! []
CloseAccount ->
{ model
| currentView = preferredTimeline model
, accountTimeline = []
, accountFollowing = []
, accountFollowers = []
}
! []
ScrollColumn context ->
model ! [ Task.attempt DomResult <| Dom.Scroll.toTop context ]
model ! [ Task.attempt (always NoOp) <| Dom.Scroll.toTop context ]
subscriptions : Model -> Sub Msg

138
src/Types.elm Normal file
View File

@ -0,0 +1,138 @@
module Types exposing (..)
import Mastodon.Model exposing (..)
import Navigation
type alias Flags =
{ client : Maybe Client
, registration : Maybe AppRegistration
}
type DraftMsg
= ClearDraft
| UpdateSensitive Bool
| UpdateSpoiler String
| UpdateStatus String
| UpdateVisibility String
| UpdateReplyTo Status
| ToggleSpoiler Bool
type ViewerMsg
= CloseViewer
| OpenViewer (List Attachment) Attachment
type MastodonMsg
= AccessToken (Result Error AccessTokenResult)
| AccountFollowers (Result Error (List Account))
| AccountFollowing (Result Error (List Account))
| AccountReceived (Result Error Account)
| AccountTimeline (Result Error (List Status))
| 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))
type WebSocketMsg
= NewWebsocketGlobalMessage String
| NewWebsocketLocalMessage String
| NewWebsocketUserMessage String
type Msg
= AddFavorite Int
| CloseAccount
| CloseThread
| DeleteStatus Int
| DraftEvent DraftMsg
| LoadAccount Int
| MastodonEvent MastodonMsg
| NoOp
| OpenThread Status
| ReblogStatus Int
| Register
| RemoveFavorite Int
| ScrollColumn String
| ServerChange String
| SubmitDraft
| UrlChange Navigation.Location
| UseGlobalTimeline Bool
| UnreblogStatus Int
| ViewAccountFollowing Account
| ViewAccountFollowers Account
| ViewAccountStatuses Account
| ViewerEvent ViewerMsg
| WebSocketEvent WebSocketMsg
type alias AccountViewInfo =
{ account : Account
, timeline : List Status
, folowers : List Account
, following : List Account
}
type alias Draft =
{ status : String
, in_reply_to : Maybe Status
, spoiler_text : Maybe String
, sensitive : Bool
, visibility : String
}
type alias Thread =
{ status : Status
, context : Context
}
type alias Viewer =
{ attachments : List Attachment
, attachment : Attachment
}
type CurrentView
= -- Basically, what we should be displaying in the fourth column
AccountFollowersView Account (List Account)
| AccountFollowingView Account (List Account)
| AccountView Account
| GlobalTimelineView
| LocalTimelineView
| ThreadView Thread
type alias Model =
{ server : String
, registration : Maybe AppRegistration
, client : Maybe Client
, userTimeline : List Status
, localTimeline : List Status
, globalTimeline : List Status
, accountTimeline : List Status
, accountFollowers : List Account
, accountFollowing : List Account
, notifications : List NotificationAggregate
, draft : Draft
, errors : List String
, location : Navigation.Location
, useGlobalTimeline : Bool
, viewer : Maybe Viewer
, currentUser : Maybe Account
, currentView : CurrentView
}

View File

@ -6,8 +6,8 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..)
import List.Extra exposing (elemIndex, getAt)
import Mastodon.Helper
import Mastodon.Model
import Model exposing (..)
import Mastodon.Model exposing (..)
import Types exposing (..)
import ViewHelper exposing (..)
import Date
import Date.Extra.Config.Config_en_au as DateEn
@ -66,7 +66,7 @@ icon name =
i [ class <| "glyphicon glyphicon-" ++ name ] []
accountLink : Mastodon.Model.Account -> Html Msg
accountLink : Account -> Html Msg
accountLink account =
a
[ href account.url
@ -75,7 +75,7 @@ accountLink account =
[ text <| "@" ++ account.username ]
accountAvatarLink : Mastodon.Model.Account -> Html Msg
accountAvatarLink : Account -> Html Msg
accountAvatarLink account =
a
[ href account.url
@ -85,12 +85,7 @@ accountAvatarLink account =
[ img [ class "avatar", src account.avatar ] [] ]
attachmentPreview :
String
-> Maybe Bool
-> List Mastodon.Model.Attachment
-> Mastodon.Model.Attachment
-> Html Msg
attachmentPreview : String -> Maybe Bool -> List Attachment -> Attachment -> Html Msg
attachmentPreview context sensitive attachments ({ url, preview_url } as attachment) =
let
nsfw =
@ -133,7 +128,7 @@ attachmentPreview context sensitive attachments ({ url, preview_url } as attachm
[ media ]
attachmentListView : String -> Mastodon.Model.Status -> Html Msg
attachmentListView : String -> Status -> Html Msg
attachmentListView context { media_attachments, sensitive } =
case media_attachments of
[] ->
@ -144,7 +139,7 @@ attachmentListView context { media_attachments, sensitive } =
List.map (attachmentPreview context sensitive attachments) attachments
statusContentView : String -> Mastodon.Model.Status -> Html Msg
statusContentView : String -> Status -> Html Msg
statusContentView context status =
case status.spoiler_text of
"" ->
@ -170,7 +165,7 @@ statusContentView context status =
]
statusView : String -> Mastodon.Model.Status -> Html Msg
statusView : String -> Status -> Html Msg
statusView context ({ account, content, media_attachments, reblog, mentions } as status) =
let
accountLinkAttributes =
@ -183,7 +178,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
]
in
case reblog of
Just (Mastodon.Model.Reblog reblog) ->
Just (Reblog reblog) ->
div [ class "reblog" ]
[ p [ class "status-info" ]
[ icon "fire"
@ -207,58 +202,94 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
]
accountTimelineView :
Mastodon.Model.Account
-> List Mastodon.Model.Status
-> String
-> String
-> Html Msg
accountTimelineView account statuses label iconName =
div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ]
[ closeablePanelheading iconName label ClearOpenedAccount
, div [ class "timeline" ]
[ div
[ class "account-detail"
, style [ ( "background-image", "url('" ++ account.header ++ "')" ) ]
]
[ div [ class "opacity-layer" ]
[ img [ src account.avatar ] []
, span [ class "account-display-name" ] [ text account.display_name ]
, span [ class "account-username" ] [ text ("@" ++ account.username) ]
, span [ class "account-note" ] (formatContent account.note [])
]
]
, div [ class "row account-infos" ]
[ div [ class "col-md-4" ]
[ text "Statuses"
, br [] []
, text <| toString account.statuses_count
]
, div [ class "col-md-4" ]
[ text "Following"
, br [] []
, text <| toString account.following_count
]
, div [ class "col-md-4" ]
[ text "Followers"
, br [] []
, text <| toString account.followers_count
]
]
, ul [ class "list-group" ] <|
List.map
(\s ->
li [ class "list-group-item status" ]
[ statusView "account" s ]
)
statuses
followView : Account -> Html Msg
followView account =
div [ class "follow-entry" ]
[ accountAvatarLink account
, div [ class "username" ]
[ strong []
[ text <|
if account.display_name /= "" then
account.display_name
else
account.username
]
, br [] []
, text <| "@" ++ account.acct
]
]
statusActionsView : Mastodon.Model.Status -> Mastodon.Model.Account -> Html Msg
accountCounterLink : String -> Int -> (Account -> Msg) -> Account -> Html Msg
accountCounterLink label count tagger account =
a
[ href ""
, class "col-md-4"
, onClickWithPreventAndStop <| tagger account
]
[ text label
, br [] []
, text <| toString count
]
accountView : String -> String -> Account -> Html Msg -> Html Msg
accountView label iconName account panelContent =
let
{ statuses_count, following_count, followers_count } =
account
in
div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ]
[ closeablePanelheading iconName label CloseAccount
, div [ class "timeline" ]
[ div
[ class "account-detail"
, style [ ( "background-image", "url('" ++ account.header ++ "')" ) ]
]
[ div [ class "opacity-layer" ]
[ img [ src account.avatar ] []
, span [ class "account-display-name" ] [ text account.display_name ]
, span [ class "account-username" ] [ text ("@" ++ account.username) ]
, span [ class "account-note" ] (formatContent account.note [])
]
]
, div [ class "row account-infos" ]
[ accountCounterLink "Statuses" statuses_count ViewAccountStatuses account
, accountCounterLink "Following" following_count ViewAccountFollowing account
, accountCounterLink "Followers" followers_count ViewAccountFollowers account
]
, panelContent
]
]
]
accountTimelineView : String -> List Status -> Account -> Html Msg
accountTimelineView label statuses account =
accountView label "user" account <|
ul [ class "list-group" ] <|
List.map
(\s ->
li [ class "list-group-item status" ]
[ statusView "account" s ]
)
statuses
accountFollowView : String -> List Account -> Account -> Html Msg
accountFollowView label accounts account =
accountView label "user" account <|
ul [ class "list-group" ] <|
List.map
(\account ->
li [ class "list-group-item status" ]
[ followView account ]
)
accounts
statusActionsView : Status -> Account -> Html Msg
statusActionsView status currentUser =
let
sourceStatus =
@ -270,10 +301,10 @@ statusActionsView status currentUser =
( reblogClasses, reblogEvent ) =
case status.reblogged of
Just True ->
( baseBtnClasses ++ " reblogged", Unreblog sourceStatus.id )
( baseBtnClasses ++ " reblogged", UnreblogStatus sourceStatus.id )
_ ->
( baseBtnClasses, Reblog sourceStatus.id )
( baseBtnClasses, ReblogStatus sourceStatus.id )
( favClasses, favEvent ) =
case status.favourited of
@ -322,7 +353,7 @@ statusActionsView status currentUser =
]
statusEntryView : String -> String -> Mastodon.Model.Account -> Mastodon.Model.Status -> Html Msg
statusEntryView : String -> String -> Account -> Status -> Html Msg
statusEntryView context className currentUser status =
let
nsfwClass =
@ -339,13 +370,7 @@ statusEntryView context className currentUser status =
]
timelineView :
String
-> String
-> String
-> Mastodon.Model.Account
-> List Mastodon.Model.Status
-> Html Msg
timelineView : String -> String -> String -> Account -> List Status -> Html Msg
timelineView label iconName context currentUser statuses =
div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ]
@ -358,7 +383,7 @@ timelineView label iconName context currentUser statuses =
]
notificationHeading : List Mastodon.Model.Account -> String -> String -> Html Msg
notificationHeading : List Account -> String -> String -> Html Msg
notificationHeading accounts str iconType =
div [ class "status-info" ]
[ div [ class "avatars" ] <| List.map accountAvatarLink accounts
@ -371,12 +396,7 @@ notificationHeading accounts str iconType =
]
notificationStatusView :
String
-> Mastodon.Model.Account
-> Mastodon.Model.Status
-> Mastodon.Model.NotificationAggregate
-> Html Msg
notificationStatusView : String -> Account -> Status -> NotificationAggregate -> Html Msg
notificationStatusView context currentUser status { type_, accounts } =
div [ class <| "notification " ++ type_ ]
[ case type_ of
@ -393,7 +413,7 @@ notificationStatusView context currentUser status { type_, accounts } =
]
notificationFollowView : Mastodon.Model.Account -> Mastodon.Model.NotificationAggregate -> Html Msg
notificationFollowView : Account -> NotificationAggregate -> Html Msg
notificationFollowView currentUser { accounts } =
let
profileView account =
@ -414,10 +434,7 @@ notificationFollowView currentUser { accounts } =
]
notificationEntryView :
Mastodon.Model.Account
-> Mastodon.Model.NotificationAggregate
-> Html Msg
notificationEntryView : Account -> NotificationAggregate -> Html Msg
notificationEntryView currentUser notification =
li [ class "list-group-item" ]
[ case notification.status of
@ -429,7 +446,7 @@ notificationEntryView currentUser notification =
]
notificationListView : Mastodon.Model.Account -> List Mastodon.Model.NotificationAggregate -> Html Msg
notificationListView : Account -> List NotificationAggregate -> Html Msg
notificationListView currentUser notifications =
div [ class "col-md-3 column" ]
[ div [ class "panel panel-default" ]
@ -465,7 +482,7 @@ draftReplyToView draft =
text ""
currentUserView : Maybe Mastodon.Model.Account -> Html Msg
currentUserView : Maybe Account -> Html Msg
currentUserView currentUser =
case currentUser of
Just currentUser ->
@ -594,7 +611,7 @@ draftView { draft, currentUser } =
]
threadView : Mastodon.Model.Account -> Thread -> Html Msg
threadView : Account -> Thread -> Html Msg
threadView currentUser thread =
let
statuses =
@ -663,7 +680,7 @@ homepageView model =
model.userTimeline
, notificationListView currentUser model.notifications
, case model.currentView of
Model.LocalTimelineView ->
LocalTimelineView ->
timelineView
"Local timeline"
"th-large"
@ -671,7 +688,7 @@ homepageView model =
currentUser
model.localTimeline
Model.GlobalTimelineView ->
GlobalTimelineView ->
timelineView
"Global timeline"
"globe"
@ -679,11 +696,16 @@ homepageView model =
currentUser
model.globalTimeline
Model.AccountView account ->
-- Todo: Load the user timeline
accountTimelineView account model.accountTimeline "Account" "user"
AccountView account ->
accountTimelineView "Account" model.accountTimeline account
Model.ThreadView thread ->
AccountFollowersView account followers ->
accountFollowView "Account followers" model.accountFollowers account
AccountFollowingView account following ->
accountFollowView "Account following" model.accountFollowing account
ThreadView thread ->
threadView currentUser thread
]

View File

@ -15,7 +15,7 @@ import HtmlParser
import Json.Decode as Decode
import String.Extra exposing (replace)
import Mastodon.Model
import Model exposing (Msg(LoadAccount))
import Types exposing (..)
-- Custom Events
@ -83,7 +83,7 @@ createLinkNode attrs children mentions =
Nothing ->
Html.node "a"
((List.map toAttribute attrs)
++ [ onClickWithStop Model.NoOp, target "_blank" ]
++ [ onClickWithStop NoOp, target "_blank" ]
)
(toVirtualDom mentions children)
@ -91,10 +91,8 @@ createLinkNode attrs children mentions =
getHrefLink : List ( String, String ) -> Maybe String
getHrefLink attrs =
attrs
|> List.filter
(\( name, value ) -> (name == "href"))
|> List.map
(\( name, value ) -> value)
|> List.filter (\( name, value ) -> (name == "href"))
|> List.map (\( name, value ) -> value)
|> List.head