Allow posting messages (#7)

This commit is contained in:
Nicolas Perriault 2017-04-20 20:30:19 +02:00 committed by GitHub
parent 1c8559e4ad
commit aa91182ff6
3 changed files with 220 additions and 20 deletions

View File

@ -9,6 +9,7 @@ module Mastodon
, Mention
, Reblog(..)
, Status
, StatusRequestBody
, Tag
, register
, registrationEncoder
@ -18,6 +19,7 @@ module Mastodon
, fetchPublicTimeline
, fetchLocalTimeline
, fetchUserTimeline
, postStatus
, send
)
@ -100,9 +102,9 @@ type alias Account =
type alias Attachment =
-- type_: -- "image", "video", "gifv"
{ id : Int
, -- Type: "image", "video", "gifv"
type_ : String
, type_ : String
, url : String
, remote_url : String
, preview_url : String
@ -151,6 +153,21 @@ type Reblog
= Reblog Status
type alias StatusRequestBody =
-- status: The text of the status
-- in_reply_to_id: local ID of the status you want to reply to
-- sensitive: set this to mark the media of the status as NSFW
-- spoiler_text: text to be shown as a warning before the actual content
-- visibility: either "direct", "private", "unlisted" or "public"
-- TODO: media_ids: array of media IDs to attach to the status (maximum 4)
{ status : String
, in_reply_to_id : Maybe Int
, spoiler_text : Maybe String
, sensitive : Bool
, visibility : String
}
-- Msg
@ -190,6 +207,17 @@ authorizationCodeEncoder registration authCode =
]
statusRequestBodyEncoder : StatusRequestBody -> Encode.Value
statusRequestBodyEncoder statusData =
Encode.object
[ ( "status", Encode.string statusData.status )
, ( "in_reply_to_id", encodeMaybe Encode.int statusData.in_reply_to_id )
, ( "spoiler_text", encodeMaybe Encode.string statusData.spoiler_text )
, ( "sensitive", Encode.bool statusData.sensitive )
, ( "visibility", Encode.string statusData.visibility )
]
-- Decoders
@ -290,6 +318,16 @@ statusDecoder =
-- Internal helpers
encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value
encodeMaybe encode thing =
case thing of
Nothing ->
Encode.null
Just value ->
encode value
encodeUrl : String -> List ( String, String ) -> String
encodeUrl base params =
List.map (\( k, v ) -> k ++ "=" ++ Http.encodeUri v) params
@ -393,8 +431,7 @@ getAccessToken registration authCode =
send : (Result Error a -> msg) -> HttpBuilder.RequestBuilder a -> Cmd msg
send tagger builder =
builder
|> HttpBuilder.send (toResponse >> tagger)
builder |> HttpBuilder.send (toResponse >> tagger)
fetchUserTimeline : Client -> HttpBuilder.RequestBuilder (List Status)
@ -410,3 +447,11 @@ fetchLocalTimeline client =
fetchPublicTimeline : Client -> HttpBuilder.RequestBuilder (List Status)
fetchPublicTimeline client =
fetchStatusList client "/api/v1/timelines/public"
postStatus : Client -> StatusRequestBody -> HttpBuilder.RequestBuilder Status
postStatus client statusRequestBody =
HttpBuilder.post (client.server ++ "/api/v1/statuses")
|> HttpBuilder.withHeader "Authorization" ("Bearer " ++ client.token)
|> HttpBuilder.withExpect (Http.expectJson statusDecoder)
|> HttpBuilder.withJsonBody (statusRequestBodyEncoder statusRequestBody)

View File

