Compare commits

...

6 Commits

Author SHA1 Message Date
c7149aa5c9 Allow more images. 2019-03-15 18:56:17 -07:00
6e721d685b Grey out messages that are still sending. 2019-03-15 18:50:09 -07:00
011630a185 Remove messages once their ID is received. 2019-03-15 18:45:55 -07:00
f2a8acc59c Decode id strings. 2019-03-15 18:01:26 -07:00
1b0ad433b9 Add id field for sending messages.
The idea is to use this field to dismiss messages only when
a sync response with their id arrives.
2019-03-15 18:01:07 -07:00
7241d112b0 Add notification counts to page title. 2019-03-15 17:44:54 -07:00
7 changed files with 73 additions and 15 deletions

View File

@ -60,7 +60,13 @@ init _ url key =
view : Model -> Browser.Document Msg view : Model -> Browser.Document Msg
view m = view m =
{ title = "Scylla" let
notificationString = totalNotificationCountString m.sync
titleString = case notificationString of
Nothing -> "Scylla"
Just s -> s ++ " Scylla"
in
{ title = titleString
, body = viewFull m , body = viewFull m
} }
@ -81,14 +87,14 @@ update msg model = case msg of
ReceiveUserData s r -> updateUserData model s r ReceiveUserData s r -> updateUserData model s r
ChangeRoomText r t -> updateChangeRoomText model r t ChangeRoomText r t -> updateChangeRoomText model r t
SendRoomText r -> updateSendRoomText model r SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse t r -> ({ model | sending = Dict.remove t model.sending }, Cmd.none) SendRoomTextResponse t r -> updateSendRoomTextResponse model t r
ReceiveCompletedReadMarker r -> (model, Cmd.none) ReceiveCompletedReadMarker r -> (model, Cmd.none)
ReceiveCompletedTypingIndicator r -> (model, Cmd.none) ReceiveCompletedTypingIndicator r -> (model, Cmd.none)
ReceiveStoreData d -> updateStoreData model d ReceiveStoreData d -> updateStoreData model d
TypingTick _ -> updateTypingTick model TypingTick _ -> updateTypingTick model
History r -> updateHistory model r History r -> updateHistory model r
ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr
SendImages rid -> (model, Select.files [ "image/png" ] <| ImagesSelected rid) SendImages rid -> (model, Select.files [ "image/jpeg", "image/png", "image/gif" ] <| ImagesSelected rid)
SendFiles rid -> (model, Select.files [ "application/*" ] <| FilesSelected rid) SendFiles rid -> (model, Select.files [ "application/*" ] <| FilesSelected rid)
ImagesSelected rid f fs -> updateUploadSelected model rid f fs (ImageUploadComplete rid) ImagesSelected rid f fs -> updateUploadSelected model rid f fs (ImageUploadComplete rid)
FilesSelected rid f fs -> updateUploadSelected model rid f fs (FileUploadComplete rid) FilesSelected rid f fs -> updateUploadSelected model rid f fs (FileUploadComplete rid)
@ -103,6 +109,17 @@ update msg model = case msg of
requestScrollCmd : Cmd Msg requestScrollCmd : Cmd Msg
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper") requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
updateSendRoomTextResponse m t r =
let
updateFunction newId msg = case msg of
Just (rid, { body, id }) -> Just (rid, { body = body, id = Just newId })
Nothing -> Nothing
in
case r of
Ok s -> ({ m | sending = Dict.update t (updateFunction s) m.sending }, Cmd.none)
Err e -> ({ m | sending = Dict.remove t m.sending }, Cmd.none)
updateDismissError : Model -> Int -> (Model, Cmd Msg) updateDismissError : Model -> Int -> (Model, Cmd Msg)
updateDismissError m i = ({ m | errors = (List.take i m.errors) ++ (List.drop (i+1) m.errors)}, Cmd.none) updateDismissError m i = ({ m | errors = (List.take i m.errors) ++ (List.drop (i+1) m.errors)}, Cmd.none)
@ -115,7 +132,7 @@ updateMarkdown m { roomId, text, markdown } =
sendMessageCmd = sendMarkdownMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) roomId text markdown sendMessageCmd = sendMarkdownMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) roomId text markdown
newModel = newModel =
{ m | transactionId = m.transactionId + 1 { m | transactionId = m.transactionId + 1
, sending = Dict.insert (m.transactionId + 1) (roomId, TextMessage text) m.sending , sending = Dict.insert (m.transactionId + 1) (roomId, { body = TextMessage text, id = Nothing }) m.sending
} }
in in
(newModel, Cmd.batch [ storeValueCmd, sendMessageCmd, requestScrollCmd ]) (newModel, Cmd.batch [ storeValueCmd, sendMessageCmd, requestScrollCmd ])
@ -322,9 +339,11 @@ updateSyncResponse model r notify =
setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of 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 (Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
_ -> Cmd.none _ -> Cmd.none
receivedEvents sr = List.map Just <| allTimelineEventIds sr
sending sr = Dict.filter (\_ (rid, { body, id }) -> not <| List.member id <| receivedEvents sr) model.sending
in in
case r of case r of
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr, sending = sending (mergeSyncResponse model.sync sr) }, Cmd.batch
[ syncCmd [ syncCmd
, newUserCmd sr , newUserCmd sr
, notificationCmd sr , notificationCmd sr

View File

@ -7,6 +7,7 @@ import Scylla.Login exposing (loginResponseDecoder, Username, Password)
import Scylla.UserData exposing (userDataDecoder, UserData) import Scylla.UserData exposing (userDataDecoder, UserData)
import Url.Builder import Url.Builder
import Json.Encode exposing (object, string, int, bool, list) import Json.Encode exposing (object, string, int, bool, list)
import Json.Decode as Decode exposing (field)
import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever) import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever)
import File exposing (File, name, mime) import File exposing (File, name, mime)
import Url.Builder as Builder import Url.Builder as Builder
@ -75,7 +76,7 @@ getHistory apiUrl token room prevBatch = request
, tracker = Nothing , tracker = Nothing
} }
sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error () -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error String -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg
sendMessage apiUrl token transactionId room msg contents = request sendMessage apiUrl token transactionId room msg contents = request
{ method = "PUT" { method = "PUT"
, headers = authenticatedHeaders token , headers = authenticatedHeaders token
@ -84,7 +85,7 @@ sendMessage apiUrl token transactionId room msg contents = request
++ "/send/" ++ "m.room.message" ++ "/send/" ++ "m.room.message"
++ "/" ++ (String.fromInt transactionId) ++ "/" ++ (String.fromInt transactionId)
, body = jsonBody <| object contents , body = jsonBody <| object contents
, expect = expectWhatever msg , expect = expectJson msg (field "event_id" Decode.string)
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }

View File

@ -2,7 +2,12 @@ module Scylla.Messages exposing (..)
import Scylla.Sync exposing (RoomEvent) import Scylla.Sync exposing (RoomEvent)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
type SendingMessage = TextMessage String type SendingMessageBody = TextMessage String
type alias SendingMessage =
{ body : SendingMessageBody
, id : Maybe String
}
type Message = type Message =
Sending SendingMessage Sending SendingMessage

View File

@ -44,7 +44,7 @@ type Msg =
| ChangeRoute Route -- URL changes | ChangeRoute Route -- URL changes
| ChangeRoomText String String -- Change to a room's input text | ChangeRoomText String String -- Change to a room's input text
| SendRoomText String -- Sends a message typed into a given room's input | SendRoomText String -- Sends a message typed into a given room's input
| SendRoomTextResponse Int (Result Http.Error ()) -- A send message response finished | SendRoomTextResponse Int (Result Http.Error String) -- A send message response finished
| ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe) | 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. | ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport.
| ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished
@ -63,8 +63,8 @@ type Msg =
| FilesSelected RoomId File (List File) | FilesSelected RoomId File (List File)
| ImageUploadComplete RoomId File (Result Http.Error String) | ImageUploadComplete RoomId File (Result Http.Error String)
| FileUploadComplete RoomId File (Result Http.Error String) | FileUploadComplete RoomId File (Result Http.Error String)
| SendImageResponse (Result Http.Error ()) | SendImageResponse (Result Http.Error String)
| SendFileResponse (Result Http.Error ()) | SendFileResponse (Result Http.Error String)
| ReceiveMarkdown MarkdownResponse | ReceiveMarkdown MarkdownResponse
| DismissError Int | DismissError Int
| AttemptReconnect | AttemptReconnect

