Scroll when new messages arrive and user is close to the bottom.

src/Main.elm

@@ -1,5 +1,6 @@
 import Browser exposing (application, UrlRequest(..))
 import Browser.Navigation as Nav
+import Browser.Dom exposing (Viewport, setViewportOf)
 import Scylla.Sync exposing (..)
 import Scylla.Login exposing (..)
 import Scylla.Model exposing (..)
@@ -14,6 +15,7 @@ import Url.Builder
 import Html exposing (div, text)
 import Http
 import Dict
+import Task
 
 type alias Flags =
     { token : Maybe String
@@ -61,6 +63,8 @@ update msg model = case msg of
     TryUrl urlRequest -> updateTryUrl model urlRequest
     OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
     ChangeRoute r -> ({ model | route = r }, Cmd.none)
+    ViewportAfterMessage v -> updateViewportAfterMessage model v
+    ViewportChangeComplete _ -> (model, Cmd.none)
     ReceiveLoginResponse r -> updateLoginResponse model r
     ReceiveFirstSyncResponse r -> updateSyncResponse model r False
     ReceiveSyncResponse r -> updateSyncResponse model r True
@@ -69,6 +73,15 @@ update msg model = case msg of
     SendRoomText r -> updateSendRoomText model r
     SendRoomTextResponse r -> (model, Cmd.none)
 
+updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Model, Cmd Msg)
+updateViewportAfterMessage m vr = 
+    let
+        cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100
+            then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height
+            else Cmd.none
+    in
+        (m, Result.withDefault Cmd.none <| Result.map cmd vr)
+
 updateUserData : Model -> String -> Result Http.Error UserData -> (Model, Cmd Msg)
 updateUserData m s r = case r of
     Ok ud -> ({ m | userData = Dict.insert s ud m.userData }, Cmd.none)
@@ -121,12 +134,23 @@ updateSyncResponse model r notify =
                 , room = s
                 })
             <| notification sr
+        roomMessages sr = case currentRoomId model of
+            Just rid -> List.filter (((==) "m.room.message") << .type_)
+                <| Maybe.withDefault []
+                <| Maybe.andThen .events
+                <| Maybe.andThen .timeline
+                <| Maybe.andThen (Dict.get rid)
+                <| Maybe.andThen .join
+                <| sr.rooms
+            Nothing -> []
+        setScrollCommand sr = if List.isEmpty <| roomMessages sr then Cmd.none else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper")
     in
         case r of
             Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
                 [ syncCmd
                 , newUserCommands sr
                 , if notify then notificationCommand sr else Cmd.none
+                , setScrollCommand sr
                 ])
             _ -> (model, syncCmd)
 

src/Scylla/Model.elm

@@ -3,8 +3,9 @@ import Scylla.Api exposing (..)
 import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
 import Scylla.Login exposing (LoginResponse, Username, Password)
 import Scylla.UserData exposing (UserData)
-import Scylla.Route exposing (Route)
+import Scylla.Route exposing (Route(..), RoomId)
 import Browser.Navigation as Nav
+import Browser.Dom exposing (Viewport)
 import Url.Builder
 import Dict exposing (Dict)
 import Browser
@@ -36,6 +37,8 @@ type Msg =
     | ChangeRoomText String String -- Change to a room's input text
     | SendRoomText String -- Sends a message typed into a given room's input
     | SendRoomTextResponse (Result Http.Error ()) -- A send message response finished
+    | ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe)
+    | ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport.
     | ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
     | ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
     | ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
@@ -49,3 +52,15 @@ roomUrl s = Url.Builder.absolute [ "room", s ] []
 
 loginUrl : String
 loginUrl = Url.Builder.absolute [ "login" ] []
+
+currentRoom : Model -> Maybe JoinedRoom
+currentRoom m =
+    let
+        roomDict = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
+    in
+        Maybe.andThen (\s -> Dict.get s roomDict) <| currentRoomId m
+
+currentRoomId : Model -> Maybe RoomId
+currentRoomId m = case m.route of
+    Room r -> Just r
+    _ -> Nothing

src/Scylla/Views.elm

@@ -11,7 +11,7 @@ import Svg.Attributes
 import Url.Builder
 import Json.Decode as Decode
 import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, table, td, tr, img)
-import Html.Attributes exposing (type_, value, href, class, style, src)
+import Html.Attributes exposing (type_, value, href, class, style, src, id)
 import Html.Events exposing (onInput, onClick, on)
 import Dict
 
@@ -156,7 +156,7 @@ iconView name =
             ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
 
 eventWrapperView : Model -> List (Html Msg) -> Html Msg
-eventWrapperView m es = div [ class "events-wrapper" ] [ table [ class "events-table" ] es ]
+eventWrapperView m es = div [ class "events-wrapper", id "events-wrapper" ] [ table [ class "events-table" ] es ]
 
 eventView : Model -> RoomEvent -> Maybe (Html Msg)
 eventView m re =