diff --git a/public/style.css b/public/style.css index 6254235..d3735f6 100644 --- a/public/style.css +++ b/public/style.css @@ -89,6 +89,16 @@ body { color: #9baec8; } +/* Thread */ + +.thread-target { + background: #3c444c; +} + +.thread-target .status-text { + font-size: 1.3em; +} + /* Status actions */ .actions { diff --git a/src/Mastodon/ApiUrl.elm b/src/Mastodon/ApiUrl.elm index 1474db7..2143ed8 100644 --- a/src/Mastodon/ApiUrl.elm +++ b/src/Mastodon/ApiUrl.elm @@ -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 diff --git a/src/Mastodon/Decoder.elm b/src/Mastodon/Decoder.elm index 6c43a9b..b4861bd 100644 --- a/src/Mastodon/Decoder.elm +++ b/src/Mastodon/Decoder.elm @@ -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 diff --git a/src/Mastodon/Http.elm b/src/Mastodon/Http.elm index b61c3eb..243fedb 100644 --- a/src/Mastodon/Http.elm +++ b/src/Mastodon/Http.elm @@ -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) diff --git a/src/Mastodon/Model.elm b/src/Mastodon/Model.elm index da6c693..ea29a42 100644 --- a/src/Mastodon/Model.elm +++ b/src/Mastodon/Model.elm @@ -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 diff --git a/src/Model.elm b/src/Model.elm index acb67e6..5633f94 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -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 diff --git a/src/View.elm b/src/View.elm index ac526a7..9dce44a 100644 --- a/src/View.elm +++ b/src/View.elm @@ -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 ] diff --git a/src/ViewHelper.elm b/src/ViewHelper.elm index 362417e..e25a5c0 100644 --- a/src/ViewHelper.elm +++ b/src/ViewHelper.elm @@ -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)