Use Elm's lazy to optimize for many-message performance

This commit is contained in:
Danila Fedorin 2019-09-06 23:55:36 -07:00
parent 7122d9e567
commit 5e3aa40a35
4 changed files with 38 additions and 52 deletions

View File

@ -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 (..)

View File

@ -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

View File

@ -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

View File

@ -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
]