Closes #132: Split model update functions to their own modules. (#147)

This commit is contained in:
Nicolas Perriault 2017-05-07 14:31:51 +02:00 committed by GitHub
parent 6746b21725
commit 8832b3156f
16 changed files with 1217 additions and 1140 deletions

View File

@ -54,6 +54,9 @@ body {
overflow-y: scroll;
}
li.load-more {
cursor: wait;
}
.notifications-panel .timeline {
max-height: calc(100vh - 100px);

35
src/Init.elm Normal file
View File

@ -0,0 +1,35 @@
module Init exposing (init)
import Command
import Navigation
import Types exposing (..)
import Update.Draft
import Update.Timeline
import Util
init : Flags -> Navigation.Location -> ( Model, Cmd Msg )
init { registration, client } location =
{ server = ""
, currentTime = 0
, registration = registration
, client = client
, homeTimeline = Update.Timeline.empty "home-timeline"
, localTimeline = Update.Timeline.empty "local-timeline"
, globalTimeline = Update.Timeline.empty "global-timeline"
, accountTimeline = Update.Timeline.empty "account-timeline"
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
, accountRelationship = Nothing
, notifications = Update.Timeline.empty "notifications"
, draft = Update.Draft.empty
, errors = []
, location = location
, useGlobalTimeline = False
, viewer = Nothing
, currentView = LocalTimelineView
, currentUser = Nothing
, notificationFilter = NotificationAll
}
! [ Command.initCommands registration client (Util.extractAuthCode location) ]

View File

@ -2,8 +2,10 @@ module Main exposing (main)
import Navigation
import View.App exposing (view)
import Model exposing (..)
import Init exposing (init)
import Subscription exposing (subscriptions)
import Types exposing (..)
import Update.Main exposing (update)
main : Program Flags Model Msg

View File

@ -6,6 +6,7 @@ module Mastodon.Helper
, getReplyPrefix
, notificationToAggregate
, sameAccount
, statusReferenced
)
import List.Extra exposing (groupWhile, uniqueBy)
@ -170,3 +171,8 @@ sameAccount : Mastodon.Model.Account -> Mastodon.Model.Account -> Bool
sameAccount { id, acct, username } account =
-- Note: different instances can share the same id for different accounts.
id == account.id && acct == account.acct && username == account.username
statusReferenced : Int -> Status -> Bool
statusReferenced id status =
status.id == id || (extractReblog status).id == id

File diff suppressed because it is too large Load Diff

42
src/Subscription.elm Normal file
View File

@ -0,0 +1,42 @@
module Subscription exposing (subscriptions)
import Autocomplete
import Mastodon.WebSocket
import Time
import Types exposing (..)
subscriptions : Model -> Sub Msg
subscriptions { client, currentView } =
let
timeSub =
Time.every Time.millisecond Tick
userWsSub =
Mastodon.WebSocket.subscribeToWebSockets
client
Mastodon.WebSocket.UserStream
NewWebsocketUserMessage
|> Sub.map WebSocketEvent
otherWsSub =
if currentView == GlobalTimelineView then
Mastodon.WebSocket.subscribeToWebSockets
client
Mastodon.WebSocket.GlobalPublicStream
NewWebsocketGlobalMessage
|> Sub.map WebSocketEvent
else if currentView == LocalTimelineView then
Mastodon.WebSocket.subscribeToWebSockets
client
Mastodon.WebSocket.LocalPublicStream
NewWebsocketLocalMessage
|> Sub.map WebSocketEvent
else
Sub.none
autoCompleteSub =
Sub.map (DraftEvent << SetAutoState) Autocomplete.subscription
in
[ timeSub, userWsSub, otherWsSub, autoCompleteSub ]
|> Sub.batch

271
src/Update/Draft.elm Normal file
View File

