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

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

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 =
+type Message
-    Sending SendingMessage
+    = 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

src/Scylla/Room.elm

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

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))
+        room r = Maybe.map (\jr -> (r, jr))
-            <| roomData model r
+            <| 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 : Model -> RoomId -> JoinedRoom -> Html Msg
-joinedRoomView m roomId rd =
+joinedRoomView m roomId jr =
     let
-        renderedMessages = List.map (userMessagesView m.userData m.apiUrl) <| mergeMessages m.loginUsername <| extractMessages rd
+        typing = List.map (displayName m.userData) <| roomTypingUsers jr
-        messagesWrapper = messagesWrapperView m roomId renderedMessages
-        typing = List.map (displayName m.userData) <| roomTypingUsers rd.joinedRoom
         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 : RoomId -> List (Html Msg) -> Html Msg
-messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrapper" ]
+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
     ]