From 225a95a63714e4a2ae446cd79eaf9195a27b546c Mon Sep 17 00:00:00 2001 From: Nicolas Perriault Date: Sun, 23 Apr 2017 10:18:47 +0200 Subject: [PATCH] WiP: Add status action buttons. (#32) * Add status action buttons. * Handle favorite actions. * Handle reblog actions. * Optimistic updates for reblogs. --- README.md | 6 +- elm-package.json | 1 + package.json | 3 +- public/style.css | 44 +++++++++- src/Mastodon.elm | 43 ++++++++++ src/Model.elm | 210 ++++++++++++++++++++++++++++++++++++++++++--- src/View.elm | 106 +++++++++++++++++++++-- src/ViewHelper.elm | 1 - 8 files changed, 391 insertions(+), 23 deletions(-) diff --git a/README.md b/README.md index 573d540..bbbeda6 100644 --- a/README.md +++ b/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 diff --git a/elm-package.json b/elm-package.json index 40e3079..fbe5a43 100644 --- a/elm-package.json +++ b/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", diff --git a/package.json b/package.json index 2f5bcf0..f98a3f3 100644 --- a/package.json +++ b/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": { diff --git a/public/style.css b/public/style.css index 0b8b29c..5e4be4f 100644 --- a/public/style.css +++ b/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 { diff --git a/src/Mastodon.elm b/src/Mastodon.elm index 8a66fcb..7a8f686 100644 --- a/src/Mastodon.elm +++ b/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) diff --git a/src/Model.elm b/src/Model.elm index 94b79c1..332594b 100644 --- a/src/Model.elm +++ b/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 -> [] diff --git a/src/View.elm b/src/View.elm index d560a0c..ef4701e 100644 --- a/src/View.elm +++ b/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" ] - [ button [ class "btn btn-primary" ] + , justifiedButtonGroup + [ button + [ type_ "button" + , class "btn btn-default" + , onClick (DraftEvent ClearDraft) + ] + [ text "Clear" ] + , button + [ type_ "submit" + , class "btn btn-primary" + ] [ text "Toot!" ] ] ] diff --git a/src/ViewHelper.elm b/src/ViewHelper.elm index 525f50e..2219a29 100644 --- a/src/ViewHelper.elm +++ b/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 " :" " :"