diff --git a/src/Scylla/Sync.elm b/src/Scylla/Sync.elm index 064a7f4..cc3227b 100644 --- a/src/Scylla/Sync.elm +++ b/src/Scylla/Sync.elm @@ -58,125 +58,6 @@ findFirstEvent = findFirstBy .originServerTs findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int } findLastEvent = findLastBy .originServerTs --- Business Logic: Merging -mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a -mergeMaybe f l r = case (l, r) of - (Just v1, Just v2) -> Just <| f v1 v2 - (Just v, Nothing) -> l - (Nothing, Just v) -> r - _ -> Nothing - -mergeEvents : List Event -> List Event -> List Event -mergeEvents l1 l2 = l1 ++ l2 - -mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent -mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2 - -mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent -mergeRoomEvents l1 l2 = uniqueBy getEventId <| l1 ++ l2 - -mergeStrippedStates : List StrippedStateEvent -> List StrippedStateEvent -> List StrippedStateEvent -mergeStrippedStates l1 l2 = l1 ++ l2 - -mergeAccountData : AccountData -> AccountData -> AccountData -mergeAccountData a1 a2 = AccountData <| mergeMaybe mergeEvents a1.events a2.events - -mergePresence : Presence -> Presence -> Presence -mergePresence p1 p2 = Presence <| mergeMaybe mergeEvents p1.events p2.events - -mergeDicts : (b -> b -> b) -> Dict comparable b -> Dict comparable b -> Dict comparable b -mergeDicts f d1 d2 = - let - inOne = Dict.insert - inBoth k v1 v2 = Dict.insert k (f v1 v2) - in - Dict.merge inOne inBoth inOne d1 d2 (Dict.empty) - -mergeState : State -> State -> State -mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events - -mergeTimeline : Timeline -> Timeline -> Timeline -mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch - -mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral -mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events - -mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom -mergeJoinedRoom r1 r2 = - { r2 | state = mergeMaybe mergeState r1.state r2.state - , timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline - , accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData - , ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral - } - -mergeInviteState : InviteState -> InviteState -> InviteState -mergeInviteState i1 i2 = InviteState <| mergeMaybe mergeStrippedStates i1.events i2.events - -mergeInvitedRoom : InvitedRoom -> InvitedRoom -> InvitedRoom -mergeInvitedRoom i1 i2 = InvitedRoom <| mergeMaybe mergeInviteState i1.inviteState i2.inviteState - -mergeLeftRoom : LeftRoom -> LeftRoom -> LeftRoom -mergeLeftRoom l1 l2 = LeftRoom - (mergeMaybe mergeState l1.state l2.state) - (mergeMaybe mergeTimeline l1.timeline l2.timeline) - (mergeMaybe mergeAccountData l1.accountData l2.accountData) - -mergeJoin : Dict String JoinedRoom -> Dict String JoinedRoom -> Dict String JoinedRoom -mergeJoin = mergeDicts mergeJoinedRoom - -mergeInvite : Dict String InvitedRoom -> Dict String InvitedRoom -> Dict String InvitedRoom -mergeInvite = mergeDicts mergeInvitedRoom - -mergeLeave : Dict String LeftRoom -> Dict String LeftRoom -> Dict String LeftRoom -mergeLeave = mergeDicts mergeLeftRoom - -mergeRooms : Rooms -> Rooms -> Rooms -mergeRooms r1 r2 = - { join = mergeMaybe mergeJoin r1.join r2.join - , invite = mergeMaybe mergeInvite r1.invite r2.invite - , leave = mergeMaybe mergeLeave r1.leave r2.leave - } - -mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse -mergeSyncResponse l r = - { r | rooms = mergeMaybe mergeRooms l.rooms r.rooms - , accountData = mergeMaybe mergeAccountData l.accountData r.accountData - } - -appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom -appendRoomHistoryResponse jr hr = - let - oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline - newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents - newTimeline = case jr.timeline of - Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end } - Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing } - in - { jr | timeline = newTimeline } - -appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse -appendHistoryResponse sr r hr = - let - appendMaybeRoomHistoryResponse mr = Just <| case mr of - Just jr -> appendRoomHistoryResponse jr hr - Nothing -> - { state = Nothing - , timeline = Just - { events = Just hr.chunk - , limited = Nothing - , prevBatch = Just hr.end - } - , ephemeral = Nothing - , accountData = Nothing - , unreadNotifications = Nothing - } - newRooms = Just <| case sr.rooms of - Just rs -> { rs | join = newJoin rs.join } - Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing } - newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j - in - { sr | rooms = newRooms } - -- Business Logic: Names homeserver : String -> String homeserver s =