Compare commits

...

5 Commits

7 changed files with 57 additions and 74 deletions

View File

@ -111,6 +111,12 @@ update msg model = case msg of
requestScrollCmd : Cmd Msg
requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper")
newUsersCmd : Model -> List Username -> Cmd Msg
newUsersCmd m us = m.token
|> Maybe.map (\t -> List.map (userData m.apiUrl t) us)
|> Maybe.withDefault []
|> Cmd.batch
updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
updateSendRoomTextResponse m t r =
let
@ -173,15 +179,14 @@ updateUploadSelected m rid f fs msg =
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
updateHistoryResponse m r hr =
let
newUsersCmd h = Cmd.batch
<| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
userDataCmd h = newUsersCmd m
<| newUsers m
<| uniqueBy (\s -> s)
<| uniqueBy identity
<| List.map .sender
<| h.chunk
in
case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, newUsersCmd h)
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h)
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
@ -307,9 +312,7 @@ updateSyncResponse model r notify =
nextBatch = Result.withDefault model.sync.nextBatch
<| Result.map .nextBatch r
syncCmd = sync model.apiUrl token nextBatch
newUserCmd sr = Cmd.batch
<| List.map (userData model.apiUrl
<| Maybe.withDefault "" model.token)
userDataCmd sr = newUsersCmd model
<| newUsers model
<| allUsers sr
notification sr = findFirstBy
@ -354,7 +357,7 @@ updateSyncResponse model r notify =
Ok sr -> (newModel sr
, Cmd.batch
[ syncCmd
, newUserCmd sr
, userDataCmd sr
, notificationCmd sr
, setScrollCmd sr
, setReadReceiptCmd sr

View File

@ -1,30 +1,21 @@
module Scylla.AccountData exposing (..)
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
import Json.Decode as Decode
import Dict
import Json.Encode as Encode
import Dict exposing (Dict)
type NotificationSetting = Normal | MentionsOnly | None
type alias DirectMessages = Dict String String
type alias DirectMessagesRaw = Dict String (List String)
notificationSettingDecoder : Decode.Decoder NotificationSetting
notificationSettingDecoder =
let
checkString s = case s of
"Normal" -> Decode.succeed Normal
"MentionsOnly" -> Decode.succeed MentionsOnly
"None" -> Decode.succeed None
_ -> Decode.fail "Not a valid notification setting"
in
Decode.andThen checkString Decode.string
directMessagesDecoder : Decode.Decoder DirectMessages
directMessagesDecoder =
Decode.dict (Decode.list Decode.string)
|> Decode.map (invertDirectMessages)
roomNotificationSetting : JoinedRoom -> NotificationSetting
roomNotificationSetting jr = Maybe.withDefault Normal
<| Maybe.andThen Result.toMaybe
<| Maybe.map (Decode.decodeValue notificationSettingDecoder)
<| roomAccountData jr "com.danilafe.scylla.notifications"
roomIdNotificationSetting : SyncResponse -> String -> NotificationSetting
roomIdNotificationSetting sr s = Maybe.withDefault Normal
<| Maybe.map roomNotificationSetting
<| Maybe.andThen (Dict.get s)
<| Maybe.andThen .join sr.rooms
invertDirectMessages : DirectMessagesRaw -> DirectMessages
invertDirectMessages dmr =
Dict.foldl
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
Dict.empty
dmr

View File

@ -149,7 +149,7 @@ userData apiUrl token username = request
, tracker = Nothing
}
setReadMarkers : ApiUrl -> ApiToken -> String -> RoomId -> Maybe String -> Cmd Msg
setReadMarkers : ApiUrl -> ApiToken -> RoomId -> String -> Maybe String -> Cmd Msg
setReadMarkers apiUrl token roomId fullyRead readReceipt =
let
readReciptFields = case readReceipt of
@ -176,3 +176,14 @@ sendTypingIndicator apiUrl token room user isTyping timeout = request
, timeout = Nothing
, tracker = Nothing
}
setRoomAccountData : ApiUrl -> ApiToken -> Username -> RoomId -> String -> Decode.Value -> Msg -> Cmd Msg
setRoomAccountData apiUrl token user roomId key value msg = request
{ method = "PUT"
, headers = authenticatedHeaders token
, url = (fullClientUrl apiUrl) ++ "/user/" ++ user ++ "/rooms/" ++ roomId ++ "/account_data/" ++ key
, body = jsonBody value
, expect = expectWhatever (\_ -> msg)
, timeout = Nothing
, tracker = Nothing
}

