From 5e3aa40a353d6a8530a9bdb8877a2189a6d71a3d Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Fri, 6 Sep 2019 23:55:36 -0700 Subject: [PATCH] Use Elm's lazy to optimize for many-message performance --- src/Main.elm | 1 - src/Scylla/Messages.elm | 15 +++++++++++++-- src/Scylla/Room.elm | 37 ------------------------------------- src/Scylla/Views.elm | 37 +++++++++++++++++++++++++------------ 4 files changed, 38 insertions(+), 52 deletions(-) delete mode 100644 src/Scylla/Room.elm diff --git a/src/Main.elm b/src/Main.elm index 03caacb..772315f 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -2,7 +2,6 @@ import Browser exposing (application, UrlRequest(..)) import Browser.Navigation as Nav import Browser.Dom exposing (Viewport, setViewportOf) import Scylla.Sync exposing (..) -import Scylla.Room exposing (..) import Scylla.Messages exposing (..) import Scylla.Login exposing (..) import Scylla.Api exposing (..) diff --git a/src/Scylla/Messages.elm b/src/Scylla/Messages.elm index b8a2c57..8db10ea 100644 --- a/src/Scylla/Messages.elm +++ b/src/Scylla/Messages.elm @@ -1,6 +1,8 @@ module Scylla.Messages exposing (..) import Scylla.Sync exposing (RoomEvent) import Scylla.Login exposing (Username) +import Scylla.Route exposing (RoomId) +import Dict exposing (Dict) type SendingMessageBody = TextMessage String @@ -9,8 +11,8 @@ type alias SendingMessage = , id : Maybe String } -type Message = - Sending SendingMessage +type Message + = Sending SendingMessage | Received RoomEvent messageUsername : Username -> Message -> Username @@ -33,3 +35,12 @@ mergeMessages du xs = (fmu, fms, fmsl) = List.foldl foldFunction initialState xs in appendNamed fmu fms fmsl + +receivedMessagesRoom : List RoomEvent -> List Message +receivedMessagesRoom es = List.map Received + <| List.filter (\e -> e.type_ == "m.room.message") es + +sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message +sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm) + <| List.filter (\(_, (nrid, _)) -> nrid == rid) + <| Dict.toList ms diff --git a/src/Scylla/Room.elm b/src/Scylla/Room.elm deleted file mode 100644 index 6ce6987..0000000 --- a/src/Scylla/Room.elm +++ /dev/null @@ -1,37 +0,0 @@ -module Scylla.Room exposing (..) -import Scylla.Model exposing (..) -import Scylla.Sync exposing (..) -import Scylla.Messages exposing (..) -import Scylla.Route exposing (..) -import Dict - -type alias RoomData = - { joinedRoom : JoinedRoom - , sendingMessages : List (SendingMessage, Int) - , inputText : Maybe String - } - -roomData : Model -> RoomId -> Maybe RoomData -roomData m rid = - case Dict.get rid (joinedRooms m) of - Just jr -> Just - { joinedRoom = jr - , sendingMessages = List.map (\(tid, (_, sm)) -> (sm, tid)) <| List.filter (\(_, (nrid, _)) -> nrid == rid) <| Dict.toList m.sending - , inputText = Dict.get rid m.roomText - } - Nothing -> Nothing - -currentRoomData : Model -> Maybe RoomData -currentRoomData m = Maybe.andThen (roomData m) <| currentRoomId m - -extractMessageEvents : List RoomEvent -> List Message -extractMessageEvents es = List.map Received - <| List.filter (\e -> e.type_ == "m.room.message") es - -extractMessages : RoomData -> List Message -extractMessages rd = - let - eventMessages = extractMessageEvents <| Maybe.withDefault [] <| Maybe.andThen .events rd.joinedRoom.timeline - sendingMessages = List.map (\(sm, i) -> Sending sm) rd.sendingMessages - in - eventMessages ++ sendingMessages diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index 6c364dc..a92279e 100644 --- a/src/Scylla/Views.elm +++ b/src/Scylla/Views.elm @@ -3,7 +3,6 @@ import Scylla.Model exposing (..) import Scylla.Sync exposing (..) import Scylla.Route exposing (..) import Scylla.Fnv as Fnv -import Scylla.Room exposing (..) import Scylla.Messages exposing (..) import Scylla.Login exposing (Username) import Scylla.UserData exposing (UserData) @@ -18,6 +17,7 @@ import Json.Decode as Decode import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p) import Html.Attributes exposing (type_, placeholder, value, href, class, style, src, id, rows, controls, src, classList) import Html.Events exposing (onInput, onClick, preventDefaultOn) +import Html.Lazy exposing (lazy6) import Dict exposing (Dict) import Tuple @@ -44,8 +44,10 @@ stringColor s = viewFull : Model -> List (Html Msg) viewFull model = let - room r = Maybe.map (\rd -> (r, rd)) - <| roomData model r + room r = Maybe.map (\jr -> (r, jr)) + <| Maybe.andThen (Dict.get r) + <| Maybe.andThen .join + <| model.sync.rooms core = case model.route of Login -> loginView model Base -> baseView model Nothing @@ -61,7 +63,7 @@ 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 (String, RoomData) -> Html Msg +baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg baseView m jr = let roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr @@ -157,12 +159,10 @@ loginView m = div [ class "login-wrapper" ] , button [ onClick AttemptLogin ] [ text "Log In" ] ] -joinedRoomView : Model -> RoomId -> RoomData -> Html Msg -joinedRoomView m roomId rd = +joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg +joinedRoomView m roomId jr = let - renderedMessages = List.map (userMessagesView m.userData m.apiUrl) <| mergeMessages m.loginUsername <| extractMessages rd - messagesWrapper = messagesWrapperView m roomId renderedMessages - typing = List.map (displayName m.userData) <| roomTypingUsers rd.joinedRoom + typing = List.map (displayName m.userData) <| roomTypingUsers jr typingText = String.join ", " typing typingSuffix = case List.length typing of 0 -> "" @@ -184,11 +184,24 @@ joinedRoomView m roomId rd = in div [ class "room-wrapper" ] [ h2 [] [ text <| roomDisplayName m roomId ] - , messagesWrapper + , lazy6 lazyMessagesView m.userData roomId jr 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 = + let + roomReceived = receivedMessagesRoom + <| Maybe.withDefault [] + <| Maybe.andThen .events jr.timeline + roomSending = sendingMessagesRoom rid snd + renderedMessages = List.map (userMessagesView ud au) + <| mergeMessages lu + <| roomReceived ++ roomSending + in + messagesWrapperView rid renderedMessages + onEnterKey : Msg -> Attribute Msg onEnterKey msg = let @@ -208,8 +221,8 @@ iconView name = [ Svg.Attributes.class "feather-icon" ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ] -messagesWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg -messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrapper" ] +messagesWrapperView : RoomId -> List (Html Msg) -> Html Msg +messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrapper" ] [ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ] , table [ class "messages-table" ] es ]