diff --git a/src/Main.elm b/src/Main.elm index e289d23..fd7df16 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -44,12 +44,8 @@ init _ url key = , loginUsername = "" , loginPassword = "" , apiUrl = "https://matrix.org" - , sync = - { nextBatch = "" - , rooms = Nothing - , presence = Nothing - , accountData = Nothing - } + , nextBatch = "" + , accountData = { events = Just [] } , errors = [] , roomText = Dict.empty , sending = Dict.empty @@ -67,7 +63,7 @@ init _ url key = view : Model -> Browser.Document Msg view m = let - notificationString = totalNotificationCountString m.sync + notificationString = getTotalNotificationCountString m.rooms titleString = case notificationString of Nothing -> "Scylla" Just s -> s ++ " Scylla" @@ -191,17 +187,14 @@ updateHistoryResponse m r hr = <| h.chunk in case hr of - Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h) + Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, userDataCmd h) Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none) updateHistory : Model -> RoomId -> (Model, Cmd Msg) updateHistory m r = let - prevBatch = Maybe.andThen .prevBatch - <| Maybe.andThen .timeline - <| Maybe.andThen (Dict.get r) - <| Maybe.andThen .join - <| m.sync.rooms + prevBatch = Dict.get r m.rooms + |> Maybe.andThen (.prevHistoryBatch) command = case prevBatch of Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv Nothing -> Cmd.none @@ -256,9 +249,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg) updateChangeRoute m r = let joinedRoom = case r of - Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms + Room rid -> Dict.get rid m.rooms _ -> Nothing - lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.map (List.filterMap toMessageEvent) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom + lastMessage = Maybe.map .messages joinedRoom + |> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) readMarkerCmd = case (r, lastMessage) of (Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId _ -> Cmd.none @@ -314,7 +308,7 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model, updateSyncResponse model r notify = let token = Maybe.withDefault "" model.token - nextBatch = Result.withDefault model.sync.nextBatch + nextBatch = Result.withDefault model.nextBatch <| Result.map .nextBatch r syncCmd = sync model.apiUrl token nextBatch userDataCmd sr = newUsersCmd model @@ -327,7 +321,7 @@ updateSyncResponse model r notify = notificationCmd sr = if notify then Maybe.withDefault Cmd.none <| Maybe.map (\(s, e) -> sendNotificationPort - { name = displayName model.userData e.sender + { name = getDisplayName model.userData e.sender , text = notificationText e , room = s }) <| notification sr @@ -354,12 +348,11 @@ updateSyncResponse model r notify = receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << getUnsigned) <| allTimelineEvents sr sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions sr) model.sending - newSync sr = mergeSyncResponse model.sync sr newModel sr = - { model | sync = newSync sr - , sending = sending (mergeSyncResponse model.sync sr) - , roomNames = computeRoomsDisplayNames model.userData (newSync sr) + { model | nextBatch = nextBatch + , sending = sending sr , rooms = applySync sr model.rooms + , accountData = applyAccountData sr.accountData model.accountData } in case r of diff --git a/src/Scylla/Messages.elm b/src/Scylla/Messages.elm index d2936db..b722c67 100644 --- a/src/Scylla/Messages.elm +++ b/src/Scylla/Messages.elm @@ -2,6 +2,7 @@ module Scylla.Messages exposing (..) import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent) import Scylla.Login exposing (Username) import Scylla.Route exposing (RoomId) +import Scylla.Room exposing (RoomData) import Dict exposing (Dict) type SendingMessageBody = TextMessage String @@ -36,10 +37,10 @@ mergeMessages du xs = in appendNamed fmu fms fmsl -receivedMessagesRoom : List RoomEvent -> List Message -receivedMessagesRoom es = List.map Received - <| List.filter (\e -> e.type_ == "m.room.message") - <| List.filterMap toMessageEvent es +receivedMessagesRoom : RoomData -> List Message +receivedMessagesRoom rd = rd.messages + |> List.filter (\e -> e.type_ == "m.room.message") + |> List.map Received sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm) diff --git a/src/Scylla/Model.elm b/src/Scylla/Model.elm index 3662faf..e347b1b 100644 --- a/src/Scylla/Model.elm +++ b/src/Scylla/Model.elm @@ -1,6 +1,6 @@ module Scylla.Model exposing (..) import Scylla.Api exposing (..) -import Scylla.Sync exposing (SyncResponse, HistoryResponse, senderName, roomName, roomJoinedUsers) +import Scylla.Sync exposing (SyncResponse, HistoryResponse, roomJoinedUsers) import Scylla.ListUtils exposing (findFirst) import Scylla.Room exposing (OpenRooms) import Scylla.Sync.Rooms exposing (JoinedRoom) @@ -29,7 +29,8 @@ type alias Model = , loginUsername : Username , loginPassword : Password , apiUrl : ApiUrl - , sync : SyncResponse + , accountData : AccountData + , nextBatch : String , errors : List String , roomText : Dict RoomId String , sending : Dict Int (RoomId, SendingMessage) @@ -77,41 +78,6 @@ type Msg = | AttemptReconnect -- User wants to reconnect to server | UpdateSearchText String -- Change search text in room list -displayName : Dict String UserData -> Username -> String -displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud - -roomDisplayName : Dict RoomId String -> RoomId -> String -roomDisplayName rd rid = - Maybe.withDefault "" <| Dict.get rid rd - -computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String -computeRoomDisplayName ud ad rid jr = - let - customName = roomName jr - direct = ad - |> Maybe.andThen .events - |> Maybe.andThen (findFirst ((==) "m.direct" << .type_)) - |> Maybe.map (Decode.decodeValue directMessagesDecoder << .content) - |> Maybe.andThen Result.toMaybe - |> Maybe.andThen (Dict.get rid) - in - case (customName, direct) of - (Just s, _) -> customName - (_, Just u) -> direct - _ -> Nothing - -computeRoomsDisplayNames : Dict String UserData -> SyncResponse -> Dict String String -computeRoomsDisplayNames ud sr = - sr.rooms - |> Maybe.andThen .join - |> Maybe.map Dict.toList - |> Maybe.map (List.foldl - (\(rid, jr) d -> - computeRoomDisplayName ud sr.accountData rid jr - |> Maybe.map (\n -> Dict.insert rid n d) - |> Maybe.withDefault d) Dict.empty) - |> Maybe.withDefault Dict.empty - roomUrl : String -> String roomUrl s = Url.Builder.absolute [ "room", s ] [] @@ -121,13 +87,6 @@ loginUrl = Url.Builder.absolute [ "login" ] [] newUsers : Model -> List Username -> List Username newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus -joinedRooms : Model -> Dict RoomId JoinedRoom -joinedRooms m = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms - -currentRoom : Model -> Maybe JoinedRoom -currentRoom m = - Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m - currentRoomId : Model -> Maybe RoomId currentRoomId m = case m.route of Room r -> Just r diff --git a/src/Scylla/Room.elm b/src/Scylla/Room.elm index 0aec4f3..e818809 100644 --- a/src/Scylla/Room.elm +++ b/src/Scylla/Room.elm @@ -2,11 +2,13 @@ module Scylla.Room exposing (..) import Scylla.Route exposing (RoomId) import Scylla.Sync exposing (SyncResponse) import Scylla.Login exposing (Username) -import Scylla.UserData exposing (UserData) +import Scylla.UserData exposing (UserData, getDisplayName) +import Scylla.Sync exposing (HistoryResponse) import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent) -import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages) +import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData) import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral) -import Json.Decode as Decode exposing (Decoder, Value, decodeValue) +import Scylla.ListUtils exposing (findFirst, uniqueBy) +import Json.Decode as Decode exposing (Decoder, Value, decodeValue, field, string, list) import Dict exposing (Dict) type alias RoomState = Dict (String, String) Value @@ -17,6 +19,7 @@ type alias RoomData = , accountData : AccountData , ephemeral : Ephemeral , unreadNotifications : UnreadNotificationCounts + , prevHistoryBatch : Maybe String , text : String } @@ -35,6 +38,7 @@ emptyRoomData = { highlightCount = Just 0 , notificationCount = Just 0 } + , prevHistoryBatch = Nothing , text = "" } @@ -59,16 +63,6 @@ changeRoomState jr rs = |> changeRoomStateEvents stateDiff |> changeRoomStateEvents timelineDiff -changeAccountData : JoinedRoom -> AccountData -> AccountData -changeAccountData jr ad = - case jr.accountData of - Nothing -> ad - Just newAd -> - case (newAd.events, ad.events) of - (Just es, Nothing) -> newAd - (Just newEs, Just es) -> { events = Just (newEs ++ es) } - _ -> ad - changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent) changeTimeline jr tl = let @@ -77,7 +71,7 @@ changeTimeline jr tl = |> Maybe.map (List.filterMap toMessageEvent) |> Maybe.withDefault [] in - newMessages ++ tl + tl ++ newMessages changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral changeEphemeral jr e = Maybe.withDefault e jr.ephemeral @@ -87,11 +81,12 @@ changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications changeRoomData : JoinedRoom -> RoomData -> RoomData changeRoomData jr rd = - { rd | accountData = changeAccountData jr rd.accountData + { rd | accountData = applyAccountData jr.accountData rd.accountData , roomState = changeRoomState jr rd.roomState , messages = changeTimeline jr rd.messages , ephemeral = changeEphemeral jr rd.ephemeral , unreadNotifications = changeNotifications jr rd.unreadNotifications + , prevHistoryBatch = Maybe.andThen .prevBatch jr.timeline } updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData @@ -111,18 +106,63 @@ applySync sr or = in Dict.foldl applyJoinedRoom or joinedRooms +addHistoryRoomData : HistoryResponse -> Maybe RoomData -> Maybe RoomData +addHistoryRoomData hr = Maybe.map + (\rd -> + { rd | messages = uniqueBy .eventId + <| (List.reverse <| List.filterMap toMessageEvent hr.chunk) ++ rd.messages + , prevHistoryBatch = Just hr.end + }) + +applyHistoryResponse : RoomId -> HistoryResponse -> OpenRooms -> OpenRooms +applyHistoryResponse rid hr = Dict.update rid (addHistoryRoomData hr) + getStateData : (String, String) -> Decoder a -> RoomData -> Maybe a getStateData k d rd = Dict.get k rd.roomState |> Maybe.andThen (Result.toMaybe << decodeValue d) -getRoomName : Maybe AccountData -> Dict Username UserData -> RoomId -> RoomData -> String +getEphemeralData : String -> Decoder a -> RoomData -> Maybe a +getEphemeralData k d rd = rd.ephemeral.events + |> Maybe.andThen (findFirst ((==) k << .type_)) + |> Maybe.andThen (Result.toMaybe << decodeValue d << .content) + +getRoomTypingUsers : RoomData -> List String +getRoomTypingUsers = Maybe.withDefault [] + << getEphemeralData "m.typing" (field "user_ids" (list string)) + +getRoomName : AccountData -> Dict Username UserData -> RoomId -> RoomData -> String getRoomName ad ud rid rd = let - customName = getStateData ("m.room.name", "") Decode.string rd - direct = Maybe.andThen getDirectMessages ad + customName = getStateData ("m.room.name", "") (field "name" (string)) rd + direct = getDirectMessages ad |> Maybe.andThen (Dict.get rid) in case (customName, direct) of (Just cn, _) -> cn - (_, Just d) -> d + (_, Just d) -> getDisplayName ud d _ -> rid + +getRoomNotificationCount : RoomData -> (Int, Int) +getRoomNotificationCount rd = + ( Maybe.withDefault 0 rd.unreadNotifications.notificationCount + , Maybe.withDefault 0 rd.unreadNotifications.highlightCount + ) + +getTotalNotificationCount : OpenRooms -> (Int, Int) +getTotalNotificationCount = + let + sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2) + in + Dict.foldl (\_ -> sumTuples << getRoomNotificationCount) (0, 0) + +getTotalNotificationCountString : OpenRooms -> Maybe String +getTotalNotificationCountString or = + let + (n, h) = getTotalNotificationCount or + suffix = case h of + 0 -> "" + _ -> "!" + in + case n of + 0 -> Nothing + _ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")" diff --git a/src/Scylla/Sync.elm b/src/Scylla/Sync.elm index e6f5ea3..064a7f4 100644 --- a/src/Scylla/Sync.elm +++ b/src/Scylla/Sync.elm @@ -178,15 +178,6 @@ appendHistoryResponse sr r hr = { sr | rooms = newRooms } -- Business Logic: Names -senderName : String -> String -senderName s = - let - colonIndex = Maybe.withDefault -1 - <| List.head - <| String.indexes ":" s - in - String.slice 1 colonIndex s - homeserver : String -> String homeserver s = let diff --git a/src/Scylla/Sync/AccountData.elm b/src/Scylla/Sync/AccountData.elm index 3c1e332..7942663 100644 --- a/src/Scylla/Sync/AccountData.elm +++ b/src/Scylla/Sync/AccountData.elm @@ -30,6 +30,16 @@ invertDirectMessages dmr = Dict.empty dmr +applyAccountData : Maybe AccountData -> AccountData -> AccountData +applyAccountData mad ad = + case mad of + Nothing -> ad + Just newAd -> + case (newAd.events, ad.events) of + (Just es, Nothing) -> newAd + (Just newEs, Just es) -> { events = Just (newEs ++ es) } + _ -> ad + getAccountData : String -> Decode.Decoder a -> AccountData -> Maybe a getAccountData key d ad = ad.events |> Maybe.andThen (findFirst ((==) key << .type_)) diff --git a/src/Scylla/UserData.elm b/src/Scylla/UserData.elm index 9e5e5e2..6555c62 100644 --- a/src/Scylla/UserData.elm +++ b/src/Scylla/UserData.elm @@ -1,6 +1,8 @@ module Scylla.UserData exposing (..) +import Scylla.Login exposing (Username) import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field) import Json.Decode.Pipeline exposing (required, optional) +import Dict exposing (Dict) type alias UserData = { displayName : Maybe String @@ -12,3 +14,18 @@ userDataDecoder = Decode.succeed UserData |> optional "displayname" (Decode.map Just string) Nothing |> optional "avatar_url" (Decode.map Just string) Nothing + +getDisplayName : Dict Username UserData -> Username -> String +getDisplayName ud s = Dict.get s ud + |> Maybe.andThen .displayName + |> Maybe.withDefault (getSenderName s) + +getSenderName : Username -> String +getSenderName s = + let + colonIndex = Maybe.withDefault -1 + <| List.head + <| String.indexes ":" s + in + String.slice 1 colonIndex s + diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index 3136a0b..0411fe4 100644 --- a/src/Scylla/Views.elm +++ b/src/Scylla/Views.elm @@ -3,12 +3,12 @@ import Scylla.Model exposing (..) import Scylla.Sync exposing (..) import Scylla.Sync.Events exposing (..) import Scylla.Sync.Rooms exposing (..) -import Scylla.Room exposing (RoomData, emptyOpenRooms, getRoomName) +import Scylla.Room exposing (RoomData, emptyOpenRooms, getRoomName, getRoomTypingUsers) import Scylla.Route exposing (..) import Scylla.Fnv as Fnv import Scylla.Messages exposing (..) import Scylla.Login exposing (Username) -import Scylla.UserData exposing (UserData) +import Scylla.UserData exposing (UserData, getDisplayName) import Scylla.Http exposing (fullMediaUrl) import Scylla.Api exposing (ApiUrl) import Scylla.ListUtils exposing (groupBy) @@ -48,10 +48,8 @@ stringColor s = viewFull : Model -> List (Html Msg) viewFull model = let - room r = Maybe.map (\jr -> (r, jr)) - <| Maybe.andThen (Dict.get r) - <| Maybe.andThen .join - <| model.sync.rooms + room r = Dict.get r model.rooms + |> Maybe.map (\rd -> (r, rd)) core = case model.route of Login -> loginView model Base -> baseView model Nothing @@ -67,10 +65,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView errorView : Int -> String -> Html Msg errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ] -baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg -baseView m jr = +baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg +baseView m rd = let - roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr + roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd reconnect = reconnectView m in div [ class "base-wrapper" ] <| maybeHtml @@ -113,14 +111,14 @@ homeserverView m hs rs = let roomList = div [ class "rooms-list" ] <| List.map (\(rid, r) -> roomListElementView m rid r) - <| List.sortBy (\(rid, r) -> getRoomName m.sync.accountData m.userData rid r) rs + <| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs in div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ] roomListElementView : Model -> RoomId -> RoomData -> Html Msg roomListElementView m rid rd = let - name = getRoomName m.sync.accountData m.userData rid rd + name = getRoomName m.accountData m.userData rid rd isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name) isCurrentRoom = case currentRoomId m of Nothing -> False @@ -160,10 +158,10 @@ loginView m = div [ class "login-wrapper" ] , button [ onClick AttemptLogin ] [ text "Log In" ] ] -joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg -joinedRoomView m roomId jr = +joinedRoomView : Model -> RoomId -> RoomData -> Html Msg +joinedRoomView m roomId rd = let - typing = List.map (displayName m.userData) <| roomTypingUsers jr + typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd typingText = String.join ", " typing typingSuffix = case List.length typing of 0 -> "" @@ -184,18 +182,16 @@ joinedRoomView m roomId jr = ] in div [ class "room-wrapper" ] - [ h2 [] [ text <| roomDisplayName m.roomNames roomId ] - , lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending + [ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ] + , lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending , messageInput , typingWrapper ] -lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg -lazyMessagesView ud rid jr au lu snd = +lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg +lazyMessagesView ud rid rd au lu snd = let - roomReceived = receivedMessagesRoom - <| Maybe.withDefault [] - <| Maybe.andThen .events jr.timeline + roomReceived = receivedMessagesRoom rd roomSending = sendingMessagesRoom rid snd renderedMessages = List.map (userMessagesView ud au) <| mergeMessages lu @@ -230,7 +226,7 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe senderView : Dict String UserData -> Username -> Html Msg senderView ud s = - span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ] + span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getDisplayName ud s ] userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg userMessagesView ud apiUrl (u, ms) = @@ -284,7 +280,7 @@ roomEventContent f re = roomEventEmoteView : Dict String UserData -> MessageEvent -> Maybe (Html Msg) roomEventEmoteView ud re = let - emoteText = "* " ++ displayName ud re.sender ++ " " + emoteText = "* " ++ getDisplayName ud re.sender ++ " " in roomEventContent (\cs -> span [] (text emoteText :: cs)) re