diff --git a/src/Main.elm b/src/Main.elm index 3d2bd8e..164ef9e 100644 --- a/src/Main.elm +++ b/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 = diff --git a/src/Scylla/Http.elm b/src/Scylla/Http.elm index 94ffc3f..d1ee4b8 100644 --- a/src/Scylla/Http.elm +++ b/src/Scylla/Http.elm @@ -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) ] diff --git a/src/Scylla/Messages.elm b/src/Scylla/Messages.elm index 3401bb7..7679434 100644 --- a/src/Scylla/Messages.elm +++ b/src/Scylla/Messages.elm @@ -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 diff --git a/src/Scylla/Model.elm b/src/Scylla/Model.elm index ca192c0..84094ab 100644 --- a/src/Scylla/Model.elm +++ b/src/Scylla/Model.elm @@ -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 diff --git a/src/Scylla/Room.elm b/src/Scylla/Room.elm index 7d294d5..6ce6987 100644 --- a/src/Scylla/Room.elm +++ b/src/Scylla/Room.elm @@ -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 diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index 8e9e98b..b03e08e 100644 --- a/src/Scylla/Views.elm +++ b/src/Scylla/Views.elm @@ -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