Allow posting messages (#7)
This commit is contained in:
Nicolas Perriault
GitHub
parent
1c8559e4ad
commit
aa91182ff6
@ -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)
|
||||
|
||||
@ -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 ]
|
||||
|
||||
94
src/View.elm
94
src/View.elm
@ -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"
|
||||
]
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user