WiP: Add status action buttons. (#32)

* Add status action buttons.
* Handle favorite actions.
* Handle reblog actions.
* Optimistic updates for reblogs.

README.md

@@ -10,7 +10,11 @@ An [experimental Mastodon client](https://n1k0.github.io/tooty/) written in Elm.
 
 ### Starting the dev server
 
-    $ npm run live
+    $ npm start
+
+### Starting the dev server in live debug mode
+
+    $ npm run debug
 
 ### Building
 

elm-package.json

@@ -10,6 +10,7 @@
     "dependencies": {
         "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.0.0",
+        "elm-lang/dom": "1.1.1 <= v < 2.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0",
         "elm-lang/http": "1.0.0 <= v < 2.0.0",
         "elm-lang/navigation": "2.1.0 <= v < 3.0.0",

package.json

@@ -5,8 +5,9 @@
   "scripts": {
     "build": "node_modules/.bin/elm-make src/Main.elm --warn --output=build/app.js && npm run copy-assets",
     "copy-assets": "cp public/index.html build/ && cp public/style.css build/",
+    "debug": "node_modules/.bin/elm-live src/Main.elm --dir=public/ --output=public/app.js --debug",
     "deploy": "npm run build && node_modules/.bin/gh-pages --dist build/",
-    "live": "node_modules/.bin/elm-live src/Main.elm --dir=public/ --output=public/app.js --debug",
+    "start": "node_modules/.bin/elm-live src/Main.elm --dir=public/ --output=public/app.js",
     "test": "node_modules/.bin/elm-make src/Main.elm --warn --output /tmp/tooty.html"
   },
   "repository": {

public/style.css

@@ -15,6 +15,7 @@ body {
 .reblog > p:first-of-type,
 .notification > p:first-of-type {
   color: #999;
+  margin-bottom: 8px;
 }
 .reblog > p:first-of-type > a,
 .notification > p:first-of-type > a {
@@ -68,10 +69,37 @@ body {
   color: #9baec8;
 }
 
+/* Status actions */
+
+.actions {
+  margin-left: 65px;
+  width: calc(100% - 65px);
+}
+
+.actions > .btn {
+  border: none;
+  background: transparent;
+  color: #aaa;
+  padding: 0 2.4em 0 0;
+  text-align: left;
+}
+
+.actions > .btn > .glyphicon {
+  margin-right: 5px;
+}
+
+.actions .favourited {
+  color: #d1ac0e;
+}
+
+.actions .reblogged {
+  color: #d56344;
+}
+
 /* Attachments */
 
 .attachments {
-  margin: 0;
+  margin: 0 0 15px 0;
   padding: 0;
   list-style-type: none;
   overflow: hidden;
@@ -151,6 +179,20 @@ body {
   transition: all .6s;
 }
 
+/* Draft form */
+
+.in-reply-to .attachments {
+  margin: 0;
+}
+.in-reply-to .attachments li {
+  display: none;
+}
+.in-reply-to .attachments:after {
+  content: "[attachments hidden]";
+  font-size: .9em;
+  color: #555;
+}
+
 /* Status text content rules */
 
 .attachment {

src/Mastodon.elm

@@ -12,6 +12,11 @@ module Mastodon
         , Status
         , StatusRequestBody
         , Tag
+        , reblog
+        , unreblog
+        , favourite
+        , unfavourite
+        , extractReblog
         , register
         , registrationEncoder
         , clientEncoder
@@ -406,6 +411,16 @@ extractError error =
             NetworkError
 
 
+extractReblog : Status -> Status
+extractReblog status =
+    case status.reblog of
+        Just (Reblog reblog) ->
+            reblog
+
+        Nothing ->
+            status
+
+
 toResponse : Result Http.Error a -> Result Error a
 toResponse result =
     Result.mapError extractError result
@@ -502,3 +517,31 @@ postStatus client statusRequestBody =
         |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
         |> HttpBuilder.withExpect (Http.expectJson statusDecoder)
         |> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)
+
+
+reblog : Client -> Int -> Request Status
+reblog client id =
+    HttpBuilder.post (client.server ++ "/api/v1/statuses/" ++ (toString id) ++ "/reblog")
+        |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
+        |> HttpBuilder.withExpect (Http.expectJson statusDecoder)
+
+
+unreblog : Client -> Int -> Request Status
+unreblog client id =
+    HttpBuilder.post (client.server ++ "/api/v1/statuses/" ++ (toString id) ++ "/unreblog")
+        |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
+        |> HttpBuilder.withExpect (Http.expectJson statusDecoder)
+
+
+favourite : Client -> Int -> Request Status
+favourite client id =
+    HttpBuilder.post (client.server ++ "/api/v1/statuses/" ++ (toString id) ++ "/favourite")
+        |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
+        |> HttpBuilder.withExpect (Http.expectJson statusDecoder)
+
+
+unfavourite : Client -> Int -> Request Status
+unfavourite client id =
+    HttpBuilder.post (client.server ++ "/api/v1/statuses/" ++ (toString id) ++ "/unfavourite")
+        |> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
+        |> HttpBuilder.withExpect (Http.expectJson statusDecoder)

src/Model.elm

@@ -1,9 +1,11 @@
 module Model exposing (..)
 
+import Dom
 import Json.Encode as Encode
 import Navigation
 import Mastodon
 import Ports
+import Task
 
 
 type alias Flags =
@@ -13,22 +15,37 @@ type alias Flags =
 
 
 type DraftMsg
-    = ToggleSpoiler Bool
+    = ClearDraft
+    | ClearReplyTo
     | UpdateSensitive Bool
     | UpdateSpoiler String
     | UpdateStatus String
     | UpdateVisibility String
+    | UpdateReplyTo Mastodon.Status
+    | ToggleSpoiler Bool
 
 
-type Msg
+type
+    Msg
+    {-
+       FIXME: Mastodon server response messages should be extracted to their own
+       MastodonMsg type at some point.
+    -}
     = AccessToken (Result Mastodon.Error Mastodon.AccessTokenResult)
+    | AddFavorite Int
     | AppRegistered (Result Mastodon.Error Mastodon.AppRegistration)
     | DraftEvent DraftMsg
+    | FavoriteAdded (Result Mastodon.Error Mastodon.Status)
+    | FavoriteRemoved (Result Mastodon.Error Mastodon.Status)
     | LocalTimeline (Result Mastodon.Error (List Mastodon.Status))
+    | NoOp
     | Notifications (Result Mastodon.Error (List Mastodon.Notification))
     | OnLoadUserAccount Int
     | PublicTimeline (Result Mastodon.Error (List Mastodon.Status))
+    | Reblog Int
+    | Reblogged (Result Mastodon.Error Mastodon.Status)
     | Register
+    | RemoveFavorite Int
     | ServerChange String
     | StatusPosted (Result Mastodon.Error Mastodon.Status)
     | SubmitDraft
@@ -36,9 +53,25 @@ type Msg
     | UseGlobalTimeline Bool
     | UserAccount (Result Mastodon.Error Mastodon.Account)
     | ClearOpenedAccount
+    | Unreblog Int
+    | Unreblogged (Result Mastodon.Error Mastodon.Status)
     | UserTimeline (Result Mastodon.Error (List Mastodon.Status))
 
 
+type Crud
+    = Add
+    | Remove
+
+
+type alias Draft =
+    { status : String
+    , in_reply_to : Maybe Mastodon.Status
+    , spoiler_text : Maybe String
+    , sensitive : Bool
+    , visibility : String
+    }
+
+
 type alias Model =
     { server : String
     , registration : Maybe Mastodon.AppRegistration
@@ -47,7 +80,7 @@ type alias Model =
     , localTimeline : List Mastodon.Status
     , publicTimeline : List Mastodon.Status
     , notifications : List Mastodon.Notification
-    , draft : Mastodon.StatusRequestBody
+    , draft : Draft
     , account : Maybe Mastodon.Account
     , errors : List String
     , location : Navigation.Location
@@ -65,10 +98,10 @@ extractAuthCode { search } =
             Nothing
 
 
-defaultDraft : Mastodon.StatusRequestBody
+defaultDraft : Draft
 defaultDraft =
     { status = ""
-    , in_reply_to_id = Nothing
+    , in_reply_to = Nothing
     , spoiler_text = Nothing
     , sensitive = False
     , visibility = "public"
@@ -142,6 +175,16 @@ saveRegistration registration =
         |> Ports.saveRegistration
 
 
+loadNotifications : Maybe Mastodon.Client -> Cmd Msg
+loadNotifications client =
+    case client of
+        Just client ->
+            Mastodon.fetchNotifications client |> Mastodon.send Notifications
+
+        Nothing ->
+            Cmd.none
+
+
 loadTimelines : Maybe Mastodon.Client -> Cmd Msg
 loadTimelines client =
     case client of
@@ -150,7 +193,7 @@ loadTimelines client =
                 [ Mastodon.fetchUserTimeline client |> Mastodon.send UserTimeline
                 , Mastodon.fetchLocalTimeline client |> Mastodon.send LocalTimeline
                 , Mastodon.fetchPublicTimeline client |> Mastodon.send PublicTimeline
-                , Mastodon.fetchNotifications client |> Mastodon.send Notifications
+                , loadNotifications <| Just client
                 ]
 
         Nothing ->
@@ -179,11 +222,56 @@ errorText error =
             "Unreachable host."
 
 
-updateDraft : DraftMsg -> Mastodon.StatusRequestBody -> Mastodon.StatusRequestBody
+toStatusRequestBody : Draft -> Mastodon.StatusRequestBody
+toStatusRequestBody draft =
+    { status = draft.status
+    , in_reply_to_id =
+        case draft.in_reply_to of
+            Just status ->
+                Just status.id
+
+            Nothing ->
+                Nothing
+    , spoiler_text = draft.spoiler_text
+    , sensitive = draft.sensitive
+    , visibility = draft.visibility
+    }
+
+
+updateTimelinesWithBoolFlag : Int -> Bool -> (Mastodon.Status -> Mastodon.Status) -> Model -> Model
+updateTimelinesWithBoolFlag statusId flag statusUpdater model =
+    let
+        update flag status =
+            if (Mastodon.extractReblog status).id == statusId then
+                statusUpdater status
+            else
+                status
+    in
+        { model
+            | userTimeline = List.map (update flag) model.userTimeline
+            , localTimeline = List.map (update flag) model.localTimeline
+            , publicTimeline = List.map (update flag) model.publicTimeline
+        }
+
+
+processFavourite : Int -> Bool -> Model -> Model
+processFavourite statusId flag model =
+    updateTimelinesWithBoolFlag statusId flag (\s -> { s | favourited = Just flag }) model
+
+
+processReblog : Int -> Bool -> Model -> Model
+processReblog statusId flag model =
+    updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model
+
+
+updateDraft : DraftMsg -> Draft -> ( Draft, Cmd Msg )
 updateDraft draftMsg draft =
     -- TODO: later we'll probably want to handle more events like when the user
     --       wants to add CW, medias, etc.
     case draftMsg of
+        ClearDraft ->
+            defaultDraft ! []
+
         ToggleSpoiler enabled ->
             { draft
                 | spoiler_text =
@@ -192,23 +280,45 @@ updateDraft draftMsg draft =
                     else
                         Nothing
             }
+                ! []
 
         UpdateSensitive sensitive ->
-            { draft | sensitive = sensitive }
+            { draft | sensitive = sensitive } ! []
 
         UpdateSpoiler spoiler_text ->
-            { draft | spoiler_text = Just spoiler_text }
+            { draft | spoiler_text = Just spoiler_text } ! []
 
         UpdateStatus status ->
-            { draft | status = status }
+            { draft | status = status } ! []
 
         UpdateVisibility visibility ->
-            { draft | visibility = visibility }
+            { draft | visibility = visibility } ! []
+
+        UpdateReplyTo status ->
+            let
+                mention =
+                    "@" ++ status.account.acct
+            in
+                { draft
+                    | in_reply_to = Just status
+                    , status =
+                        if String.startsWith mention draft.status then
+                            draft.status
+                        else
+                            mention ++ " " ++ draft.status
+                }
+                    ! [ Dom.focus "status" |> Task.attempt (always NoOp) ]
+
+        ClearReplyTo ->
+            { draft | in_reply_to = Nothing } ! []
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
+        NoOp ->
+            model ! []
+
         ServerChange server ->
             { model | server = server } ! []
 
@@ -245,14 +355,88 @@ update msg model =
                 Err error ->
                     { model | errors = (errorText error) :: model.errors } ! []
 
+        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.reblog client id |> Mastodon.send Reblogged ]
+
+                Nothing ->
+                    model ! []
+
+        Reblogged result ->
+            case result of
+                Ok status ->
+                    model ! [ loadNotifications model.client ]
+
+                Err error ->
+                    { model | errors = (errorText error) :: model.errors } ! []
+
+        Unreblog id ->
+            case model.client of
+                Just client ->
+                    processReblog id False model ! [ Mastodon.unfavourite client id |> Mastodon.send Unreblogged ]
+
+                Nothing ->
+                    model ! []
+
+        Unreblogged result ->
+            case result of
+                Ok status ->
+                    model ! [ loadNotifications model.client ]
+
+                Err error ->
+                    { model | errors = (errorText error) :: model.errors } ! []
+
+        AddFavorite id ->
+            model
+                ! case model.client of
+                    Just client ->
+                        [ Mastodon.favourite client id |> Mastodon.send FavoriteAdded ]
+
+                    Nothing ->
+                        []
+
+        FavoriteAdded result ->
+            case result of
+                Ok status ->
+                    processFavourite status.id True model ! [ loadNotifications model.client ]
+
+                Err error ->
+                    { model | errors = (errorText error) :: model.errors } ! []
+
+        RemoveFavorite id ->
+            model
+                ! case model.client of
+                    Just client ->
+                        [ Mastodon.unfavourite client id |> Mastodon.send FavoriteRemoved ]
+
+                    Nothing ->
+                        []
+
+        FavoriteRemoved result ->
+            case result of
+                Ok status ->
+                    processFavourite status.id False model ! [ loadNotifications model.client ]
+
+                Err error ->
+                    { model | errors = (errorText error) :: model.errors } ! []
+
         DraftEvent draftMsg ->
-            { model | draft = updateDraft draftMsg model.draft } ! []
+            let
+                ( draft, commands ) =
+                    updateDraft draftMsg model.draft
+            in
+                { model | draft = draft } ! [ commands ]
 
         SubmitDraft ->
             model
                 ! case model.client of
                     Just client ->
-                        [ postStatus client model.draft ]
+                        [ postStatus client <| toStatusRequestBody model.draft ]
 
                     Nothing ->
                         []

src/View.elm

@@ -5,7 +5,7 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Mastodon
-import Model exposing (Model, DraftMsg(..), Msg(..))
+import Model exposing (Model, Draft, DraftMsg(..), Msg(..))
 import ViewHelper
 
 
@@ -34,6 +34,12 @@ errorsListView model =
             div [] <| List.map errorView model.errors
 
 
+justifiedButtonGroup : List (Html Msg) -> Html Msg
+justifiedButtonGroup buttons =
+    div [ class "btn-group btn-group-justified" ] <|
+        List.map (\b -> div [ class "btn-group" ] [ b ]) buttons
+
+
 icon : String -> Html Msg
 icon name =
     i [ class <| "glyphicon glyphicon-" ++ name ] []
@@ -215,6 +221,51 @@ accountTimelineView account statuses label iconName =
         ]
 
 
+statusActionsView : Mastodon.Status -> Html Msg
+statusActionsView status =
+    let
+        target =
+            Mastodon.extractReblog status
+
+        baseBtnClasses =
+            "btn btn-sm btn-default"
+
+        ( reblogClasses, reblogEvent ) =
+            case status.favourited of
+                Just True ->
+                    ( baseBtnClasses ++ " reblogged", Unreblog target.id )
+
+                _ ->
+                    ( baseBtnClasses, AddFavorite target.id )
+
+        ( favClasses, favEvent ) =
+            case status.favourited of
+                Just True ->
+                    ( baseBtnClasses ++ " favourited", RemoveFavorite target.id )
+
+                _ ->
+                    ( baseBtnClasses, AddFavorite target.id )
+    in
+        div [ class "btn-group actions" ]
+            [ a
+                [ class baseBtnClasses
+                , ViewHelper.onClickWithPreventAndStop <|
+                    DraftEvent (UpdateReplyTo target)
+                ]
+                [ icon "share-alt" ]
+            , a
+                [ class reblogClasses
+                , ViewHelper.onClickWithPreventAndStop reblogEvent
+                ]
+                [ icon "fire", text (toString status.reblogs_count) ]
+            , a
+                [ class favClasses
+                , ViewHelper.onClickWithPreventAndStop favEvent
+                ]
+                [ icon "star", text (toString status.favourites_count) ]
+            ]
+
+
 statusEntryView : Mastodon.Status -> Html Msg
 statusEntryView status =
     let
@@ -227,7 +278,9 @@ statusEntryView status =
                     ""
     in
         li [ class <| "list-group-item " ++ nsfwClass ]
-            [ statusView status ]
+            [ statusView status
+            , statusActionsView status
+            ]
 
 
 timelineView : List Mastodon.Status -> String -> String -> Html Msg
@@ -264,6 +317,7 @@ notificationStatusView status { type_, account } =
             _ ->
                 text ""
         , statusView status
+        , statusActionsView status
         ]
 
 
@@ -299,6 +353,29 @@ notificationListView notifications =
         ]
 
 
+draftReplyToView : Draft -> Html Msg
+draftReplyToView draft =
+    case draft.in_reply_to of
+        Just status ->
+            div [ class "in-reply-to" ]
+                [ p []
+                    [ strong []
+                        [ text "In reply to this toot ("
+                        , a
+                            [ href ""
+                            , ViewHelper.onClickWithPreventAndStop <| DraftEvent ClearReplyTo
+                            ]
+                            [ icon "remove" ]
+                        , text ")"
+                        ]
+                    ]
+                , div [ class "well" ] [ statusView status ]
+                ]
+
+        Nothing ->
+            text ""
+
+
 draftView : Model -> Html Msg
 draftView { draft } =
     let
@@ -310,9 +387,17 @@ draftView { draft } =
                 [ text <| visibility ++ ": " ++ description ]
     in
         div [ class "panel panel-default" ]
-            [ div [ class "panel-heading" ] [ icon "envelope", text "Post a message" ]
+            [ div [ class "panel-heading" ]
+                [ icon "envelope"
+                , text <|
+                    if draft.in_reply_to /= Nothing then
+                        "Post a reply"
+                    else
+                        "Post a message"
+                ]
             , div [ class "panel-body" ]
-                [ Html.form [ class "form", onSubmit SubmitDraft ]
+                [ draftReplyToView draft
+                , Html.form [ class "form", onSubmit SubmitDraft ]
                     [ div [ class "form-group checkbox" ]
                         [ label []
                             [ input
@@ -387,8 +472,17 @@ draftView { draft } =
                             , text " This post is NSFW"
                             ]
                         ]
-                    , p [ class "text-right" ]
+                    , justifiedButtonGroup
-                        [ button [ class "btn btn-primary" ]
+                        [ button
+                            [ type_ "button"
+                            , class "btn btn-default"
+                            , onClick (DraftEvent ClearDraft)
+                            ]
+                            [ text "Clear" ]
+                        , button
+                            [ type_ "submit"
+                            , class "btn btn-primary"
+                            ]
                             [ text "Toot!" ]
                         ]
                     ]

src/ViewHelper.elm

@@ -34,7 +34,6 @@ onClickWithPreventAndStop msg =
 formatContent : String -> List Mastodon.Mention -> List (Html Msg)
 formatContent content mentions =
     content
-        |> replace "'" "'"
         |> replace " ?" " ?"
         |> replace " !" " !"
         |> replace " :" " :"