@ -0,0 +1,271 @@
module Update.Draft
exposing
( empty
, showAutoMenu
, update
)
import Autocomplete
import Command
import Mastodon.Helper
import Mastodon.Model exposing (..)
import String.Extra
import Types exposing (..)
import Util
autocompleteUpdateConfig : Autocomplete.UpdateConfig Msg Account
autocompleteUpdateConfig =
Autocomplete.updateConfig
{ toId = .id >> toString
, onKeyDown =
\code maybeId ->
if code == 38 || code == 40 then
Nothing
else if code == 13 then
Maybe.map (DraftEvent << SelectAccount) maybeId
else
Just <| (DraftEvent << ResetAutocomplete) False
, onTooLow = Just <| (DraftEvent << ResetAutocomplete) True
, onTooHigh = Just <| (DraftEvent << ResetAutocomplete) False
, onMouseEnter = \_ -> Nothing
, onMouseLeave = \_ -> Nothing
, onMouseClick = \id -> Just <| (DraftEvent << SelectAccount) id
, separateSelections = False
}
empty : Draft
empty =
{ status = ""
, inReplyTo = Nothing
, spoilerText = Nothing
, sensitive = False
, visibility = "public"
, statusLength = 0
, autoState = Autocomplete.empty
, autoAtPosition = Nothing
, autoQuery = ""
, autoCursorPosition = 0
, autoMaxResults = 4
, autoAccounts = []
, showAutoMenu = False
}
showAutoMenu : List Account -> Maybe Int -> String -> Bool
showAutoMenu accounts atPosition query =
case ( List.isEmpty accounts, atPosition, query ) of
( _, Nothing, _ ) ->
False
( True, _, _ ) ->
False
( _, _, "" ) ->
False
( False, Just _, _ ) ->
True
update : DraftMsg -> Account -> Model -> ( Model, Cmd Msg )
update draftMsg currentUser model =
let
draft =
model.draft
in
case draftMsg of
ClearDraft ->
{ model | draft = empty }
! [ Command.updateDomStatus empty.status ]
ToggleSpoiler enabled ->
let
newDraft =
{ draft
| spoilerText =
if enabled then
Just ""
else
Nothing
}
in
{ model | draft = newDraft } ! []
UpdateSensitive sensitive ->
{ model | draft = { draft | sensitive = sensitive } } ! []
UpdateSpoiler spoilerText ->
{ model | draft = { draft | spoilerText = Just spoilerText } } ! []
UpdateVisibility visibility ->
{ model | draft = { draft | visibility = visibility } } ! []
UpdateReplyTo status ->
let
newStatus =
Mastodon.Helper.getReplyPrefix currentUser status
in
{ model
| draft =
{ draft
| inReplyTo = Just status
, status = newStatus
, sensitive = Maybe.withDefault False status.sensitive
, spoilerText =
if status.spoiler_text == "" then
Nothing
else
Just status.spoiler_text
, visibility = status.visibility
}
}
! [ Command.focusId "status"
, Command.updateDomStatus newStatus
]
UpdateInputInformation { status, selectionStart } ->
let
stringToPos =
String.slice 0 selectionStart status
atPosition =
case (String.right 1 stringToPos) of
"@" ->
Just selectionStart
" " ->
Nothing
_ ->
model.draft.autoAtPosition
query =
case atPosition of
Just position ->
String.slice position (String.length stringToPos) stringToPos
Nothing ->
""
newDraft =
{ draft
| status = status
, statusLength = String.length status
, autoCursorPosition = selectionStart
, autoAtPosition = atPosition
, autoQuery = query
, showAutoMenu =
showAutoMenu
draft.autoAccounts
draft.autoAtPosition
draft.autoQuery
}
in
{ model | draft = newDraft }
! if query /= "" && atPosition /= Nothing then
[ Command.searchAccounts model.client query model.draft.autoMaxResults False ]
else
[]
SelectAccount id ->
let
account =
List.filter (\account -> toString account.id == id) draft.autoAccounts
|> List.head
stringToAtPos =
case draft.autoAtPosition of
Just atPosition ->
String.slice 0 atPosition draft.status
_ ->
""
stringToPos =
String.slice 0 draft.autoCursorPosition draft.status
newStatus =
case draft.autoAtPosition of
Just atPosition ->
String.Extra.replaceSlice
(case account of
Just a ->
a.acct ++ " "
Nothing ->
""
)
atPosition
((String.length draft.autoQuery) + atPosition)
draft.status
_ ->
""
newDraft =
{ draft
| status = newStatus
, autoAtPosition = Nothing
, autoQuery = ""
, autoState = Autocomplete.empty
, autoAccounts = []
, showAutoMenu = False
}
in
{ model | draft = newDraft }
-- As we are using defaultValue, we need to update the textarea
-- using a port.
! [ Command.updateDomStatus newStatus ]
SetAutoState autoMsg ->
let
( newState, maybeMsg ) =
Autocomplete.update
autocompleteUpdateConfig
autoMsg
draft.autoMaxResults
draft.autoState
(Util.acceptableAccounts draft.autoQuery draft.autoAccounts)
newModel =
{ model | draft = { draft | autoState = newState } }
in
case maybeMsg of
Just (DraftEvent updateMsg) ->
update updateMsg currentUser newModel
_ ->
newModel ! []
CloseAutocomplete ->
let
newDraft =
{ draft
| showAutoMenu = False
, autoState = Autocomplete.reset autocompleteUpdateConfig draft.autoState
}
in
{ model | draft = newDraft } ! []
ResetAutocomplete toTop ->
let
newDraft =
{ draft
| autoState =
if toTop then
Autocomplete.resetToFirstItem
autocompleteUpdateConfig
(Util.acceptableAccounts draft.autoQuery draft.autoAccounts)
draft.autoMaxResults
draft.autoState
else
Autocomplete.resetToLastItem
autocompleteUpdateConfig
(Util.acceptableAccounts draft.autoQuery draft.autoAccounts)
draft.autoMaxResults
draft.autoState
}
in
{ model | draft = newDraft } ! []