@ -12,13 +12,23 @@ type alias Flags =
}
type DraftMsg
= ToggleSpoiler Bool
| UpdateSensitive Bool
| UpdateSpoiler String
| UpdateStatus String
type Msg
= AccessToken (Result Mastodon.Error Mastodon.AccessTokenResult)
| AppRegistered (Result Mastodon.Error Mastodon.AppRegistration)
| DraftEvent DraftMsg
| LocalTimeline (Result Mastodon.Error (List Mastodon.Status))
| PublicTimeline (Result Mastodon.Error (List Mastodon.Status))
| Register
| ServerChange String
| StatusPosted (Result Mastodon.Error Mastodon.Status)
| SubmitDraft
| UrlChange Navigation.Location
| UserTimeline (Result Mastodon.Error (List Mastodon.Status))
@ -30,6 +40,7 @@ type alias Model =
, userTimeline : List Mastodon.Status
, localTimeline : List Mastodon.Status
, publicTimeline : List Mastodon.Status
, draft : Mastodon.StatusRequestBody
, errors : List String
, location : Navigation.Location
}
@ -45,6 +56,16 @@ extractAuthCode { search } =
Nothing
defaultDraft : Mastodon.StatusRequestBody
defaultDraft =
{ status = ""
, in_reply_to_id = Nothing
, spoiler_text = Nothing
, sensitive = False
, visibility = "public"
}
init : Flags -> Navigation.Location -> ( Model, Cmd Msg )
init flags location =
let
@ -57,6 +78,7 @@ init flags location =
, userTimeline = []
, localTimeline = []
, publicTimeline = []
, draft = defaultDraft
, errors = []
, location = location
}
@ -76,12 +98,7 @@ initCommands registration client authCode =
[]
Nothing ->
case client of
Just client ->
[ loadTimelines client ]
Nothing ->
[]
[ loadTimelines client ]
registerApp : Model -> Cmd Msg
@ -113,13 +130,24 @@ saveRegistration registration =
|> Ports.saveRegistration
loadTimelines : Mastodon.Client -> Cmd Msg
loadTimelines : Maybe Mastodon.Client -> Cmd Msg
loadTimelines client =
Cmd.batch
[ Mastodon.fetchUserTimeline client |> Mastodon.send UserTimeline
, Mastodon.fetchLocalTimeline client |> Mastodon.send LocalTimeline
, Mastodon.fetchPublicTimeline client |> Mastodon.send PublicTimeline
]
case client of
Just client ->
Cmd.batch
[ Mastodon.fetchUserTimeline client |> Mastodon.send UserTimeline
, Mastodon.fetchLocalTimeline client |> Mastodon.send LocalTimeline
, Mastodon.fetchPublicTimeline client |> Mastodon.send PublicTimeline
]
Nothing ->
Cmd.none
postStatus : Mastodon.Client -> Mastodon.StatusRequestBody -> Cmd Msg
postStatus client draft =
Mastodon.postStatus client draft
|> Mastodon.send StatusPosted
errorText : Mastodon.Error -> String
@ -138,6 +166,30 @@ errorText error =
"Unreachable host."
updateDraft : DraftMsg -> Mastodon.StatusRequestBody -> Mastodon.StatusRequestBody
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
ToggleSpoiler enabled ->
{ draft
| spoiler_text =
if enabled then
Just ""
else
Nothing
}
UpdateSensitive sensitive ->
{ draft | sensitive = sensitive }
UpdateSpoiler spoiler_text ->
{ draft | spoiler_text = Just spoiler_text }
UpdateStatus status ->
{ draft | status = status }
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
@ -169,7 +221,7 @@ update msg model =
Mastodon.Client server accessToken
in
{ model | client = Just client }
! [ loadTimelines client
! [ loadTimelines <| Just client
, Navigation.modifyUrl model.location.pathname
, saveClient client
]
@ -177,6 +229,18 @@ update msg model =
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
DraftEvent draftMsg ->
{ model | draft = updateDraft draftMsg model.draft } ! []
SubmitDraft ->
model
! case model.client of
Just client ->
[ postStatus client model.draft ]
Nothing ->
[]
UserTimeline result ->
case result of
Ok userTimeline ->
@ -200,3 +264,6 @@ update msg model =
Err error ->
{ model | publicTimeline = [], errors = (errorText error) :: model.errors } ! []
StatusPosted _ ->
{ model | draft = defaultDraft } ! [ loadTimelines model.client ]

View File

@ -6,7 +6,7 @@ import Html.Events exposing (..)
import HtmlParser
import HtmlParser.Util exposing (toVirtualDom)
import Mastodon
import Model exposing (Model, Msg(..))
import Model exposing (Model, DraftMsg(..), Msg(..))
errorView : String -> Html Msg
@ -49,7 +49,7 @@ statusView status =
timelineView : List Mastodon.Status -> String -> Html Msg
timelineView statuses label =
div [ class "col-sm-4" ]
div [ class "col-sm-3" ]
[ div [ class "panel panel-default" ]
[ div [ class "panel-heading" ] [ text label ]
, ul [ class "list-group" ] <|
@ -63,10 +63,98 @@ timelineView statuses label =
]
draftView : Model -> Html Msg
draftView { draft } =
let
hasSpoiler =
case draft.spoiler_text of
Nothing ->
False
Just _ ->
True
in
div [ class "col-md-3" ]
[ div [ class "panel panel-default" ]
[ div [ class "panel-heading" ] [ text "Post a message" ]
, div [ class "panel-body" ]
[ Html.form [ class "form", onSubmit SubmitDraft ]
[ div [ class "form-group checkbox" ]
[ label []
[ input
[ type_ "checkbox"
, onCheck <| DraftEvent << ToggleSpoiler
, checked hasSpoiler
]
[]
, text " Add a spoiler"
]
]
, if hasSpoiler then
div [ class "form-group" ]
[ label [ for "spoiler" ] [ text "Visible part" ]
, textarea
[ id "spoiler"
, class "form-control"
, rows 5
, placeholder "This text will always be visible."
, onInput <| DraftEvent << UpdateSpoiler
, required True
, value <| Maybe.withDefault "" draft.spoiler_text
]
[]
]
else
text ""
, div [ class "form-group" ]
[ label [ for "status" ]
[ text <|
if hasSpoiler then
"Hidden part"
else
"Status"
]
, textarea
[ id "status"
, class "form-control"
, rows 8
, placeholder <|
if hasSpoiler then
"This text with be hidden by default, as you have enabled a spoiler."
else
"Once upon a time..."
, onInput <| DraftEvent << UpdateStatus
, required True
, value draft.status
]
[]
]
, div [ class "form-group checkbox" ]
[ label []
[ input
[ type_ "checkbox"
, onCheck <| DraftEvent << UpdateSensitive
, checked draft.sensitive
]
[]
, text " NSFW"
]
]
, p [ class "text-right" ]
[ button [ class "btn btn-primary" ]
[ text "Toot!" ]
]
]
]
]
]
homepageView : Model -> Html Msg
homepageView model =
div [ class "row" ]
[ timelineView model.userTimeline "Home timeline"
[ draftView model
, timelineView model.userTimeline "Home timeline"
, timelineView model.localTimeline "Local timeline"
, timelineView model.publicTimeline "Public timeline"
]