859 lines
27 KiB
Elm
859 lines
27 KiB
Elm
module Model exposing (..)
|
|
|
|
import Dom
|
|
import Json.Encode as Encode
|
|
import Navigation
|
|
import Mastodon.Decoder
|
|
import Mastodon.Encoder
|
|
import Mastodon.Helper
|
|
import Mastodon.Http
|
|
import Mastodon.Model
|
|
import Mastodon.WebSocket
|
|
import Ports
|
|
import Task
|
|
import Dom.Scroll
|
|
|
|
|
|
maxBuffer : Int
|
|
maxBuffer =
|
|
-- Max number of entries to keep in columns
|
|
100
|
|
|
|
|
|
type alias Flags =
|
|
{ client : Maybe Mastodon.Model.Client
|
|
, registration : Maybe Mastodon.Model.AppRegistration
|
|
}
|
|
|
|
|
|
type DraftMsg
|
|
= ClearDraft
|
|
| UpdateSensitive Bool
|
|
| UpdateSpoiler String
|
|
| UpdateStatus String
|
|
| UpdateVisibility String
|
|
| UpdateReplyTo Mastodon.Model.Status
|
|
| ToggleSpoiler Bool
|
|
|
|
|
|
type ViewerMsg
|
|
= CloseViewer
|
|
| OpenViewer (List Mastodon.Model.Attachment) Mastodon.Model.Attachment
|
|
|
|
|
|
type MastodonMsg
|
|
= AccessToken (Result Mastodon.Model.Error Mastodon.Model.AccessTokenResult)
|
|
| AppRegistered (Result Mastodon.Model.Error Mastodon.Model.AppRegistration)
|
|
| ContextLoaded Mastodon.Model.Status (Result Mastodon.Model.Error Mastodon.Model.Context)
|
|
| CurrentUser (Result Mastodon.Model.Error Mastodon.Model.Account)
|
|
| FavoriteAdded (Result Mastodon.Model.Error Mastodon.Model.Status)
|
|
| FavoriteRemoved (Result Mastodon.Model.Error Mastodon.Model.Status)
|
|
| LocalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
|
|
| Notifications (Result Mastodon.Model.Error (List Mastodon.Model.Notification))
|
|
| GlobalTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
|
|
| Reblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
|
|
| StatusDeleted (Result Mastodon.Model.Error Int)
|
|
| StatusPosted (Result Mastodon.Model.Error Mastodon.Model.Status)
|
|
| Unreblogged (Result Mastodon.Model.Error Mastodon.Model.Status)
|
|
| Account (Result Mastodon.Model.Error Mastodon.Model.Account)
|
|
| AccountTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
|
|
| UserTimeline (Result Mastodon.Model.Error (List Mastodon.Model.Status))
|
|
|
|
|
|
type WebSocketMsg
|
|
= NewWebsocketUserMessage String
|
|
| NewWebsocketGlobalMessage String
|
|
| NewWebsocketLocalMessage String
|
|
|
|
|
|
type Msg
|
|
= AddFavorite Int
|
|
| ClearOpenedAccount
|
|
| CloseThread
|
|
| DomResult (Result Dom.Error ())
|
|
| DeleteStatus Int
|
|
| DraftEvent DraftMsg
|
|
| LoadAccount Int
|
|
| MastodonEvent MastodonMsg
|
|
| NoOp
|
|
| OpenThread Mastodon.Model.Status
|
|
| Reblog Int
|
|
| Register
|
|
| RemoveFavorite Int
|
|
| ServerChange String
|
|
| SubmitDraft
|
|
| UrlChange Navigation.Location
|
|
| UseGlobalTimeline Bool
|
|
| Unreblog Int
|
|
| ViewerEvent ViewerMsg
|
|
| WebSocketEvent WebSocketMsg
|
|
| ScrollColumn String
|
|
|
|
|
|
type alias Draft =
|
|
{ status : String
|
|
, in_reply_to : Maybe Mastodon.Model.Status
|
|
, spoiler_text : Maybe String
|
|
, sensitive : Bool
|
|
, visibility : String
|
|
}
|
|
|
|
|
|
type alias Thread =
|
|
{ status : Mastodon.Model.Status
|
|
, context : Mastodon.Model.Context
|
|
}
|
|
|
|
|
|
type alias Viewer =
|
|
{ attachments : List Mastodon.Model.Attachment
|
|
, attachment : Mastodon.Model.Attachment
|
|
}
|
|
|
|
|
|
type CurrentView
|
|
= -- Basically, what we should be displaying in the fourth column
|
|
AccountView Mastodon.Model.Account
|
|
| ThreadView Thread
|
|
| LocalTimelineView
|
|
| GlobalTimelineView
|
|
|
|
|
|
type alias Model =
|
|
{ server : String
|
|
, registration : Maybe Mastodon.Model.AppRegistration
|
|
, client : Maybe Mastodon.Model.Client
|
|
, userTimeline : List Mastodon.Model.Status
|
|
, localTimeline : List Mastodon.Model.Status
|
|
, globalTimeline : List Mastodon.Model.Status
|
|
, accountTimeline : List Mastodon.Model.Status
|
|
, notifications : List Mastodon.Model.NotificationAggregate
|
|
, draft : Draft
|
|
, errors : List String
|
|
, location : Navigation.Location
|
|
, useGlobalTimeline : Bool
|
|
, viewer : Maybe Viewer
|
|
, currentUser : Maybe Mastodon.Model.Account
|
|
, currentView : CurrentView
|
|
}
|
|
|
|
|
|
extractAuthCode : Navigation.Location -> Maybe String
|
|
extractAuthCode { search } =
|
|
case (String.split "?code=" search) of
|
|
[ _, authCode ] ->
|
|
Just authCode
|
|
|
|
_ ->
|
|
Nothing
|
|
|
|
|
|
defaultDraft : Draft
|
|
defaultDraft =
|
|
{ status = ""
|
|
, in_reply_to = Nothing
|
|
, spoiler_text = Nothing
|
|
, sensitive = False
|
|
, visibility = "public"
|
|
}
|
|
|
|
|
|
init : Flags -> Navigation.Location -> ( Model, Cmd Msg )
|
|
init flags location =
|
|
let
|
|
authCode =
|
|
extractAuthCode location
|
|
in
|
|
{ server = ""
|
|
, registration = flags.registration
|
|
, client = flags.client
|
|
, userTimeline = []
|
|
, localTimeline = []
|
|
, globalTimeline = []
|
|
, accountTimeline = []
|
|
, notifications = []
|
|
, draft = defaultDraft
|
|
, errors = []
|
|
, location = location
|
|
, useGlobalTimeline = False
|
|
, viewer = Nothing
|
|
, currentView = LocalTimelineView
|
|
, currentUser = Nothing
|
|
}
|
|
! [ initCommands flags.registration flags.client authCode ]
|
|
|
|
|
|
initCommands : Maybe Mastodon.Model.AppRegistration -> Maybe Mastodon.Model.Client -> Maybe String -> Cmd Msg
|
|
initCommands registration client authCode =
|
|
Cmd.batch <|
|
|
case authCode of
|
|
Just authCode ->
|
|
case registration of
|
|
Just registration ->
|
|
[ Mastodon.Http.getAccessToken registration authCode
|
|
|> Mastodon.Http.send (MastodonEvent << AccessToken)
|
|
]
|
|
|
|
Nothing ->
|
|
[]
|
|
|
|
Nothing ->
|
|
[ loadUserAccount client, loadTimelines client ]
|
|
|
|
|
|
registerApp : Model -> Cmd Msg
|
|
registerApp { server, location } =
|
|
let
|
|
appUrl =
|
|
location.origin ++ location.pathname
|
|
|
|
cleanServer =
|
|
if String.endsWith "/" server then
|
|
String.dropRight 1 server
|
|
else
|
|
server
|
|
in
|
|
Mastodon.Http.register
|
|
cleanServer
|
|
"tooty"
|
|
appUrl
|
|
"read write follow"
|
|
"https://github.com/n1k0/tooty"
|
|
|> Mastodon.Http.send (MastodonEvent << AppRegistered)
|
|
|
|
|
|
saveClient : Mastodon.Model.Client -> Cmd Msg
|
|
saveClient client =
|
|
Mastodon.Encoder.clientEncoder client
|
|
|> Encode.encode 0
|
|
|> Ports.saveClient
|
|
|
|
|
|
saveRegistration : Mastodon.Model.AppRegistration -> Cmd Msg
|
|
saveRegistration registration =
|
|
Mastodon.Encoder.registrationEncoder registration
|
|
|> Encode.encode 0
|
|
|> Ports.saveRegistration
|
|
|
|
|
|
loadNotifications : Maybe Mastodon.Model.Client -> Cmd Msg
|
|
loadNotifications client =
|
|
case client of
|
|
Just client ->
|
|
Mastodon.Http.fetchNotifications client
|
|
|> Mastodon.Http.send (MastodonEvent << Notifications)
|
|
|
|
Nothing ->
|
|
Cmd.none
|
|
|
|
|
|
loadUserAccount : Maybe Mastodon.Model.Client -> Cmd Msg
|
|
loadUserAccount client =
|
|
case client of
|
|
Just client ->
|
|
Mastodon.Http.userAccount client
|
|
|> Mastodon.Http.send (MastodonEvent << CurrentUser)
|
|
|
|
Nothing ->
|
|
Cmd.none
|
|
|
|
|
|
loadTimelines : Maybe Mastodon.Model.Client -> Cmd Msg
|
|
loadTimelines client =
|
|
case client of
|
|
Just client ->
|
|
Cmd.batch
|
|
[ Mastodon.Http.fetchUserTimeline client
|
|
|> Mastodon.Http.send (MastodonEvent << UserTimeline)
|
|
, Mastodon.Http.fetchLocalTimeline client
|
|
|> Mastodon.Http.send (MastodonEvent << LocalTimeline)
|
|
, Mastodon.Http.fetchGlobalTimeline client
|
|
|> Mastodon.Http.send (MastodonEvent << GlobalTimeline)
|
|
, loadNotifications <| Just client
|
|
]
|
|
|
|
Nothing ->
|
|
Cmd.none
|
|
|
|
|
|
preferredTimeline : Model -> CurrentView
|
|
preferredTimeline model =
|
|
if model.useGlobalTimeline then
|
|
GlobalTimelineView
|
|
else
|
|
LocalTimelineView
|
|
|
|
|
|
truncate : List a -> List a
|
|
truncate entries =
|
|
List.take maxBuffer entries
|
|
|
|
|
|
postStatus : Mastodon.Model.Client -> Mastodon.Model.StatusRequestBody -> Cmd Msg
|
|
postStatus client draft =
|
|
Mastodon.Http.postStatus client draft
|
|
|> Mastodon.Http.send (MastodonEvent << StatusPosted)
|
|
|
|
|
|
deleteStatus : Mastodon.Model.Client -> Int -> Cmd Msg
|
|
deleteStatus client id =
|
|
Mastodon.Http.deleteStatus client id
|
|
|> Mastodon.Http.send (MastodonEvent << StatusDeleted)
|
|
|
|
|
|
errorText : Mastodon.Model.Error -> String
|
|
errorText error =
|
|
case error of
|
|
Mastodon.Model.MastodonError statusCode statusMsg errorMsg ->
|
|
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
|
|
|
|
Mastodon.Model.ServerError statusCode statusMsg errorMsg ->
|
|
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
|
|
|
|
Mastodon.Model.TimeoutError ->
|
|
"Request timed out."
|
|
|
|
Mastodon.Model.NetworkError ->
|
|
"Unreachable host."
|
|
|
|
|
|
toStatusRequestBody : Draft -> Mastodon.Model.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.Model.Status -> Mastodon.Model.Status) -> Model -> Model
|
|
updateTimelinesWithBoolFlag statusId flag statusUpdater model =
|
|
let
|
|
update flag status =
|
|
if (Mastodon.Helper.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
|
|
, globalTimeline = List.map (update flag) model.globalTimeline
|
|
}
|
|
|
|
|
|
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
|
|
|
|
|
|
deleteStatusFromTimeline : Int -> List Mastodon.Model.Status -> List Mastodon.Model.Status
|
|
deleteStatusFromTimeline statusId timeline =
|
|
timeline
|
|
|> List.filter
|
|
(\s ->
|
|
s.id
|
|
/= statusId
|
|
&& (Mastodon.Helper.extractReblog s).id
|
|
/= statusId
|
|
)
|
|
|
|
|
|
updateDraft : DraftMsg -> Mastodon.Model.Account -> Draft -> ( Draft, Cmd Msg )
|
|
updateDraft draftMsg currentUser draft =
|
|
case draftMsg of
|
|
ClearDraft ->
|
|
defaultDraft ! []
|
|
|
|
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 } ! []
|
|
|
|
UpdateVisibility visibility ->
|
|
{ draft | visibility = visibility } ! []
|
|
|
|
UpdateReplyTo status ->
|
|
{ draft
|
|
| in_reply_to = Just status
|
|
, status = Mastodon.Helper.getReplyPrefix currentUser status
|
|
, sensitive = Maybe.withDefault False status.sensitive
|
|
, spoiler_text =
|
|
if status.spoiler_text == "" then
|
|
Nothing
|
|
else
|
|
Just status.spoiler_text
|
|
, visibility = status.visibility
|
|
}
|
|
! [ Dom.focus "status" |> Task.attempt (always NoOp) ]
|
|
|
|
|
|
updateViewer : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg )
|
|
updateViewer viewerMsg viewer =
|
|
case viewerMsg of
|
|
CloseViewer ->
|
|
Nothing ! []
|
|
|
|
OpenViewer attachments attachment ->
|
|
(Just <| Viewer attachments attachment) ! []
|
|
|
|
|
|
processMastodonEvent : MastodonMsg -> Model -> ( Model, Cmd Msg )
|
|
processMastodonEvent msg model =
|
|
case msg of
|
|
AccessToken result ->
|
|
case result of
|
|
Ok { server, accessToken } ->
|
|
let
|
|
client =
|
|
Mastodon.Model.Client server accessToken
|
|
in
|
|
{ model | client = Just client }
|
|
! [ loadTimelines <| Just client
|
|
, Navigation.modifyUrl model.location.pathname
|
|
, saveClient client
|
|
]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
AppRegistered result ->
|
|
case result of
|
|
Ok registration ->
|
|
{ model | registration = Just registration }
|
|
! [ saveRegistration registration
|
|
, Navigation.load <| Mastodon.Http.getAuthorizationUrl registration
|
|
]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
ContextLoaded status result ->
|
|
case result of
|
|
Ok context ->
|
|
let
|
|
thread =
|
|
Thread status context
|
|
in
|
|
{ model | currentView = ThreadView thread } ! []
|
|
|
|
Err error ->
|
|
{ model
|
|
| currentView = preferredTimeline model
|
|
, errors = (errorText error) :: model.errors
|
|
}
|
|
! []
|
|
|
|
CurrentUser result ->
|
|
case result of
|
|
Ok currentUser ->
|
|
{ model | currentUser = Just currentUser } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
FavoriteAdded result ->
|
|
case result of
|
|
Ok status ->
|
|
processFavourite status.id True model ! [ loadNotifications model.client ]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
FavoriteRemoved result ->
|
|
case result of
|
|
Ok status ->
|
|
processFavourite status.id False model ! [ loadNotifications model.client ]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
LocalTimeline result ->
|
|
case result of
|
|
Ok localTimeline ->
|
|
{ model | localTimeline = localTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | localTimeline = [], errors = (errorText error) :: model.errors } ! []
|
|
|
|
Notifications result ->
|
|
case result of
|
|
Ok notifications ->
|
|
{ model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! []
|
|
|
|
Err error ->
|
|
{ model | notifications = [], errors = (errorText error) :: model.errors } ! []
|
|
|
|
GlobalTimeline result ->
|
|
case result of
|
|
Ok globalTimeline ->
|
|
{ model | globalTimeline = globalTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | globalTimeline = [], errors = (errorText error) :: model.errors } ! []
|
|
|
|
Reblogged result ->
|
|
case result of
|
|
Ok status ->
|
|
model ! [ loadNotifications model.client ]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
StatusPosted _ ->
|
|
{ model | draft = defaultDraft } ! []
|
|
|
|
StatusDeleted result ->
|
|
case result of
|
|
Ok id ->
|
|
{ model
|
|
| userTimeline = deleteStatusFromTimeline id model.userTimeline
|
|
, localTimeline = deleteStatusFromTimeline id model.localTimeline
|
|
, globalTimeline = deleteStatusFromTimeline id model.globalTimeline
|
|
}
|
|
! []
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
Unreblogged result ->
|
|
case result of
|
|
Ok status ->
|
|
model ! [ loadNotifications model.client ]
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
Account result ->
|
|
case result of
|
|
Ok account ->
|
|
{ model | currentView = AccountView account } ! []
|
|
|
|
Err error ->
|
|
{ model
|
|
| currentView = preferredTimeline model
|
|
, errors = (errorText error) :: model.errors
|
|
}
|
|
! []
|
|
|
|
AccountTimeline result ->
|
|
case result of
|
|
Ok statuses ->
|
|
{ model | accountTimeline = statuses } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = (errorText error) :: model.errors } ! []
|
|
|
|
UserTimeline result ->
|
|
case result of
|
|
Ok userTimeline ->
|
|
{ model | userTimeline = userTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | userTimeline = [], errors = (errorText error) :: model.errors } ! []
|
|
|
|
|
|
processWebSocketMsg : WebSocketMsg -> Model -> ( Model, Cmd Msg )
|
|
processWebSocketMsg msg model =
|
|
case msg of
|
|
NewWebsocketUserMessage message ->
|
|
case (Mastodon.Decoder.decodeWebSocketMessage message) of
|
|
Mastodon.WebSocket.ErrorEvent error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusUpdateEvent result ->
|
|
case result of
|
|
Ok status ->
|
|
{ model | userTimeline = truncate (status :: model.userTimeline) } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusDeleteEvent result ->
|
|
case result of
|
|
Ok id ->
|
|
{ model | userTimeline = deleteStatusFromTimeline id model.userTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.NotificationEvent result ->
|
|
case result of
|
|
Ok notification ->
|
|
let
|
|
notifications =
|
|
Mastodon.Helper.addNotificationToAggregates
|
|
notification
|
|
model.notifications
|
|
in
|
|
{ model | notifications = truncate notifications } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
NewWebsocketLocalMessage message ->
|
|
case (Mastodon.Decoder.decodeWebSocketMessage message) of
|
|
Mastodon.WebSocket.ErrorEvent error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusUpdateEvent result ->
|
|
case result of
|
|
Ok status ->
|
|
{ model | localTimeline = truncate (status :: model.localTimeline) } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusDeleteEvent result ->
|
|
case result of
|
|
Ok id ->
|
|
{ model | localTimeline = deleteStatusFromTimeline id model.localTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
_ ->
|
|
model ! []
|
|
|
|
NewWebsocketGlobalMessage message ->
|
|
case (Mastodon.Decoder.decodeWebSocketMessage message) of
|
|
Mastodon.WebSocket.ErrorEvent error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusUpdateEvent result ->
|
|
case result of
|
|
Ok status ->
|
|
{ model | globalTimeline = truncate (status :: model.globalTimeline) } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
Mastodon.WebSocket.StatusDeleteEvent result ->
|
|
case result of
|
|
Ok id ->
|
|
{ model | globalTimeline = deleteStatusFromTimeline id model.globalTimeline } ! []
|
|
|
|
Err error ->
|
|
{ model | errors = error :: model.errors } ! []
|
|
|
|
_ ->
|
|
model ! []
|
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
case msg of
|
|
NoOp ->
|
|
model ! []
|
|
|
|
DomResult result ->
|
|
model ! []
|
|
|
|
MastodonEvent msg ->
|
|
let
|
|
( newModel, commands ) =
|
|
processMastodonEvent msg model
|
|
in
|
|
newModel ! [ commands ]
|
|
|
|
WebSocketEvent msg ->
|
|
let
|
|
( newModel, commands ) =
|
|
processWebSocketMsg msg model
|
|
in
|
|
newModel ! [ commands ]
|
|
|
|
ServerChange server ->
|
|
{ model | server = server } ! []
|
|
|
|
UrlChange location ->
|
|
model ! []
|
|
|
|
Register ->
|
|
model ! [ registerApp model ]
|
|
|
|
OpenThread status ->
|
|
case model.client of
|
|
Just client ->
|
|
model
|
|
! [ Mastodon.Http.context client status.id
|
|
|> Mastodon.Http.send (MastodonEvent << (ContextLoaded status))
|
|
]
|
|
|
|
Nothing ->
|
|
model ! []
|
|
|
|
CloseThread ->
|
|
{ model | currentView = preferredTimeline model } ! []
|
|
|
|
DeleteStatus id ->
|
|
case model.client of
|
|
Just client ->
|
|
model ! [ deleteStatus client id ]
|
|
|
|
Nothing ->
|
|
model ! []
|
|
|
|
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.Http.reblog client id
|
|
|> Mastodon.Http.send (MastodonEvent << Reblogged)
|
|
]
|
|
|
|
Nothing ->
|
|
model ! []
|
|
|
|
Unreblog id ->
|
|
case model.client of
|
|
Just client ->
|
|
processReblog id False model
|
|
! [ Mastodon.Http.unfavourite client id
|
|
|> Mastodon.Http.send (MastodonEvent << Unreblogged)
|
|
]
|
|
|
|
Nothing ->
|
|
model ! []
|
|
|
|
AddFavorite id ->
|
|
model
|
|
! case model.client of
|
|
Just client ->
|
|
[ Mastodon.Http.favourite client id
|
|
|> Mastodon.Http.send (MastodonEvent << FavoriteAdded)
|
|
]
|
|
|
|
Nothing ->
|
|
[]
|
|
|
|
RemoveFavorite id ->
|
|
model
|
|
! case model.client of
|
|
Just client ->
|
|
[ Mastodon.Http.unfavourite client id
|
|
|> Mastodon.Http.send (MastodonEvent << FavoriteRemoved)
|
|
]
|
|
|
|
Nothing ->
|
|
[]
|
|
|
|
DraftEvent draftMsg ->
|
|
case model.currentUser of
|
|
Just user ->
|
|
let
|
|
( draft, commands ) =
|
|
updateDraft draftMsg user model.draft
|
|
in
|
|
{ model | draft = draft } ! [ commands ]
|
|
|
|
Nothing ->
|
|
model ! []
|
|
|
|
ViewerEvent viewerMsg ->
|
|
let
|
|
( viewer, commands ) =
|
|
updateViewer viewerMsg model.viewer
|
|
in
|
|
{ model | viewer = viewer } ! [ commands ]
|
|
|
|
SubmitDraft ->
|
|
model
|
|
! case model.client of
|
|
Just client ->
|
|
[ postStatus client <| toStatusRequestBody model.draft ]
|
|
|
|
Nothing ->
|
|
[]
|
|
|
|
LoadAccount accountId ->
|
|
{-
|
|
@TODO
|
|
When requesting a user profile, we should load a new "page"
|
|
so that the URL in the browser matches the user displayed
|
|
-}
|
|
{ model | currentView = preferredTimeline model }
|
|
! case model.client of
|
|
Just client ->
|
|
[ Mastodon.Http.fetchAccount client accountId
|
|
|> Mastodon.Http.send (MastodonEvent << Account)
|
|
, Mastodon.Http.fetchAccountTimeline client accountId
|
|
|> Mastodon.Http.send (MastodonEvent << AccountTimeline)
|
|
]
|
|
|
|
Nothing ->
|
|
[]
|
|
|
|
UseGlobalTimeline flag ->
|
|
let
|
|
newModel =
|
|
{ model | useGlobalTimeline = flag }
|
|
in
|
|
{ model | currentView = preferredTimeline newModel } ! []
|
|
|
|
ClearOpenedAccount ->
|
|
{ model | currentView = preferredTimeline model } ! []
|
|
|
|
ScrollColumn context ->
|
|
model ! [ Task.attempt DomResult <| Dom.Scroll.toTop context ]
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
case model.client of
|
|
Just client ->
|
|
let
|
|
subs =
|
|
[ Mastodon.WebSocket.subscribeToWebSockets
|
|
client
|
|
Mastodon.WebSocket.UserStream
|
|
NewWebsocketUserMessage
|
|
]
|
|
++ (if model.useGlobalTimeline then
|
|
[ Mastodon.WebSocket.subscribeToWebSockets
|
|
client
|
|
Mastodon.WebSocket.GlobalPublicStream
|
|
NewWebsocketGlobalMessage
|
|
]
|
|
else
|
|
[ Mastodon.WebSocket.subscribeToWebSockets
|
|
client
|
|
Mastodon.WebSocket.LocalPublicStream
|
|
NewWebsocketLocalMessage
|
|
]
|
|
)
|
|
in
|
|
Sub.batch <| List.map (Sub.map WebSocketEvent) subs
|
|
|
|
Nothing ->
|
|
Sub.batch []
|