Add "typing people wrapper"

src/Main.elm

@@ -6,6 +6,8 @@ import Scylla.Model exposing (..)
 import Scylla.Http exposing (..)
 import Scylla.Views exposing (viewFull)
 import Scylla.Route exposing (Route(..))
+import Scylla.UserData exposing (..)
+import Scylla.Notification exposing (..)
 import Url exposing (Url)
 import Url.Parser exposing (parse)
 import Url.Builder
@@ -57,15 +59,21 @@ update msg model = case msg of
     ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
     AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO 
     TryUrl urlRequest -> updateTryUrl model urlRequest
+    OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
     ChangeRoute r -> ({ model | route = r }, Cmd.none)
     ReceiveLoginResponse r -> updateLoginResponse model r
     ReceiveFirstSyncResponse r -> updateSyncResponse model r False
     ReceiveSyncResponse r -> updateSyncResponse model r True
-    ReceiveUserData s r -> (model, Cmd.none)
+    ReceiveUserData s r -> updateUserData model s r
     ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
     SendRoomText r -> updateSendRoomText model r
     SendRoomTextResponse r -> (model, Cmd.none)
 
+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)
+    Err e -> (m, userData m.apiUrl (Maybe.withDefault "" m.token) s)
+
 updateSendRoomText : Model -> String -> (Model, Cmd Msg)
 updateSendRoomText m r =
     let
@@ -84,7 +92,7 @@ updateTryUrl m ur = case ur of
 
 updateLoginResponse : Model -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
 updateLoginResponse model r = case r of
-    Ok lr -> ( { model | token = Just lr.accessToken } , Cmd.batch
+    Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId } , Cmd.batch
         [ firstSync model.apiUrl lr.accessToken
         , Nav.pushUrl model.key <| Url.Builder.absolute [] []
         ] )
@@ -96,14 +104,34 @@ updateSyncResponse model r notify =
         token = Maybe.withDefault "" model.token
         nextBatch = Result.withDefault model.sync.nextBatch
             <| Result.map .nextBatch r
-        cmd = sync nextBatch model.apiUrl token
+        syncCmd = sync nextBatch model.apiUrl token
+        newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
+        newUserCommands sr = Cmd.batch
+            <| List.map (userData model.apiUrl
+            <| Maybe.withDefault "" model.token)
+            <| newUsers sr
+        notification sr = findFirstBy
+            (\(s, e) -> e.originServerTs)
+            (\(s, e) -> e.sender /= model.loginUsername)
+            <| notificationEvents sr
+        notificationCommand sr = Maybe.withDefault Cmd.none
+            <| Maybe.map (\(s, e) -> sendNotificationPort
+                { name = displayName model e.sender
+                , text = notificationText e
+                , room = s
+                })
+            <| notification sr
     in
         case r of
-            Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, cmd)
+            Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
-            _ -> (model, cmd)
+                [ syncCmd
+                , newUserCommands sr
+                , if notify then notificationCommand sr else Cmd.none
+                ])
+            _ -> (model, syncCmd)
 
 subscriptions : Model -> Sub Msg
-subscriptions m = Sub.none
+subscriptions m = onNotificationClickPort OpenRoom
 
 onUrlRequest : Browser.UrlRequest -> Msg
 onUrlRequest = TryUrl

src/Scylla/Model.elm

@@ -1,10 +1,11 @@
 module Scylla.Model exposing (..)
 import Scylla.Api exposing (..)
-import Scylla.Sync exposing (SyncResponse, JoinedRoom)
+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 Browser.Navigation as Nav
+import Url.Builder
 import Dict exposing (Dict)
 import Browser
 import Http
@@ -30,6 +31,7 @@ type Msg =
     | ChangeLoginPassword Password -- During login screen: the password
     | AttemptLogin -- During login screen, login button presed
     | TryUrl Browser.UrlRequest -- User attempts to change URL
+    | OpenRoom String -- We try open a room
     | ChangeRoute Route -- URL changes
     | ChangeRoomText String String -- Change to a room's input text
     | SendRoomText String -- Sends a message typed into a given room's input
@@ -39,3 +41,11 @@ type Msg =
     | ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
     | ReceiveUserData Username (Result Http.Error UserData)
 
+displayName : Model -> Username -> String
+displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
+
+roomUrl : String -> String
+roomUrl s = Url.Builder.absolute [ "room", s ] []
+
+loginUrl : String
+loginUrl = Url.Builder.absolute [ "login" ] []

src/Scylla/Notification.elm

@@ -8,4 +8,4 @@ type alias Notification =
     }
 
 port sendNotificationPort : Notification -> Cmd msg
-port onNotificationClickPort : (Json.Decode.Value -> msg) -> Sub msg
+port onNotificationClickPort : (String -> msg) -> Sub msg

src/Scylla/Sync.elm

@@ -269,6 +269,26 @@ uniqueByRecursive f l s = case l of
 uniqueBy : (a -> comparable) -> List a -> List a
 uniqueBy f l = uniqueByRecursive f l Set.empty
 
+findFirst : (a -> Bool) -> List a -> Maybe a
+findFirst cond l = case l of
+    x::xs -> if cond x then Just x else findFirst cond xs
+    [] -> Nothing
+
+findLast : (a -> Bool) -> List a -> Maybe a
+findLast cond l = findFirst cond <| List.reverse l
+
+findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
+findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
+
+findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
+findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
+
+findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
+findFirstEvent = findFirstBy .originServerTs
+
+findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
+findLastEvent = findLastBy .originServerTs
+
 -- Business Logic: Merging
 mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
 mergeMaybe f l r = case (l, r) of
