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

* Add Mastodon.Http.context.
* Added thread events.
* Fix a few server endpoint urls.
* Added thread views.

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 {

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

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

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)

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

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

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 ]
+                    [ closeablePanelheading iconName label ClearOpenedAccount ]
-                    , div [ class "col-xs-3 text-right" ]
-                        [ a
-                            [ href ""
-                            , ViewHelper.onClickWithPreventAndStop ClearOpenedAccount
-                            ]
-                            [ icon "remove" ]
-                        ]
-                    ]
                 ]
             , 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 : String -> String -> Mastodon.Model.Status -> Html Msg
-statusEntryView context status =
+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
+        , case model.currentView of
-            Just account ->
+            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 ->
+            Model.ThreadView thread ->
-                if model.useGlobalTimeline then
+                threadView thread
-                    timelineView "Global timeline" "globe" "global" model.globalTimeline
-                else
-                    timelineView "Local timeline" "th-large" "local" model.localTimeline
         ]
 
 

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)