12
src/Update/Error.elm Normal file
View File

@ -0,0 +1,12 @@
module Update.Error exposing (addErrorNotification)
import Types exposing (..)
addErrorNotification : String -> Model -> List ErrorNotification
addErrorNotification message model =
let
error =
{ message = message, time = model.currentTime }
in
error :: model.errors

166
src/Update/Main.elm Normal file
View File

@ -0,0 +1,166 @@
module Update.Main exposing (update)
import Command
import List.Extra exposing (removeAt)
import Mastodon.Model exposing (..)
import Types exposing (..)
import Update.Draft
import Update.Mastodon
import Update.Timeline
import Update.Viewer
import Update.WebSocket
toStatusRequestBody : Draft -> StatusRequestBody
toStatusRequestBody draft =
{ status = draft.status
, in_reply_to_id =
case draft.inReplyTo of
Just status ->
Just status.id
Nothing ->
Nothing
, spoiler_text = draft.spoilerText
, sensitive = draft.sensitive
, visibility = draft.visibility
}
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NoOp ->
model ! []
Tick newTime ->
{ model
| currentTime = newTime
, errors = List.filter (\{ time } -> model.currentTime - time <= 10000) model.errors
}
! []
ClearError index ->
{ model | errors = removeAt index model.errors } ! []
MastodonEvent msg ->
let
( newModel, commands ) =
Update.Mastodon.update msg model
in
newModel ! [ commands ]
WebSocketEvent msg ->
let
( newModel, commands ) =
Update.WebSocket.update 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 = Update.Timeline.preferred 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 ->
Update.Timeline.processReblog id True model
! [ Command.reblogStatus model.client id ]
UnreblogStatus id ->
Update.Timeline.processReblog id False model
! [ Command.unreblogStatus model.client id ]
AddFavorite id ->
Update.Timeline.processFavourite id True model
! [ Command.favouriteStatus model.client id ]
RemoveFavorite id ->
Update.Timeline.processFavourite id False model
! [ Command.unfavouriteStatus model.client id ]
DraftEvent draftMsg ->
case model.currentUser of
Just user ->
Update.Draft.update draftMsg user model
Nothing ->
model ! []
ViewerEvent viewerMsg ->
let
( viewer, commands ) =
Update.Viewer.update viewerMsg model.viewer
in
{ model | viewer = viewer } ! [ commands ]
SubmitDraft ->
model ! [ Command.postStatus model.client <| toStatusRequestBody model.draft ]
LoadAccount accountId ->
{ model
| accountTimeline = Update.Timeline.empty "account-timeline"
, accountFollowers = []
, accountFollowing = []
, accountRelationships = []
, accountRelationship = Nothing
}
! [ Command.loadAccount model.client accountId ]
TimelineLoadNext id next ->
Update.Timeline.markAsLoading True id model
! [ Command.loadNextTimeline model.client model.currentView id next ]
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
{ newModel | currentView = Update.Timeline.preferred newModel } ! []
CloseAccount ->
{ model
| currentView = Update.Timeline.preferred model
, accountTimeline = Update.Timeline.empty "account-timeline"
, accountFollowing = []
, accountFollowers = []
}
! []
FilterNotifications filter ->
{ model | notificationFilter = filter } ! []
ScrollColumn ScrollTop column ->
model ! [ Command.scrollColumnToTop column ]
ScrollColumn ScrollBottom column ->
model ! [ Command.scrollColumnToBottom column ]

308
src/Update/Mastodon.elm Normal file
View File