View File

@ -476,6 +476,9 @@ allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events
<| List.filterMap .timeline <| List.filterMap .timeline
<| Dict.values dict <| Dict.values dict
allTimelineEventIds : SyncResponse -> List String
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
allTimelineEvents : SyncResponse -> List RoomEvent allTimelineEvents : SyncResponse -> List RoomEvent
allTimelineEvents s = allTimelineEvents s =
let let
@ -493,6 +496,32 @@ joinedRoomsTimelineEvents s =
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline)) <| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
<| Maybe.andThen .join s.rooms <| Maybe.andThen .join s.rooms
totalNotificationCountString : SyncResponse -> Maybe String
totalNotificationCountString sr =
let
(h, n) = totalNotificationCounts sr
suffix = case h of
0 -> ""
_ -> "!"
in
case n of
0 -> Nothing
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
totalNotificationCounts : SyncResponse -> (Int, Int)
totalNotificationCounts sr =
let
rooms = Maybe.withDefault []
<| Maybe.map (Dict.values)
<| Maybe.andThen (.join) sr.rooms
zeroDefault = Maybe.withDefault 0
getCounts = Maybe.map (\cs -> (zeroDefault cs.highlightCount, zeroDefault cs.notificationCount))
<< .unreadNotifications
sumCounts (h1, n1) (h2, n2) = (h1 + h2, n1 + n2)
in
List.foldl sumCounts (0, 0)
<| List.filterMap getCounts rooms
-- Business Logic: Room Info -- Business Logic: Room Info
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
roomAccountData jr et = roomAccountData jr et =

View File

@ -213,8 +213,8 @@ messageView m msg = case msg of
Received re -> roomEventView m re Received re -> roomEventView m re
sendingMessageView : Model -> SendingMessage -> Html Msg sendingMessageView : Model -> SendingMessage -> Html Msg
sendingMessageView m msg = case msg of sendingMessageView m msg = case msg.body of
TextMessage t -> text t TextMessage t -> span [ class "sending"] [ text t ]
roomEventView : Model -> RoomEvent -> Maybe (Html Msg) roomEventView : Model -> RoomEvent -> Maybe (Html Msg)
roomEventView m re = roomEventView m re =

View File

@ -249,6 +249,10 @@ table.messages-table {
max-height: 400px; max-height: 400px;
} }
.sending {
color: grey;
}
video { video {
max-width: 90%; max-width: 90%;
max-height: 400px; max-height: 400px;