diff --git a/elm.json b/elm.json index 6a3ccd2..e16e94e 100644 --- a/elm.json +++ b/elm.json @@ -13,12 +13,12 @@ "elm/http": "2.0.0", "elm/json": "1.1.2", "elm/svg": "1.0.1", + "elm/time": "1.0.0", "elm/url": "1.0.0" }, "indirect": { "elm/bytes": "1.0.7", "elm/file": "1.0.1", - "elm/time": "1.0.0", "elm/virtual-dom": "1.0.2" } }, diff --git a/src/Main.elm b/src/Main.elm index 5647854..e737db3 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -7,7 +7,7 @@ import Scylla.Api exposing (..) import Scylla.Model exposing (..) import Scylla.Http exposing (..) import Scylla.Views exposing (viewFull) -import Scylla.Route exposing (Route(..)) +import Scylla.Route exposing (Route(..), RoomId) import Scylla.UserData exposing (..) import Scylla.Notification exposing (..) import Scylla.Storage exposing (..) @@ -16,11 +16,15 @@ import Url.Parser exposing (parse) import Url.Builder import Json.Encode import Json.Decode +import Time exposing (every) import Html exposing (div, text) import Http import Dict import Task +syncTimeout = 10000 +typingTimeout = 2000 + type alias Flags = { token : Maybe String } @@ -73,12 +77,37 @@ update msg model = case msg of ReceiveFirstSyncResponse r -> updateSyncResponse model r False ReceiveSyncResponse r -> updateSyncResponse model r True ReceiveUserData s r -> updateUserData model s r - ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none) + ChangeRoomText r t -> updateChangeRoomText model r t SendRoomText r -> updateSendRoomText model r SendRoomTextResponse r -> (model, Cmd.none) ReceiveCompletedReadMarker r -> (model, Cmd.none) ReceiveCompletedTypingIndicator r -> (model, Cmd.none) ReceiveStoreData d -> updateStoreData model d + TypingTick _ -> updateTypingTick model + + +updateChangeRoomText : Model -> RoomId -> String -> (Model, Cmd Msg) +updateChangeRoomText m roomId text = + let + typingIndicator = case (text, Dict.get roomId m.roomText) of + ("", _) -> Just False + (_, Just "") -> Just True + _ -> Nothing + command = case typingIndicator of + Just b -> sendTypingIndicator m.apiUrl (Maybe.withDefault "" m.token) roomId m.loginUsername b typingTimeout + _ -> Cmd.none + in + ({ m | roomText = Dict.insert roomId text m.roomText}, command) + +updateTypingTick : Model -> (Model, Cmd Msg) +updateTypingTick m = + let + command = case currentRoomId m of + Just rid -> sendTypingIndicator m.apiUrl (Maybe.withDefault "" m.token) rid m.loginUsername True typingTimeout + Nothing -> Cmd.none + in + (m, command) + updateStoreData : Model -> Json.Encode.Value -> (Model, Cmd Msg) updateStoreData m d = case (Json.Decode.decodeValue storeDataDecoder d) of @@ -197,10 +226,17 @@ updateSyncResponse model r notify = _ -> (model, syncCmd) subscriptions : Model -> Sub Msg -subscriptions m = Sub.batch - [ onNotificationClickPort OpenRoom - , receiveStoreValuePort ReceiveStoreData - ] +subscriptions m = + let + typingTimer = case Maybe.withDefault "" <| Maybe.andThen (\rid -> Dict.get rid m.roomText) <| currentRoomId m of + "" -> Sub.none + _ -> every typingTimeout TypingTick + in + Sub.batch + [ onNotificationClickPort OpenRoom + , receiveStoreValuePort ReceiveStoreData + , typingTimer + ] onUrlRequest : Browser.UrlRequest -> Msg onUrlRequest = TryUrl diff --git a/src/Scylla/Model.elm b/src/Scylla/Model.elm index 1129930..4e66036 100644 --- a/src/Scylla/Model.elm +++ b/src/Scylla/Model.elm @@ -9,6 +9,7 @@ import Browser.Navigation as Nav import Browser.Dom exposing (Viewport) import Url.Builder import Dict exposing (Dict) +import Time exposing (Posix) import Json.Decode import Browser import Http @@ -44,10 +45,11 @@ type Msg = | ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ReceiveSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ReceiveLoginResponse ApiUrl (Result Http.Error LoginResponse) -- HTTP, Login has finished - | ReceiveUserData Username (Result Http.Error UserData) - | ReceiveCompletedReadMarker (Result Http.Error ()) - | ReceiveStoreData Json.Decode.Value + | ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data + | ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed | ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed + | ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage. + | TypingTick Posix -- Tick for updating the typing status displayName : Model -> Username -> String displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData