tooty/src/Model.elm
Nicolas Perriault 5da0c77551
it works™.
2017-04-30 12:15:33 +02:00

686 lines
22 KiB
Elm

module Model exposing (..)
import Command
import Navigation
import Mastodon.Decoder
import Mastodon.Helper
import Mastodon.Model exposing (..)
import Mastodon.WebSocket
import Types exposing (..)
maxBuffer : Int
maxBuffer =
-- Max number of entries to keep in columns
100
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 = []
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
, accountRelationship = Nothing
, notifications = []
, draft = defaultDraft
, errors = []
, location = location
, useGlobalTimeline = False
, viewer = Nothing
, currentView = LocalTimelineView
, currentUser = Nothing
, notificationFilter = NotificationAll
}
! [ Command.initCommands flags.registration flags.client authCode ]
preferredTimeline : Model -> CurrentView
preferredTimeline model =
if model.useGlobalTimeline then
GlobalTimelineView
else
LocalTimelineView
truncate : List a -> List a
truncate entries =
List.take maxBuffer entries
errorText : Error -> String
errorText error =
case error of
MastodonError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
ServerError statusCode statusMsg errorMsg ->
"HTTP " ++ (toString statusCode) ++ " " ++ statusMsg ++ ": " ++ errorMsg
TimeoutError ->
"Request timed out."
NetworkError ->
"Unreachable host."
toStatusRequestBody : Draft -> 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 -> (Status -> 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 =
-- TODO: update notifications too
updateTimelinesWithBoolFlag statusId flag (\s -> { s | favourited = Just flag }) model
processReblog : Int -> Bool -> Model -> Model
processReblog statusId flag model =
-- TODO: update notifications too
updateTimelinesWithBoolFlag statusId flag (\s -> { s | reblogged = Just flag }) model
deleteStatusFromTimeline : Int -> List Status -> List Status
deleteStatusFromTimeline statusId timeline =
timeline
|> List.filter
(\s ->
s.id
/= statusId
&& (Mastodon.Helper.extractReblog s).id
/= statusId
)
{-| Update viewed account relationships as well as the relationship with the
current connected user, both according to the "following" status provided.
-}
processFollowEvent : Relationship -> Bool -> Model -> Model
processFollowEvent relationship flag model =
let
updateRelationship r =
if r.id == relationship.id then
{ r | following = flag }
else
r
accountRelationships =
model.accountRelationships |> List.map updateRelationship
accountRelationship =
case model.accountRelationship of
Just accountRelationship ->
if accountRelationship.id == relationship.id then
Just { relationship | following = flag }
else
model.accountRelationship
Nothing ->
Nothing
in
{ model
| accountRelationships = accountRelationships
, accountRelationship = accountRelationship
}
updateDraft : DraftMsg -> 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
}
! [ Command.focusId "status" ]
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 =
Client server accessToken
in
{ model | client = Just client }
! [ Command.loadTimelines <| Just client
, Navigation.modifyUrl model.location.pathname
, Command.saveClient client
]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowed result ->
case result of
Ok relationship ->
processFollowEvent relationship True model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountUnfollowed result ->
case result of
Ok relationship ->
processFollowEvent relationship False model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AppRegistered result ->
case result of
Ok registration ->
{ model | registration = Just registration }
! [ Command.saveRegistration registration
, Command.navigateToAuthUrl registration
]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
ContextLoaded status result ->
case result of
Ok context ->
{ model | currentView = ThreadView (Thread status context) }
! [ Command.scrollColumnToBottom "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 ->
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
FavoriteRemoved result ->
case result of
Ok status ->
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
LocalTimeline result ->
case result of
Ok localTimeline ->
{ model | localTimeline = localTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Notifications result ->
case result of
Ok notifications ->
{ model | notifications = Mastodon.Helper.aggregateNotifications notifications } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
GlobalTimeline result ->
case result of
Ok globalTimeline ->
{ model | globalTimeline = globalTimeline } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
Reblogged result ->
case result of
Ok status ->
model ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
StatusPosted _ ->
{ model | draft = defaultDraft }
! [ Command.scrollColumnToTop "home" ]
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 ! [ Command.loadNotifications model.client ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountReceived result ->
case result of
Ok account ->
{ model | currentView = AccountView account }
! [ Command.loadAccountTimeline model.client account.id ]
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 } ! []
AccountFollowers result ->
case result of
Ok followers ->
{ model | accountFollowers = followers }
! [ Command.loadRelationships model.client <| List.map .id followers ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountFollowing result ->
case result of
Ok following ->
{ model | accountFollowing = following }
! [ Command.loadRelationships model.client <| List.map .id following ]
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountRelationship result ->
case result of
Ok [ relationship ] ->
{ model | accountRelationship = Just relationship } ! []
Ok _ ->
model ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
AccountRelationships result ->
case result of
Ok relationships ->
{ model | accountRelationships = relationships } ! []
Err error ->
{ model | errors = (errorText error) :: model.errors } ! []
UserTimeline result ->
case result of
Ok userTimeline ->
{ model | userTimeline = userTimeline } ! []
Err error ->
{ model | 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 ! []
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 ! [ Command.registerApp model ]
OpenThread status ->
model ! [ Command.loadThread model.client status ]
CloseThread ->
{ model | currentView = preferredTimeline model } ! []
FollowAccount id ->
model ! [ Command.follow model.client id ]
UnfollowAccount id ->
model ! [ Command.unfollow model.client id ]
DeleteStatus id ->
model ! [ Command.deleteStatus model.client id ]
ReblogStatus id ->
processReblog id True model ! [ Command.reblogStatus model.client id ]
UnreblogStatus id ->
processReblog id False model ! [ Command.unreblogStatus model.client id ]
AddFavorite id ->
processFavourite id True model ! [ Command.favouriteStatus model.client id ]
RemoveFavorite id ->
processFavourite id False model ! [ Command.unfavouriteStatus model.client id ]
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 ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ]
LoadAccount accountId ->
{ model
| accountTimeline = []
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
, accountRelationship = Nothing
}
! [ Command.loadAccount model.client accountId ]
ViewAccountFollowers account ->
{ model | currentView = AccountFollowersView account model.accountFollowers }
! [ Command.loadAccountFollowers model.client account.id ]
ViewAccountFollowing account ->
{ model | currentView = AccountFollowingView account model.accountFollowing }
! [ Command.loadAccountFollowing model.client account.id ]
ViewAccountStatuses account ->
{ model | currentView = AccountView account } ! []
UseGlobalTimeline flag ->
let
newModel =
{ model | useGlobalTimeline = flag }
in
{ model | currentView = preferredTimeline newModel } ! []
CloseAccount ->
{ model
| currentView = preferredTimeline model
, accountTimeline = []
, accountFollowing = []
, accountFollowers = []
}
! []
FilterNotifications filter ->
{ model | notificationFilter = filter } ! []
ScrollColumn ScrollTop column ->
model ! [ Command.scrollColumnToTop column ]
ScrollColumn ScrollBottom column ->
model ! [ Command.scrollColumnToBottom column ]
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 []