diff --git a/src/Mastodon.elm b/src/Mastodon.elm index 01d4574..e25afb4 100644 --- a/src/Mastodon.elm +++ b/src/Mastodon.elm @@ -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) diff --git a/src/Model.elm b/src/Model.elm index 8b28180..46ed545 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -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 ] diff --git a/src/View.elm b/src/View.elm index 9b01134..cfa51a2 100644 --- a/src/View.elm +++ b/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" ]