Send typing notifications.
This commit is contained in:
parent
7f0624f112
commit
7de91104b0
2
elm.json
2
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"
|
||||
}
|
||||
},
|
||||
|
|
48
src/Main.elm
48
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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user