@ -0,0 +1,308 @@
module Update.Mastodon exposing (update)
import Command
import Navigation
import Mastodon.Helper
import Mastodon.Model exposing (..)
import Task
import Types exposing (..)
import Update.Draft
import Update.Error exposing (..)
import Update.Timeline
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."
update : MastodonMsg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
AccessToken result ->
case result of
Ok { decoded } ->
let
client =
Client decoded.server decoded.accessToken
in
{ model | client = Just client }
! [ Command.loadTimelines <| Just client
, Command.saveClient client
, Navigation.modifyUrl model.location.pathname
, Navigation.reload
]
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountFollowed result ->
case result of
Ok { decoded } ->
processFollowEvent decoded True model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountUnfollowed result ->
case result of
Ok { decoded } ->
processFollowEvent decoded False model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AppRegistered result ->
case result of
Ok { decoded } ->
{ model | registration = Just decoded }
! [ Command.saveRegistration decoded
, Command.navigateToAuthUrl decoded
]
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
ContextLoaded status result ->
case result of
Ok { decoded } ->
{ model | currentView = ThreadView (Thread status decoded) }
! [ Command.scrollToThreadStatus <| toString status.id ]
Err error ->
{ model
| currentView = Update.Timeline.preferred model
, errors = addErrorNotification (errorText error) model
}
! []
CurrentUser result ->
case result of
Ok { decoded } ->
{ model | currentUser = Just decoded } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
FavoriteAdded result ->
case result of
Ok _ ->
model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
FavoriteRemoved result ->
case result of
Ok _ ->
model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
LocalTimeline append result ->
case result of
Ok { decoded, links } ->
{ model | localTimeline = Update.Timeline.update append decoded links model.localTimeline } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
Notifications append result ->
case result of
Ok { decoded, links } ->
let
aggregated =
Mastodon.Helper.aggregateNotifications decoded
in
{ model | notifications = Update.Timeline.update append aggregated links model.notifications } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
GlobalTimeline append result ->
case result of
Ok { decoded, links } ->
{ model | globalTimeline = Update.Timeline.update append decoded links model.globalTimeline } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
Reblogged result ->
case result of
Ok _ ->
model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
StatusPosted _ ->
-- FIXME: here we should rather send a ClearDraft command, and update the
-- ClearDraft message handler to update DOM status
let
draft =
Update.Draft.empty
in
{ model | draft = draft }
! [ Command.scrollColumnToTop "home-timeline"
, Command.updateDomStatus draft.status
]
StatusDeleted result ->
case result of
Ok { decoded } ->
Update.Timeline.deleteStatusFromAllTimelines decoded model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
Unreblogged result ->
case result of
Ok _ ->
model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountReceived result ->
case result of
Ok { decoded } ->
{ model | currentView = AccountView decoded }
! [ Command.loadAccountTimeline model.client decoded.id model.accountTimeline.links.next ]
Err error ->
{ model
| currentView = Update.Timeline.preferred model
, errors = addErrorNotification (errorText error) model
}
! []
AccountTimeline append result ->
case result of
Ok { decoded, links } ->
{ model | accountTimeline = Update.Timeline.update append decoded links model.accountTimeline } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountFollowers result ->
case result of
Ok { decoded } ->
-- TODO: store next link
{ model | accountFollowers = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountFollowing result ->
case result of
Ok { decoded } ->
-- TODO: store next link
{ model | accountFollowing = decoded }
! [ Command.loadRelationships model.client <| List.map .id decoded ]
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountRelationship result ->
case result of
Ok { decoded } ->
case decoded of
[ relationship ] ->
{ model | accountRelationship = Just relationship } ! []
_ ->
model ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AccountRelationships result ->
case result of
Ok { decoded } ->
-- TODO: store next link
{ model | accountRelationships = decoded } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
HomeTimeline append result ->
case result of
Ok { decoded, links } ->
{ model | homeTimeline = Update.Timeline.update append decoded links model.homeTimeline } ! []
Err error ->
{ model | errors = addErrorNotification (errorText error) model } ! []
AutoSearch result ->
let
draft =
model.draft
in
case result of
Ok { decoded } ->
{ model
| draft =
{ draft
| showAutoMenu =
Update.Draft.showAutoMenu
decoded
draft.autoAtPosition
draft.autoQuery
, autoAccounts = decoded
}
}
-- Force selection of the first item after each
-- Successfull request
! [ Task.perform identity (Task.succeed ((DraftEvent << ResetAutocomplete) True)) ]
Err error ->
{ model
| draft = { draft | showAutoMenu = False }
, errors = addErrorNotification (errorText error) model
}
! []
{-| 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
}

225
src/Update/Timeline.elm Normal file
View File

@ -0,0 +1,225 @@
module Update.Timeline
exposing
( deleteStatusFromAllTimelines
, deleteStatus
, empty
, markAsLoading
, preferred
, prepend
, processReblog
, processFavourite
, update
, updateWithBoolFlag
)
import Mastodon.Helper
import Mastodon.Http exposing (Links)
import Mastodon.Model exposing (..)
import Types exposing (..)
deleteStatusFromCurrentView : Int -> Model -> CurrentView
deleteStatusFromCurrentView id model =
-- Note: account timeline is already cleaned in deleteStatusFromAllTimelines
case model.currentView of
ThreadView thread ->
if thread.status.id == id then
-- the current thread status as been deleted, close it
preferred model
else
let
update statuses =
List.filter (\s -> s.id /= id) statuses
in
ThreadView
{ thread
| context =
{ ancestors = update thread.context.ancestors
, descendants = update thread.context.descendants
}
}
currentView ->
currentView
deleteStatusFromAllTimelines : Int -> Model -> Model
deleteStatusFromAllTimelines id model =
{ model
| homeTimeline = deleteStatus id model.homeTimeline
, localTimeline = deleteStatus id model.localTimeline
, globalTimeline = deleteStatus id model.globalTimeline
, accountTimeline = deleteStatus id model.accountTimeline
, notifications = deleteStatusFromNotifications id model.notifications
, currentView = deleteStatusFromCurrentView id model
}
deleteStatusFromNotifications : Int -> Timeline NotificationAggregate -> Timeline NotificationAggregate
deleteStatusFromNotifications statusId notifications =
let
update notification =
case notification.status of
Just status ->
not <| Mastodon.Helper.statusReferenced statusId status
Nothing ->
True
in
{ notifications | entries = List.filter update notifications.entries }
deleteStatus : Int -> Timeline Status -> Timeline Status
deleteStatus statusId ({ entries } as timeline) =
{ timeline
| entries = List.filter (not << Mastodon.Helper.statusReferenced statusId) entries
}
empty : String -> Timeline a
empty id =
{ id = id
, entries = []
, links = Links Nothing Nothing
, loading = False
}
markAsLoading : Bool -> String -> Model -> Model
markAsLoading loading id model =
let
mark timeline =
{ timeline | loading = loading }
in
case id of
"notifications" ->
{ model | notifications = mark model.notifications }
"home-timeline" ->
{ model | homeTimeline = mark model.homeTimeline }
"local-timeline" ->
{ model | localTimeline = mark model.localTimeline }
"global-timeline" ->
{ model | globalTimeline = mark model.globalTimeline }
"account-timeline" ->
case model.currentView of
AccountView account ->
{ model | accountTimeline = mark model.accountTimeline }
_ ->
model
_ ->
model
preferred : Model -> CurrentView
preferred model =
if model.useGlobalTimeline then
GlobalTimelineView
else
LocalTimelineView
prepend : a -> Timeline a -> Timeline a
prepend entry timeline =
{ timeline | entries = entry :: timeline.entries }
processFavourite : Int -> Bool -> Model -> Model
processFavourite statusId flag model =
updateWithBoolFlag statusId
flag
(\s ->
{ s
| favourited = Just flag
, favourites_count =
if flag then
s.favourites_count + 1
else if s.favourites_count > 0 then
s.favourites_count - 1
else
0
}
)
model
processReblog : Int -> Bool -> Model -> Model
processReblog statusId flag model =
updateWithBoolFlag statusId
flag
(\s ->
{ s
| reblogged = Just flag
, reblogs_count =
if flag then
s.reblogs_count + 1
else if s.reblogs_count > 0 then
s.reblogs_count - 1
else
0
}
)
model
update : Bool -> List a -> Links -> Timeline a -> Timeline a
update append entries links timeline =
let
newEntries =
if append then
List.concat [ timeline.entries, entries ]
else
entries
in
{ timeline
| entries = newEntries
, links = links
, loading = False
}
updateWithBoolFlag : Int -> Bool -> (Status -> Status) -> Model -> Model
updateWithBoolFlag statusId flag statusUpdater model =
let
updateStatus status =
if (Mastodon.Helper.extractReblog status).id == statusId then
statusUpdater status
else
status
updateNotification notification =
case notification.status of
Just status ->
{ notification | status = Just <| updateStatus status }
Nothing ->
notification
updateTimeline updateEntry timeline =
{ timeline | entries = List.map updateEntry timeline.entries }
in
{ model
| homeTimeline = updateTimeline updateStatus model.homeTimeline
, accountTimeline = updateTimeline updateStatus model.accountTimeline
, localTimeline = updateTimeline updateStatus model.localTimeline
, globalTimeline = updateTimeline updateStatus model.globalTimeline
, notifications = updateTimeline updateNotification model.notifications
, currentView =
case model.currentView of
ThreadView thread ->
ThreadView
{ status = updateStatus thread.status
, context =
{ ancestors = List.map updateStatus thread.context.ancestors
, descendants = List.map updateStatus thread.context.descendants
}
}
currentView ->
currentView
}

13
src/Update/Viewer.elm Normal file
View File

@ -0,0 +1,13 @@
module Update.Viewer exposing (update)
import Types exposing (..)
update : ViewerMsg -> Maybe Viewer -> ( Maybe Viewer, Cmd Msg )
update viewerMsg viewer =
case viewerMsg of
CloseViewer ->
Nothing ! []
OpenViewer attachments attachment ->
(Just <| Viewer attachments attachment) ! []

101
src/Update/WebSocket.elm Normal file
View File

@ -0,0 +1,101 @@
module Update.WebSocket exposing (update)
import Mastodon.Decoder
import Mastodon.Helper
import Mastodon.WebSocket
import Types exposing (..)
import Update.Error exposing (..)
import Update.Timeline
update : WebSocketMsg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NewWebsocketUserMessage message ->
case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | homeTimeline = Update.Timeline.prepend status model.homeTimeline } ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusDeleteEvent result ->
case result of
Ok id ->
Update.Timeline.deleteStatusFromAllTimelines id model ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.NotificationEvent result ->
case result of
Ok notification ->
let
oldNotifications =
model.notifications
newNotifications =
{ oldNotifications
| entries =
Mastodon.Helper.addNotificationToAggregates
notification
oldNotifications.entries
}
in
{ model | notifications = newNotifications } ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
NewWebsocketLocalMessage message ->
case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | localTimeline = Update.Timeline.prepend status model.localTimeline } ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusDeleteEvent result ->
case result of
Ok id ->
Update.Timeline.deleteStatusFromAllTimelines id model ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
_ ->
model ! []
NewWebsocketGlobalMessage message ->
case (Mastodon.Decoder.decodeWebSocketMessage message) of
Mastodon.WebSocket.ErrorEvent error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusUpdateEvent result ->
case result of
Ok status ->
{ model | globalTimeline = Update.Timeline.prepend status model.globalTimeline } ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
Mastodon.WebSocket.StatusDeleteEvent result ->
case result of
Ok id ->
Update.Timeline.deleteStatusFromAllTimelines id model ! []
Err error ->
{ model | errors = addErrorNotification error model } ! []
_ ->
model ! []

30
src/Util.elm Normal file
View File

@ -0,0 +1,30 @@
module Util
exposing
( acceptableAccounts
, extractAuthCode
)
import Mastodon.Model exposing (..)
import Navigation
acceptableAccounts : String -> List Account -> List Account
acceptableAccounts query accounts =
let
lowerQuery =
String.toLower query
in
if query == "" then
[]
else
List.filter (String.contains lowerQuery << String.toLower << .username) accounts
extractAuthCode : Navigation.Location -> Maybe String
extractAuthCode { search } =
case (String.split "?code=" search) of
[ _, authCode ] ->
Just authCode
_ ->
Nothing

View File

@ -85,7 +85,6 @@ justifiedButtonGroup cls buttons =
loadMoreBtn : { timeline | id : String, links : Links, loading : Bool } -> Html Msg
loadMoreBtn { id, links, loading } =
if loading then
-- TODO: proper spinner
li [ class "list-group-item load-more text-center" ]
[ text "Loading..." ]
else

View File

@ -8,8 +8,8 @@ import Html.Lazy as Lazy
import Json.Encode as Encode
import Json.Decode as Decode
import Mastodon.Model exposing (..)
import Model
import Types exposing (..)
import Util
import View.Common as Common
import View.Events exposing (..)
import View.Formatter exposing (formatContent)
@ -36,7 +36,7 @@ viewAutocompleteMenu draft =
(Autocomplete.view viewConfig
draft.autoMaxResults
draft.autoState
(Model.acceptableAccounts draft.autoQuery draft.autoAccounts)
(Util.acceptableAccounts draft.autoQuery draft.autoAccounts)
)
]