Compare commits

..

No commits in common. "5f8751e14223a9a26d3d92a39681d83beca3e113" and "1703c091a76e74ca4fbbd8e688003e0303a45245" have entirely different histories.

7 changed files with 69 additions and 152 deletions

View File

@ -2,8 +2,6 @@ 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 (..)
@ -80,7 +78,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 t r -> ({ model | sending = Dict.remove t model.sending }, Cmd.none)
SendRoomTextResponse r -> (model, Cmd.none)
ReceiveCompletedReadMarker r -> (model, Cmd.none)
ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d
@ -109,12 +107,8 @@ 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
(newModel, Cmd.batch [ storeValueCmd, sendMessageCmd ])
({ m | transactionId = m.transactionId + 1 }, Cmd.batch [ storeValueCmd, sendMessageCmd ])
updateFileUploadComplete : Model -> RoomId -> File -> (Result Http.Error String) -> (Model, Cmd Msg)
updateFileUploadComplete m rid mime ur =
@ -236,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 "messages-wrapper" vp.viewport.x vp.scene.height
then Task.attempt ViewportChangeComplete <| setViewportOf "events-wrapper" vp.viewport.x vp.scene.height
else Cmd.none
in
(m, Result.withDefault Cmd.none <| Result.map cmd vr)
@ -314,7 +308,7 @@ updateSyncResponse model r notify =
setScrollCmd sr = if List.isEmpty
<| roomMessages sr
then Cmd.none
else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
else Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "events-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 transactionId)
sendMarkdownMessage apiUrl token transactionId room message md = sendMessage apiUrl token transactionId room SendRoomTextResponse
[ ("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 transactionId)
sendTextMessage apiUrl token transactionId room message = sendMessage apiUrl token transactionId room SendRoomTextResponse
[ ("msgtype", string "m.text")
, ("body", string message)
]

View File

@ -1,30 +0,0 @@
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,7 +4,6 @@ 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
@ -27,8 +26,7 @@ type alias Model =
, apiUrl : ApiUrl
, sync : SyncResponse
, errors : List String
, roomText : Dict RoomId String
, sending : Dict Int (RoomId, SendingMessage)
, roomText : Dict String String
, transactionId : Int
, userData : Dict Username UserData
, connected : Bool
@ -44,7 +42,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 Int (Result Http.Error ()) -- A send message response finished
| SendRoomTextResponse (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
@ -81,12 +79,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 =
Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m
let
roomDict = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
in
Maybe.andThen (\s -> Dict.get s roomDict) <| currentRoomId m
currentRoomId : Model -> Maybe RoomId
currentRoomId m = case m.route of

View File

@ -1,37 +0,0 @@
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,8 +3,6 @@ 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)
@ -14,7 +12,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, p)
import Html exposing (Html, Attribute, div, input, text, button, div, span, a, h2, h3, table, td, tr, img, textarea, video, source)
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)
@ -43,8 +41,9 @@ stringColor s =
viewFull : Model -> List (Html Msg)
viewFull model =
let
room r = Maybe.map (\rd -> (r, rd))
<| roomData model r
room r = Maybe.map (\jr -> (r, jr))
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join model.sync.rooms
core = case model.route of
Login -> loginView model
Base -> baseView model Nothing
@ -60,7 +59,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, RoomData) -> Html Msg
baseView : Model -> Maybe (String, JoinedRoom) -> Html Msg
baseView m jr =
let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
@ -137,12 +136,13 @@ loginView m = div [ class "login-wrapper" ]
, button [ onClick AttemptLogin ] [ text "Log In" ]
]
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
joinedRoomView m roomId rd =
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId jr =
let
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd
messagesWrapper = messagesWrapperView m roomId renderedMessages
typing = List.map (displayName m) <| roomTypingUsers rd.joinedRoom
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
typingText = String.join ", " typing
typingSuffix = case List.length typing of
0 -> ""
@ -162,8 +162,8 @@ joinedRoomView m roomId rd =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName rd.joinedRoom ]
, messagesWrapper
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
, eventWrapper
, typingWrapper
, messageInput
]
@ -187,62 +187,58 @@ iconView name =
[ Svg.Attributes.class "feather-icon"
] [ Svg.use [ Svg.Attributes.xlinkHref (url ++ "#" ++ name) ] [] ]
messagesWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg
messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrapper" ]
eventWrapperView : Model -> RoomId -> List (Html Msg) -> Html Msg
eventWrapperView m rid es = div [ class "events-wrapper", id "events-wrapper" ]
[ a [ class "history-link", onClick <| History rid ] [ text "Load older messages" ]
, table [ class "messages-table" ] es
, table [ class "events-table" ] es
]
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) =
eventView : Model -> RoomEvent -> Maybe (Html Msg)
eventView m re =
let
wrap h = div [ class "message" ] [ h ]
in
tr []
[ td [] [ senderView m u ]
, td [] <| List.map wrap <| List.filterMap (messageView m) ms
viewFunction = case re.type_ of
"m.room.message" -> Just messageView
_ -> Nothing
createRow mhtml = tr []
[ td [] [ eventSenderView m re.sender ]
, td [] [ mhtml ]
]
in
Maybe.map createRow
<| Maybe.andThen (\f -> f m re) viewFunction
messageView : Model -> Message -> Maybe (Html Msg)
messageView m msg = case msg of
Sending t -> Just <| sendingMessageView m t
Received re -> roomEventView m re
eventSenderView : Model -> Username -> Html Msg
eventSenderView m s =
span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
sendingMessageView : Model -> SendingMessage -> Html Msg
sendingMessageView m msg = case msg of
TextMessage t -> text t
roomEventView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventView m re =
messageView : Model -> RoomEvent -> Maybe (Html Msg)
messageView m re =
let
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
in
case msgtype of
Ok "m.text" -> roomEventTextView m re
Ok "m.image" -> roomEventImageView m re
Ok "m.file" -> roomEventFileView m re
Ok "m.video" -> roomEventVideoView m re
Ok "m.text" -> messageTextView m re
Ok "m.image" -> messageImageView m re
Ok "m.file" -> messageFileView m re
Ok "m.video" -> messageVideoView m re
_ -> Nothing
roomEventTextView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventTextView m re =
messageTextView : Model -> RoomEvent -> Maybe (Html Msg)
messageTextView 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 [] c
Nothing -> Maybe.map (p [] << List.singleton << text) <| Result.toMaybe body
Just c -> Just <| div [ class "markdown-wrapper" ] c
Nothing -> Maybe.map wrap <| Result.toMaybe body
roomEventImageView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventImageView m re =
messageImageView : Model -> RoomEvent -> Maybe (Html Msg)
messageImageView m re =
let
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
in
@ -250,8 +246,8 @@ roomEventImageView m re =
<| Maybe.map (contentRepositoryDownloadUrl m.apiUrl)
<| Result.toMaybe body
roomEventFileView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventFileView m re =
messageFileView : Model -> RoomEvent -> Maybe (Html Msg)
messageFileView 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
@ -260,8 +256,8 @@ roomEventFileView m re =
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl m.apiUrl url, name))
<| Result.toMaybe fileData
roomEventVideoView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventVideoView m re =
messageVideoView : Model -> RoomEvent -> Maybe (Html Msg)
messageVideoView m re =
let
decoder = Decode.map2 (\l r -> (l, r))
(Decode.field "url" Decode.string)

