Fix #65: Add a thread view. (#73)

* Add Mastodon.Http.context.
* Added thread events.
* Fix a few server endpoint urls.
* Added thread views.
This commit is contained in:
Nicolas Perriault 2017-04-27 18:39:14 +02:00 committed by GitHub
parent f5b41aa155
commit 0ad2b59c32
8 changed files with 175 additions and 41 deletions

View File

@ -89,6 +89,16 @@ body {
color: #9baec8;
}
/* Thread */
.thread-target {
background: #3c444c;
}
.thread-target .status-text {
font-size: 1.3em;
}
/* Status actions */
.actions {

View File

@ -8,6 +8,7 @@ module Mastodon.ApiUrl
, publicTimeline
, notifications
, statuses
, context
, reblog
, unreblog
, favourite
@ -74,24 +75,29 @@ statuses server =
server ++ "/api/v1/statuses"
context : Server -> Int -> String
context server id =
statuses server ++ "/" ++ (toString id) ++ "/context"
reblog : Server -> Int -> String
reblog server id =
statuses server ++ (toString id) ++ "/reblog"
statuses server ++ "/" ++ (toString id) ++ "/reblog"
unreblog : Server -> Int -> String
unreblog server id =
statuses server ++ (toString id) ++ "/unreblog"
statuses server ++ "/" ++ (toString id) ++ "/unreblog"
favourite : Server -> Int -> String
favourite server id =
statuses server ++ (toString id) ++ "/favourite"
statuses server ++ "/" ++ (toString id) ++ "/favourite"
unfavourite : Server -> Int -> String
unfavourite server id =
statuses server ++ (toString id) ++ "/unfavourite"
statuses server ++ "/" ++ (toString id) ++ "/unfavourite"
streaming : Server -> String

View File

@ -4,6 +4,7 @@ module Mastodon.Decoder
, accessTokenDecoder
, accountDecoder
, attachmentDecoder
, contextDecoder
, decodeWebSocketMessage
, mastodonErrorDecoder
, mentionDecoder
@ -68,6 +69,13 @@ attachmentDecoder =
|> Pipe.required "text_url" (Decode.nullable Decode.string)
contextDecoder : Decode.Decoder Context
contextDecoder =
Pipe.decode Context
|> Pipe.required "ancestors" (Decode.list statusDecoder)
|> Pipe.required "descendants" (Decode.list statusDecoder)
mastodonErrorDecoder : Decode.Decoder String
mastodonErrorDecoder =
Decode.field "error" Decode.string

View File

@ -1,6 +1,7 @@
module Mastodon.Http
exposing
( Request
, context
, reblog
, unreblog
, favourite
@ -133,6 +134,13 @@ postStatus client statusRequestBody =
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)
context : Client -> Int -> Request Context
context client id =
HttpBuilder.get (ApiUrl.context client.server id)
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson contextDecoder)
reblog : Client -> Int -> Request Status
reblog client id =
HttpBuilder.post (ApiUrl.reblog client.server id)

View File

@ -5,6 +5,7 @@ module Mastodon.Model
, Account
, Attachment
, Client
, Context
, Error(..)
, Mention
, Notification
@ -15,8 +16,6 @@ module Mastodon.Model
, StatusRequestBody
)
import HttpBuilder
type alias AccountId =
Int
@ -107,6 +106,12 @@ type alias Client =
}
type alias Context =
{ ancestors : List Status
, descendants : List Status
}
type alias Mention =
{ id : AccountId
, url : String

View File

@ -38,6 +38,7 @@ type ViewerMsg
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)
| 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))
@ -58,10 +59,13 @@ type WebSocketMsg
type Msg
= AddFavorite Int
| ClearOpenedAccount
| CloseThread
| DraftEvent DraftMsg
| LoadUserAccount Int
| MastodonEvent MastodonMsg
| NoOp
| OnLoadUserAccount Int
| OpenThread Mastodon.Model.Status
| Reblog Int
| Register
| RemoveFavorite Int
@ -69,7 +73,6 @@ type Msg
| SubmitDraft
| UrlChange Navigation.Location
| UseGlobalTimeline Bool
| ClearOpenedAccount
| Unreblog Int
| ViewerEvent ViewerMsg
| WebSocketEvent WebSocketMsg
@ -84,12 +87,26 @@ type alias Draft =
}
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
@ -99,11 +116,11 @@ type alias Model =
, globalTimeline : List Mastodon.Model.Status
, notifications : List Mastodon.Model.NotificationAggregate
, draft : Draft
, account : Maybe Mastodon.Model.Account
, errors : List String
, location : Navigation.Location
, useGlobalTimeline : Bool
, viewer : Maybe Viewer
, currentView : CurrentView
}
@ -141,11 +158,11 @@ init flags location =
, globalTimeline = []
, notifications = []
, draft = defaultDraft
, account = Nothing
, errors = []
, location = location
, useGlobalTimeline = False
, viewer = Nothing
, currentView = LocalTimelineView
}
! [ initCommands flags.registration flags.client authCode ]
@ -232,6 +249,14 @@ loadTimelines client =
Cmd.none
preferredTimeline : Model -> CurrentView
preferredTimeline model =
if model.useGlobalTimeline then
GlobalTimelineView
else
LocalTimelineView
postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg
postStatus client draft =
Mastodon.Http.postStatus client draft
@ -402,6 +427,22 @@ processMastodonEvent msg model =
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
ContextLoaded status result ->
case result of
Ok context ->
let
thread =
Thread status context
in
{ model | currentView = ThreadView thread } ! []
Err error ->
{ model
| currentView = preferredTimeline model
, errors = (errorText error) :: model.errors
}
! []
FavoriteAdded result ->
case result of
Ok status ->
@ -464,10 +505,14 @@ processMastodonEvent msg model =
UserAccount result ->
case result of
Ok account ->
{ model | account = Just account } ! []
{ model | currentView = AccountView account } ! []
Err error ->
{ model | account = Nothing, errors = (errorText error) :: model.errors } ! []
{ model
| currentView = preferredTimeline model
, errors = (errorText error) :: model.errors
}
! []
UserTimeline result ->
case result of
@ -594,6 +639,20 @@ update msg model =
Register ->
model ! [ 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 ! []
CloseThread ->
{ model | currentView = preferredTimeline model } ! []
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
@ -664,7 +723,7 @@ update msg model =
Nothing ->
[]
OnLoadUserAccount accountId ->
LoadUserAccount accountId ->
{-
@TODO
When requesting a user profile, we should load a new "page"
@ -684,7 +743,7 @@ update msg model =
{ model | useGlobalTimeline = flag } ! []
ClearOpenedAccount ->
{ model | account = Nothing } ! []
{ model | currentView = preferredTimeline model } ! []
subscriptions : Model -> Sub Msg

View File

@ -7,7 +7,7 @@ import Html.Events exposing (..)
import List.Extra exposing (elemIndex, getAt)
import Mastodon.Helper
import Mastodon.Model
import Model exposing (Model, Draft, DraftMsg(..), Viewer, ViewerMsg(..), Msg(..))
import Model exposing (..)
import ViewHelper
import Date
import Date.Extra.Config.Config_en_au as DateEn
@ -24,6 +24,22 @@ visibilities =
]
closeablePanelheading : String -> String -> Msg -> Html Msg
closeablePanelheading iconName label onClose =
div [ class "panel-heading" ]
[ div [ class "row" ]
[ div [ class "col-xs-9 heading" ] [ icon iconName, text label ]
, div [ class "col-xs-3 text-right" ]
[ a
[ href ""
, ViewHelper.onClickWithPreventAndStop onClose
]
[ icon "remove" ]
]
]
]
errorView : String -> Html Msg
errorView error =
div [ class "alert alert-danger" ] [ text error ]
@ -54,7 +70,7 @@ accountLink : Mastodon.Model.Account -> Html Msg
accountLink account =
a
[ href account.url
, ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id)
, ViewHelper.onClickWithPreventAndStop (LoadUserAccount account.id)
]
[ text <| "@" ++ account.username ]
@ -63,7 +79,7 @@ accountAvatarLink : Mastodon.Model.Account -> Html Msg
accountAvatarLink account =
a
[ href account.url
, ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id)
, ViewHelper.onClickWithPreventAndStop (LoadUserAccount account.id)
, title <| "@" ++ account.username
]
[ img [ class "avatar", src account.avatar ] [] ]
@ -158,7 +174,7 @@ statusView context ({ account, content, media_attachments, reblog, mentions } as
-- When clicking on a status, we should not let the browser
-- redirect to a new page. That's why we're preventing the default
-- behavior here
, ViewHelper.onClickWithPreventAndStop (OnLoadUserAccount account.id)
, ViewHelper.onClickWithPreventAndStop (LoadUserAccount account.id)
]
in
case reblog of
@ -192,15 +208,7 @@ accountTimelineView account statuses label iconName =
[ div [ class "panel panel-default" ]
[ div [ class "panel-heading" ]
[ div [ class "row" ]
[ div [ class "col-xs-9 heading" ] [ icon iconName, text label ]
, div [ class "col-xs-3 text-right" ]
[ a
[ href ""
, ViewHelper.onClickWithPreventAndStop ClearOpenedAccount
]
[ icon "remove" ]
]
]
[ closeablePanelheading iconName label ClearOpenedAccount ]
]
, div [ class "account-detail", style [ ( "background-image", "url('" ++ account.header ++ "')" ) ] ]
[ div [ class "opacity-layer" ]
@ -290,14 +298,14 @@ statusActionsView status =
, a
[ class baseBtnClasses
, href status.url
, target "_blank"
, ViewHelper.onClickWithPreventAndStop <| OpenThread status
]
[ icon "time", formatDate ]
]
statusEntryView : String -> Mastodon.Model.Status -> Html Msg
statusEntryView context status =
statusEntryView : String -> String -> Mastodon.Model.Status -> Html Msg
statusEntryView context className status =
let
nsfwClass =
case status.sensitive of
@ -307,7 +315,7 @@ statusEntryView context status =
_ ->
""
in
li [ class <| "list-group-item " ++ nsfwClass ]
li [ class <| "list-group-item " ++ className ++ " " ++ nsfwClass ]
[ statusView context status
, statusActionsView status
]
@ -322,7 +330,7 @@ timelineView label iconName context statuses =
, text label
]
, ul [ class "list-group" ] <|
List.map (statusEntryView context) statuses
List.map (statusEntryView context "") statuses
]
]
@ -536,6 +544,33 @@ draftView { draft } =
]
threadView : Thread -> Html Msg
threadView thread =
let
statuses =
List.concat
[ thread.context.ancestors
, [ thread.status ]
, thread.context.descendants
]
threadEntry status =
statusEntryView "thread"
(if status == thread.status then
"thread-target"
else
""
)
status
in
div [ class "col-md-3" ]
[ div [ class "panel panel-default" ]
[ closeablePanelheading "list" "Thread" CloseThread
, ul [ class "list-group" ] <| List.map threadEntry statuses
]
]
optionsView : Model -> Html Msg
optionsView model =
div [ class "panel panel-default" ]
@ -569,16 +604,19 @@ homepageView model =
[ sidebarView model
, timelineView "Home timeline" "home" "home" model.userTimeline
, notificationListView model.notifications
, case model.account of
Just account ->
, case model.currentView of
Model.LocalTimelineView ->
timelineView "Local timeline" "th-large" "local" model.localTimeline
Model.GlobalTimelineView ->
timelineView "Global timeline" "globe" "global" model.globalTimeline
Model.AccountView account ->
-- Todo: Load the user timeline
accountTimelineView account [] "Account" "user"
Nothing ->
if model.useGlobalTimeline then
timelineView "Global timeline" "globe" "global" model.globalTimeline
else
timelineView "Local timeline" "th-large" "local" model.localTimeline
Model.ThreadView thread ->
threadView thread
]

View File

@ -13,7 +13,7 @@ import HtmlParser
import Json.Decode as Decode
import String.Extra exposing (replace)
import Mastodon.Model
import Model exposing (Msg(OnLoadUserAccount))
import Model exposing (Msg(LoadUserAccount))
-- Custom Events
@ -58,7 +58,7 @@ createLinkNode attrs children mentions =
Just mention ->
Html.node "a"
((List.map toAttribute attrs)
++ [ onClickWithPreventAndStop (OnLoadUserAccount mention.id) ]
++ [ onClickWithPreventAndStop (LoadUserAccount mention.id) ]
)
(toVirtualDom mentions children)