Display "still sending" messages.
This commit is contained in:
parent
2136bf34b9
commit
5d519242be
10
src/Main.elm
10
src/Main.elm
|
@ -2,6 +2,8 @@ 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 (..)
|
||||
import Scylla.Model exposing (..)
|
||||
|
@ -78,7 +80,7 @@ update msg model = case msg of
|
|||
ReceiveUserData s r -> updateUserData model s r
|
||||
ChangeRoomText r t -> updateChangeRoomText model r t
|
||||
SendRoomText r -> updateSendRoomText model r
|
||||
SendRoomTextResponse r -> (model, Cmd.none)
|
||||
SendRoomTextResponse t r -> ({ model | sending = Dict.remove t model.sending }, Cmd.none)
|
||||
ReceiveCompletedReadMarker r -> (model, Cmd.none)
|
||||
ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
|
||||
ReceiveStoreData d -> updateStoreData model d
|
||||
|
@ -107,8 +109,12 @@ updateMarkdown m { roomId, text, markdown } =
|
|||
<| encodeLoginInfo
|
||||
<| LoginInfo (Maybe.withDefault "" m.token) m.apiUrl m.loginUsername (m.transactionId + 1))
|
||||
sendMessageCmd = sendMarkdownMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) roomId text markdown
|
||||
newModel =
|
||||
{ m | transactionId = m.transactionId + 1
|
||||
, sending = Dict.insert (m.transactionId + 1) (roomId, TextMessage text) m.sending
|
||||
}
|
||||
in
|
||||
({ m | transactionId = m.transactionId + 1 }, Cmd.batch [ storeValueCmd, sendMessageCmd ])
|
||||
(newModel, Cmd.batch [ storeValueCmd, sendMessageCmd ])
|
||||
|
||||
updateFileUploadComplete : Model -> RoomId -> File -> (Result Http.Error String) -> (Model, Cmd Msg)
|
||||
updateFileUploadComplete m rid mime ur =
|
||||
|
|
|
@ -90,7 +90,7 @@ sendMessage apiUrl token transactionId room msg contents = request
|
|||
}
|
||||
|
||||
sendMarkdownMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> String -> Cmd Msg
|
||||
sendMarkdownMessage apiUrl token transactionId room message md = sendMessage apiUrl token transactionId room SendRoomTextResponse
|
||||
sendMarkdownMessage apiUrl token transactionId room message md = sendMessage apiUrl token transactionId room (SendRoomTextResponse transactionId)
|
||||
[ ("msgtype", string "m.text")
|
||||
, ("body", string message)
|
||||
, ("formatted_body", string md)
|
||||
|
@ -98,7 +98,7 @@ sendMarkdownMessage apiUrl token transactionId room message md = sendMessage api
|
|||
]
|
||||
|
||||
sendTextMessage : ApiUrl -> ApiToken -> Int -> RoomId -> String -> Cmd Msg
|
||||
sendTextMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room SendRoomTextResponse
|
||||
sendTextMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room (SendRoomTextResponse transactionId)
|
||||
[ ("msgtype", string "m.text")
|
||||
, ("body", string message)
|
||||
]
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
module Scylla.Messages exposing (..)
|
||||
import Scylla.Model exposing (Model)
|
||||
import Scylla.Sync exposing (RoomEvent)
|
||||
import Scylla.Login exposing (Username)
|
||||
|
||||
|
@ -9,17 +8,13 @@ type Message =
|
|||
Sending SendingMessage
|
||||
| Received RoomEvent
|
||||
|
||||
extractMessageEvents : List RoomEvent -> List Message
|
||||
extractMessageEvents es = List.map Received
|
||||
<| List.filter (\e -> e.type_ == "m.room.message") es
|
||||
|
||||
messageUsername : Model -> Message -> Username
|
||||
messageUsername m msg = case msg of
|
||||
Sending _ -> m.loginUsername
|
||||
messageUsername : Username -> Message -> Username
|
||||
messageUsername u msg = case msg of
|
||||
Sending _ -> u
|
||||
Received re -> re.sender
|
||||
|
||||
mergeMessages : Model -> List Message -> List (Username, List Message)
|
||||
mergeMessages m xs =
|
||||
mergeMessages : Username -> List Message -> List (Username, List Message)
|
||||
mergeMessages du xs =
|
||||
let
|
||||
initialState = (Nothing, [], [])
|
||||
appendNamed mu ms msl = case mu of
|
||||
|
@ -27,7 +22,7 @@ mergeMessages m xs =
|
|||
Nothing -> msl
|
||||
foldFunction msg (pu, ms, msl) =
|
||||
let
|
||||
nu = Just <| messageUsername m msg
|
||||
nu = Just <| messageUsername du msg
|
||||
in
|
||||
if pu == nu then (pu, ms ++ [msg], msl) else (nu, [msg], appendNamed pu ms msl)
|
||||
(fmu, fms, fmsl) = List.foldl foldFunction initialState xs
|
||||
|
|
|
@ -4,6 +4,7 @@ import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderNa
|
|||
import Scylla.Login exposing (LoginResponse, Username, Password)
|
||||
import Scylla.UserData exposing (UserData)
|
||||
import Scylla.Route exposing (Route(..), RoomId)
|
||||
import Scylla.Messages exposing (..)
|
||||
import Scylla.Storage exposing (..)
|
||||
import Scylla.Markdown exposing (..)
|
||||
import Browser.Navigation as Nav
|
||||
|
@ -26,7 +27,8 @@ type alias Model =
|
|||
, apiUrl : ApiUrl
|
||||
, sync : SyncResponse
|
||||
, errors : List String
|
||||
, roomText : Dict String String
|
||||
, roomText : Dict RoomId String
|
||||
, sending : Dict Int (RoomId, SendingMessage)
|
||||
, transactionId : Int
|
||||
, userData : Dict Username UserData
|
||||
, connected : Bool
|
||||
|
@ -42,7 +44,7 @@ type Msg =
|
|||
| 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
|
||||
| SendRoomTextResponse (Result Http.Error ()) -- A send message response finished
|
||||
| SendRoomTextResponse Int (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
|
||||
|
|
|
@ -16,10 +16,22 @@ roomData m rid =
|
|||
case Dict.get rid (joinedRooms m) of
|
||||
Just jr -> Just
|
||||
{ joinedRoom = jr
|
||||
, sendingMessages = []
|
||||
, inputText = Nothing
|
||||
, 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
|
||||
|
|
|
@ -140,8 +140,7 @@ loginView m = div [ class "login-wrapper" ]
|
|||
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
|
||||
joinedRoomView m roomId rd =
|
||||
let
|
||||
events = Maybe.withDefault [] <| Maybe.andThen .events rd.joinedRoom.timeline
|
||||
renderedMessages = List.map (userMessagesView m) <| mergeMessages m <| extractMessageEvents events
|
||||
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd
|
||||
messagesWrapper = messagesWrapperView m roomId renderedMessages
|
||||
typing = List.map (displayName m) <| roomTypingUsers rd.joinedRoom
|
||||
typingText = String.join ", " typing
|
||||
|
|
Loading…
Reference in New Issue
Block a user