From ce1580926cbc94aa0dcfa267940386fa7fa08ba7 Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Mon, 25 Feb 2019 16:44:47 -0800 Subject: [PATCH] Refactor to allow "messages". This will allow us to group non-event things as messages, which will then allow us to display messages that are still being sent. --- src/Main.elm | 4 +-- src/Scylla/Messages.elm | 33 ++++++++++++++++++ src/Scylla/Views.elm | 77 +++++++++++++++++++++-------------------- static/scss/style.scss | 9 ++--- 4 files changed, 79 insertions(+), 44 deletions(-) create mode 100644 src/Scylla/Messages.elm diff --git a/src/Main.elm b/src/Main.elm index d38999f..3d2bd8e 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -230,7 +230,7 @@ updateViewportAfterMessage : Model -> Result Browser.Dom.Error Viewport -> (Mode updateViewportAfterMessage m vr = let cmd vp = if vp.scene.height - (vp.viewport.y + vp.viewport.height ) < 100 - then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height + then Task.attempt ViewportChangeComplete <| setViewportOf "messages-wrapper" vp.viewport.x vp.scene.height else Cmd.none in (m, Result.withDefault Cmd.none <| Result.map cmd vr) @@ -308,7 +308,7 @@ updateSyncResponse model r notify = setScrollCmd sr = if List.isEmpty <| roomMessages sr then Cmd.none - else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-wrapper") + else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper") setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of (Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId _ -> Cmd.none diff --git a/src/Scylla/Messages.elm b/src/Scylla/Messages.elm new file mode 100644 index 0000000..767f5f9 --- /dev/null +++ b/src/Scylla/Messages.elm @@ -0,0 +1,33 @@ +module Scylla.Messages exposing (..) +import Scylla.Model exposing (Model) +import Scylla.Sync exposing (RoomEvent) +import Scylla.Login exposing (Username) + +type Message = + SendingTextMessage String Int + | SyncMessage RoomEvent + +extractMessageEvents : List RoomEvent -> List Message +extractMessageEvents es = List.map SyncMessage + <| List.filter (\e -> e.type_ == "m.room.message") es + +messageUsername : Model -> Message -> Username +messageUsername m msg = case msg of + SendingTextMessage _ _ -> m.loginUsername + SyncMessage re -> re.sender + +mergeMessages : Model -> List Message -> List (Username, List Message) +mergeMessages m xs = + let + initialState = (Nothing, [], []) + appendNamed mu ms msl = case mu of + Just u -> msl ++ [(u, ms)] + Nothing -> msl + foldFunction msg (pu, ms, msl) = + let + nu = Just <| messageUsername m 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 + in + appendNamed fmu fms fmsl diff --git a/src/Scylla/Views.elm b/src/Scylla/Views.elm index b5ca917..d301b7e 100644 --- a/src/Scylla/Views.elm +++ b/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.Messages exposing (..) import Scylla.Login exposing (Username) import Scylla.Http exposing (fullMediaUrl) import Scylla.Api exposing (ApiUrl) @@ -12,7 +13,7 @@ import Svg import Svg.Attributes import Url.Builder import Json.Decode as Decode -import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source) +import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source, p) import Html.Attributes exposing (type_, value, href, class, style, src, id, rows, controls, src) import Html.Events exposing (onInput, onClick, preventDefaultOn) import Dict exposing (Dict) @@ -140,8 +141,8 @@ joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg joinedRoomView m roomId jr = let events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline - renderedEvents = List.filterMap (eventView m) events - eventWrapper = eventWrapperView m roomId renderedEvents + renderedMessages = List.map (userMessagesView m) <| mergeMessages m <| extractMessageEvents events + messagesWrapper = messagesWrapperView m roomId renderedMessages typing = List.map (displayName m) <| roomTypingUsers jr typingText = String.join ", " typing typingSuffix = case List.length typing of @@ -163,7 +164,7 @@ joinedRoomView m roomId jr = in div [ class "room-wrapper" ] [ h2 [] [ text <| Maybe.withDefault "" <| roomName jr ] - , eventWrapper + , messagesWrapper , typingWrapper , messageInput ] @@ -187,58 +188,58 @@ iconView name = [ Svg.Attributes.class "feather-icon" ] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ] -eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg -eventWrapperView m rid es = div [ class "events-wrapper", id "events-wrapper" ] +messagesWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg +messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrapper" ] [ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ] - , table [ class "events-table" ] es + , table [ class "messages-table" ] es ] -eventView : Model -> RoomEvent -> Maybe (Html Msg) -eventView m re = +senderView : Model -> Username -> Html Msg +senderView m s = + span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ] + +userMessagesView : Model -> (Username, List Message) -> Html Msg +userMessagesView m (u, ms) = let - viewFunction = case re.type_ of - "m.room.message" -> Just messageView - _ -> Nothing - createRow mhtml = tr [] - [ td [] [ eventSenderView m re.sender ] - , td [] [ mhtml ] - ] + wrap h = div [ class "message" ] [ h ] in - Maybe.map createRow - <| Maybe.andThen (\f -> f m re) viewFunction + tr [] + [ td [] [ senderView m u ] + , td [] <| List.map wrap <| List.filterMap (messageView m) ms + ] -eventSenderView : Model -> Username -> Html Msg -eventSenderView m s = - span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ] +messageView : Model -> Message -> Maybe (Html Msg) +messageView m msg = case msg of + SendingTextMessage t _ -> Just <| div [] [ text t ] + SyncMessage re -> roomEventView m re -messageView : Model -> RoomEvent -> Maybe (Html Msg) -messageView m re = +roomEventView : Model -> RoomEvent -> Maybe (Html Msg) +roomEventView m re = let msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content in case msgtype of - Ok "m.text" -> messageTextView m re - Ok "m.image" -> messageImageView m re - Ok "m.file" -> messageFileView m re - Ok "m.video" -> messageVideoView m re + Ok "m.text" -> roomEventTextView m re + Ok "m.image" -> roomEventImageView m re + Ok "m.file" -> roomEventFileView m re + Ok "m.video" -> roomEventVideoView m re _ -> Nothing -messageTextView : Model -> RoomEvent -> Maybe (Html Msg) -messageTextView m re = +roomEventTextView : Model -> RoomEvent -> Maybe (Html Msg) +roomEventTextView m re = let body = Decode.decodeValue (Decode.field "body" Decode.string) re.content customHtml = Maybe.map Html.Parser.Util.toVirtualDom <| Maybe.andThen (Result.toMaybe << Html.Parser.run ) <| Result.toMaybe <| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content - wrap mtext = span [] [ text mtext ] in case customHtml of - Just c -> Just <| div [ class "markdown-wrapper" ] c - Nothing -> Maybe.map wrap <| Result.toMaybe body + Just c -> Just <| div [] c + Nothing -> Maybe.map (p [] << List.singleton << text) <| Result.toMaybe body -messageImageView : Model -> RoomEvent -> Maybe (Html Msg) -messageImageView m re = +roomEventImageView : Model -> RoomEvent -> Maybe (Html Msg) +roomEventImageView m re = let body = Decode.decodeValue (Decode.field "url" Decode.string) re.content in @@ -246,8 +247,8 @@ messageImageView m re = <| Maybe.map (contentRepositoryDownloadUrl m.apiUrl) <| Result.toMaybe body -messageFileView : Model -> RoomEvent -> Maybe (Html Msg) -messageFileView m re = +roomEventFileView : Model -> RoomEvent -> Maybe (Html Msg) +roomEventFileView m re = let decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string) fileData = Decode.decodeValue decoder re.content @@ -256,8 +257,8 @@ messageFileView m re = <| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl m.apiUrl url, name)) <| Result.toMaybe fileData -messageVideoView : Model -> RoomEvent -> Maybe (Html Msg) -messageVideoView m re = +roomEventVideoView : Model -> RoomEvent -> Maybe (Html Msg) +roomEventVideoView m re = let decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) diff --git a/static/scss/style.scss b/static/scss/style.scss index d991a46..8a33f50 100644 --- a/static/scss/style.scss +++ b/static/scss/style.scss @@ -212,7 +212,7 @@ div.message-wrapper { } } -div.events-wrapper { +div.messages-wrapper { overflow-y: scroll; flex-grow: 1; @@ -225,7 +225,7 @@ div.events-wrapper { } } -table.events-table { +table.messages-table { border-collapse: collapse; width: 100%; table-layout: fixed; @@ -258,7 +258,7 @@ table.events-table { } } -div.markdown-wrapper { +div.message { p { margin: 0px; } @@ -291,7 +291,8 @@ span.sender-wrapper { padding-right: 5px; display: inline-block; box-sizing: border-box; - text-align: center; + text-align: right; + font-weight: 800; width: 100%; text-overflow: ellipsis; overflow: hidden;