@@ -309,11 +329,15 @@ mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
 mergeTimeline : Timeline -> Timeline -> Timeline
 mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t2.prevBatch
 
+mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
+mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
+
 mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom
 mergeJoinedRoom r1 r2 =
     { r2 | state = mergeMaybe mergeState r1.state r2.state
     , timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
     , accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
+    , ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral
     }
 
 mergeInviteState : InviteState -> InviteState -> InviteState 
@@ -364,19 +388,23 @@ roomName : JoinedRoom -> Maybe String
 roomName jr = 
     let
         state = jr.state
-        nameEvent = List.head << List.sortBy (\e -> -e.originServerTs) << List.filter (\e -> e.type_ == "m.room.name")
+        nameEvent = findLastEvent (((==) "m.room.name") << .type_)
         name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
     in
         Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
 
 -- Business Logic: Event Extraction
-notificationEvent : SyncResponse -> Maybe (String, RoomEvent)
+notificationText : RoomEvent -> String
-notificationEvent s =
+notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
+    Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
+    _ -> ""
+
+notificationEvents : SyncResponse -> List (String, RoomEvent)
+notificationEvents s =
     let
         applyPair k = List.map (\v -> (k, v))
     in
-        List.head
+        List.sortBy (\(k, v) -> v.originServerTs)
-        <| List.sortBy (\(k, v) -> v.originServerTs)
         <| Dict.foldl (\k v a -> a ++ applyPair k v) []
         <| joinedRoomsEvents s
 
@@ -387,6 +415,13 @@ joinedRoomsEvents s =
     <| Maybe.andThen .join s.rooms
 
 -- Business Logic: User Extraction
+roomTypingUsers : JoinedRoom -> List Username
+roomTypingUsers jr = Maybe.withDefault []
+    <| Maybe.andThen (Result.toMaybe << Decode.decodeValue (Decode.field "user_ids" (list string)))
+    <| Maybe.map .content
+    <| Maybe.andThen (findLast (((==) "m.typing") << .type_))
+    <| Maybe.andThen .events jr.ephemeral
+
 roomsUsers : SyncResponse -> List Username
 roomsUsers s =
     let
@@ -399,4 +434,4 @@ roomsUsers s =
         joinedUsers = usersFor .join
         leftUsers = usersFor .leave
     in
-        leftUsers ++ joinedUsers
+        uniqueBy (\u -> u) <| leftUsers ++ joinedUsers

src/Scylla/Views.elm

@@ -3,6 +3,7 @@ import Scylla.Model exposing (..)
 import Scylla.Sync exposing (..)
 import Scylla.Route exposing (..)
 import Scylla.Fnv as Fnv
+import Scylla.Login exposing (Username)
 import Svg
 import Svg.Attributes
 import Url.Builder
@@ -68,7 +69,7 @@ roomListElementView s jr =
     let
         name = Maybe.withDefault "<No Name>"  <| roomName jr
     in
-        a [ href <| Url.Builder.absolute [ "room", s ] [] ] [ text name ]
+        a [ href <| roomUrl s ] [ text name ]
 
 loginView : Model -> Html Msg
 loginView m = div [ class "login-wrapper" ]
@@ -85,6 +86,13 @@ joinedRoomView m roomId jr =
         events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
         renderedEvents = List.filterMap (eventView m) events
         eventWrapper = eventWrapperView m renderedEvents
+        typing = List.map (displayName m) <| roomTypingUsers jr
+        typingText = String.join ", " typing
+        typingSuffix = case List.length typing of
+            0 -> ""
+            1 -> " is typing..."
+            _ -> " are typing..."
+        typingWrapper = div [ class "typing-wrapper" ] [ text <| typingText ++ typingSuffix ] 
         messageInput = div [ class "message-wrapper" ]
             [ input
                 [ type_ "text"
@@ -97,6 +105,7 @@ joinedRoomView m roomId jr =
         div [ class "room-wrapper" ]
             [ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
             , eventWrapper
+            , typingWrapper
             , messageInput
             ]
 
@@ -119,16 +128,16 @@ eventView m re =
             "m.room.message" -> Just messageView
             _ -> Nothing
         createRow mhtml = tr []
-            [ td [] [ eventSenderView re.sender ]
+            [ td [] [ eventSenderView m re.sender ]
             , td [] [ mhtml ]
             ]
     in
         Maybe.map createRow
             <| Maybe.andThen (\f -> f m re) viewFunction
 
-eventSenderView : String -> Html Msg
+eventSenderView : Model -> Username -> Html Msg
-eventSenderView s =
+eventSenderView m s =
-    span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| senderName s ]
+    span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
 
 messageView : Model -> RoomEvent -> Maybe (Html Msg)
 messageView m re =

static/js/notifications.js

@@ -9,9 +9,8 @@ function setupNotificationPorts(app) {
         }
         var n = new Notification(data.name, options)
         n.onclick = function() {
-            app.ports.onNotificationClickPort.send({
+            app.ports.onNotificationClickPort.send(data.room);
-                "room" : data.room
+            n.close();
-            });
         }
     })
 }