View File

@ -4,7 +4,6 @@ $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;
@ -17,8 +16,6 @@ $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;
}
@ -80,7 +77,6 @@ h2, h3 {
}
a.file-wrapper {
padding: 5px 0px 5px 0px;
display: flex;
align-items: center;
@ -145,7 +141,7 @@ div.base-wrapper {
height: 100%;
> div {
padding: 10px;
padding: 5px;
box-sizing: border-box;
}
}
@ -155,7 +151,6 @@ div.base-wrapper {
*/
div.rooms-wrapper {
flex-shrink: 0;
background-color: $background-color-light;
}
div.room-link-wrapper {
@ -191,8 +186,6 @@ div.room-wrapper {
display: flex;
height: 100%;
flex-direction: column;
box-shadow: $inset-shadow;
padding: 5px;
}
div.typing-wrapper {
@ -219,7 +212,7 @@ div.message-wrapper {
}
}
div.messages-wrapper {
div.events-wrapper {
overflow-y: scroll;
flex-grow: 1;
@ -232,7 +225,7 @@ div.messages-wrapper {
}
}
table.messages-table {
table.events-table {
border-collapse: collapse;
width: 100%;
table-layout: fixed;
@ -259,9 +252,13 @@ table.messages-table {
}
white-space: nowrap;
}
tr:nth-child(2n) {
background-color: $background-color-dark;
}
}
div.message {
div.markdown-wrapper {
p {
margin: 0px;
}
@ -284,7 +281,7 @@ div.message {
padding: 10px;
background-color: $background-color;
border-radius: 3px;
box-shadow: $inset-shadow;
box-shadow: inset 0px 0px 5px rgba(0, 0, 0, .15);
}
}
@ -294,8 +291,7 @@ span.sender-wrapper {
padding-right: 5px;
display: inline-block;
box-sizing: border-box;
text-align: right;
font-weight: 800;
text-align: center;
width: 100%;
text-overflow: ellipsis;
overflow: hidden;