Compare commits

...

6 Commits

Author SHA1 Message Date
5f8751e142 Update CSS. 2019-02-25 19:58:05 -08:00
5d519242be Display "still sending" messages. 2019-02-25 19:54:54 -08:00
2136bf34b9 Create an abstraction for room data.
Unless you specifically need the Sync data, this will be more useful,
since it stores the messages being sent and the like.
2019-02-25 18:09:39 -08:00
6c67e85ca5 Add shadows to room css. 2019-02-25 17:39:25 -08:00
be7ea33085 Remove the "every other row" darkening. 2019-02-25 17:26:52 -08:00
ce1580926c 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.
2019-02-25 16:44:47 -08:00
7 changed files with 152 additions and 69 deletions

View File

@ -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 =
@ -230,7 +236,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 +314,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

View File

@ -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)
]

30
src/Scylla/Messages.elm Normal file
View File

@ -0,0 +1,30 @@
module Scylla.Messages exposing (..)
import Scylla.Sync exposing (RoomEvent)
import Scylla.Login exposing (Username)
type SendingMessage = TextMessage String
type Message =
Sending SendingMessage
| Received RoomEvent
messageUsername : Username -> Message -> Username
messageUsername u msg = case msg of
Sending _ -> u
Received re -> re.sender
mergeMessages : Username -> List Message -> List (Username, List Message)
mergeMessages du 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 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
in
appendNamed fmu fms fmsl

View File

@ -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
@ -79,12 +81,12 @@ loginUrl = Url.Builder.absolute [ "login" ] []
newUsers : Model -> List Username -> List Username
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
joinedRooms : Model -> Dict RoomId JoinedRoom
joinedRooms m = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
currentRoom : Model -> Maybe JoinedRoom
currentRoom m =
let
roomDict = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
in
Maybe.andThen (\s -> Dict.get s roomDict) <| currentRoomId m
Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m
currentRoomId : Model -> Maybe RoomId
currentRoomId m = case m.route of

37
src/Scylla/Room.elm Normal file
View File

@ -0,0 +1,37 @@
module Scylla.Room exposing (..)
import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Messages exposing (..)
import Scylla.Route exposing (..)
import Dict
type alias RoomData =
{ joinedRoom : JoinedRoom
, sendingMessages : List (SendingMessage, Int)
, inputText : Maybe String
}
roomData : Model -> RoomId -> Maybe RoomData
roomData m rid =
case Dict.get rid (joinedRooms m) of
Just jr -> Just
{ joinedRoom = jr
, 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

View File

@ -3,6 +3,8 @@ import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Room exposing (..)
import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username)
import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl)
@ -12,7 +14,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)
@ -41,9 +43,8 @@ stringColor s =
viewFull : Model -> List (Html Msg)
viewFull model =
let
room r = Maybe.map (\jr -> (r, jr))
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join model.sync.rooms
room r = Maybe.map (\rd -> (r, rd))
<| roomData model r
core = case model.route of
Login -> loginView model
Base -> baseView model Nothing
@ -59,7 +60,7 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
errorView : Int -> String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
baseView : Model -> Maybe (String, JoinedRoom) -> Html Msg
baseView : Model -> Maybe (String, RoomData) -> Html Msg
baseView m jr =
let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
@ -136,13 +137,12 @@ loginView m = div [ class "login-wrapper" ]
, button [ onClick AttemptLogin ] [ text "Log In" ]
]
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId jr =
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
joinedRoomView m roomId rd =
let
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
renderedEvents = List.filterMap (eventView m) events
eventWrapper = eventWrapperView m roomId renderedEvents
typing = List.map (displayName m) <| roomTypingUsers jr
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
typingSuffix = case List.length typing of
0 -> ""
@ -162,8 +162,8 @@ joinedRoomView m roomId jr =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
, eventWrapper
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName rd.joinedRoom ]
, messagesWrapper
, typingWrapper
, messageInput
]
@ -187,58 +187,62 @@ 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
Sending t -> Just <| sendingMessageView m t
Received re -> roomEventView m re
messageView : Model -> RoomEvent -> Maybe (Html Msg)
messageView m re =
sendingMessageView : Model -> SendingMessage -> Html Msg
sendingMessageView m msg = case msg of
TextMessage t -> text t
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 +250,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 +260,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)

View File

@ -4,6 +4,7 @@ $primary-color-highlight: #4298C7;
$primary-color-light: #9FDBFB;
$background-color: #1b1e21;
$background-color-light: lighten($background-color, 4%);
$background-color-dark: darken($background-color, 4%);
$error-color: #f01d43;
@ -16,6 +17,8 @@ $inactive-input-border-color: darken($inactive-input-color, 10%);
$transition-duration: .125s;
$inset-shadow: inset 0px 0px 5px rgba(0, 0, 0, .25);
html, body {
height: 100vh;
}
@ -77,6 +80,7 @@ h2, h3 {
}
a.file-wrapper {
padding: 5px 0px 5px 0px;
display: flex;
align-items: center;
@ -141,7 +145,7 @@ div.base-wrapper {
height: 100%;
> div {
padding: 5px;
padding: 10px;
box-sizing: border-box;
}
}
@ -151,6 +155,7 @@ div.base-wrapper {
*/
div.rooms-wrapper {
flex-shrink: 0;
background-color: $background-color-light;
}
div.room-link-wrapper {
@ -186,6 +191,8 @@ div.room-wrapper {
display: flex;
height: 100%;
flex-direction: column;
box-shadow: $inset-shadow;
padding: 5px;
}
div.typing-wrapper {
@ -212,7 +219,7 @@ div.message-wrapper {
}
}
div.events-wrapper {
div.messages-wrapper {
overflow-y: scroll;
flex-grow: 1;
@ -225,7 +232,7 @@ div.events-wrapper {
}
}
table.events-table {
table.messages-table {
border-collapse: collapse;
width: 100%;
table-layout: fixed;
@ -252,13 +259,9 @@ table.events-table {
}
white-space: nowrap;
}
tr:nth-child(2n) {
background-color: $background-color-dark;
}
}
div.markdown-wrapper {
div.message {
p {
margin: 0px;
}
@ -281,7 +284,7 @@ div.markdown-wrapper {
padding: 10px;
background-color: $background-color;
border-radius: 3px;
box-shadow: inset 0px 0px 5px rgba(0, 0, 0, .15);
box-shadow: $inset-shadow;
}
}
@ -291,7 +294,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;