View File

@ -1,6 +1,7 @@
module Scylla.Model exposing (..)
import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, directMessagesDecoder, AccountData)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData)
import Scylla.AccountData exposing (directMessagesDecoder)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
@ -59,25 +60,25 @@ type Msg =
| TypingTick Posix -- Tick for updating the typing status
| History RoomId -- Load history for a room
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
| SendImages RoomId
| SendFiles RoomId
| ImagesSelected RoomId File (List File)
| FilesSelected RoomId File (List File)
| ImageUploadComplete RoomId File (Result Http.Error String)
| FileUploadComplete RoomId File (Result Http.Error String)
| SendImageResponse (Result Http.Error String)
| SendFileResponse (Result Http.Error String)
| ReceiveMarkdown MarkdownResponse
| DismissError Int
| AttemptReconnect
| UpdateSearchText String
| SendImages RoomId -- Image selection triggered
| SendFiles RoomId -- File selection triggered
| ImagesSelected RoomId File (List File) -- Images to send selected
| FilesSelected RoomId File (List File) -- Files to send selected
| ImageUploadComplete RoomId File (Result Http.Error String) -- Image has been uploaded
| FileUploadComplete RoomId File (Result Http.Error String) -- File has been uploaded
| SendImageResponse (Result Http.Error String) -- Server responded to image
| SendFileResponse (Result Http.Error String) -- Server responded to file
| ReceiveMarkdown MarkdownResponse -- Markdown was rendered
| DismissError Int -- User dismisses error
| AttemptReconnect -- User wants to reconnect to server
| UpdateSearchText String -- Change search text in room list
displayName : Dict String UserData -> Username -> String
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
roomDisplayName : Model -> RoomId -> String
roomDisplayName m rid =
Maybe.withDefault "<No Name>" <| Dict.get rid m.roomNames
roomDisplayName : Dict RoomId String -> RoomId -> String
roomDisplayName rd rid =
Maybe.withDefault "<No Name>" <| Dict.get rid rd
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
computeRoomDisplayName ud ad rid jr =

View File

@ -13,12 +13,6 @@ type alias Notification =
port sendNotificationPort : Notification -> Cmd msg
port onNotificationClickPort : (String -> msg) -> Sub msg
producesNotification : NotificationSetting -> RoomEvent -> Bool
producesNotification ns re = case ns of
Normal -> True
_ -> False
notificationText : RoomEvent -> String
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
@ -31,6 +25,5 @@ joinedRoomNotificationEvents s =
in
List.sortBy (\(k, v) -> v.originServerTs)
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
<| Dict.map (\k v -> List.filter (producesNotification (roomIdNotificationSetting s k)) v)
<| joinedRoomsTimelineEvents s

View File

@ -258,22 +258,6 @@ historyResponseDecoder =
|> required "end" string
|> required "chunk" (list roomEventDecoder)
-- Direct Messages
type alias DirectMessages = Dict String String
type alias DirectMessagesRaw = Dict String (List String)
directMessagesDecoder : Decoder DirectMessages
directMessagesDecoder =
Decode.dict (Decode.list Decode.string)
|> Decode.map (invertDirectMessages)
invertDirectMessages : DirectMessagesRaw -> DirectMessages
invertDirectMessages dmr =
Dict.foldl
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
Dict.empty
dmr
-- Business Logic: Helper Functions
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs =

View File

@ -112,14 +112,14 @@ homeserverView m hs rs =
let
roomList = div [ class "rooms-list" ]
<| List.map (\(rid, r) -> roomListElementView m rid r)
<| List.sortBy (\(rid, r) -> roomDisplayName m rid) rs
<| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
roomListElementView m rid jr =
let
name = roomDisplayName m rid
name = roomDisplayName m.roomNames rid
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of
Nothing -> False
@ -183,7 +183,7 @@ joinedRoomView m roomId jr =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m roomId ]
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
, messageInput
, typingWrapper