Compare commits
5 Commits
db2def5388
...
3b1dabd624
Author | SHA1 | Date | |
---|---|---|---|
3b1dabd624 | |||
1d50c5b1e4 | |||
360b7be281 | |||
06799194e4 | |||
8623eb8dfd |
19
src/Main.elm
19
src/Main.elm
|
@ -111,6 +111,12 @@ 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")
|
||||||
|
|
||||||
|
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 : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg)
|
||||||
updateSendRoomTextResponse m t r =
|
updateSendRoomTextResponse m t r =
|
||||||
let
|
let
|
||||||
|
@ -173,15 +179,14 @@ updateUploadSelected m rid f fs msg =
|
||||||
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
updateHistoryResponse : Model -> RoomId -> Result Http.Error HistoryResponse -> (Model, Cmd Msg)
|
||||||
updateHistoryResponse m r hr =
|
updateHistoryResponse m r hr =
|
||||||
let
|
let
|
||||||
newUsersCmd h = Cmd.batch
|
userDataCmd h = newUsersCmd m
|
||||||
<| List.map (userData m.apiUrl (Maybe.withDefault "" m.token))
|
|
||||||
<| newUsers m
|
<| newUsers m
|
||||||
<| uniqueBy (\s -> s)
|
<| uniqueBy identity
|
||||||
<| List.map .sender
|
<| List.map .sender
|
||||||
<| h.chunk
|
<| h.chunk
|
||||||
in
|
in
|
||||||
case hr of
|
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)
|
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
|
||||||
|
|
||||||
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
||||||
|
@ -307,9 +312,7 @@ updateSyncResponse model r notify =
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.sync.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| Result.map .nextBatch r
|
||||||
syncCmd = sync model.apiUrl token nextBatch
|
syncCmd = sync model.apiUrl token nextBatch
|
||||||
newUserCmd sr = Cmd.batch
|
userDataCmd sr = newUsersCmd model
|
||||||
<| List.map (userData model.apiUrl
|
|
||||||
<| Maybe.withDefault "" model.token)
|
|
||||||
<| newUsers model
|
<| newUsers model
|
||||||
<| allUsers sr
|
<| allUsers sr
|
||||||
notification sr = findFirstBy
|
notification sr = findFirstBy
|
||||||
|
@ -354,7 +357,7 @@ updateSyncResponse model r notify =
|
||||||
Ok sr -> (newModel sr
|
Ok sr -> (newModel sr
|
||||||
, Cmd.batch
|
, Cmd.batch
|
||||||
[ syncCmd
|
[ syncCmd
|
||||||
, newUserCmd sr
|
, userDataCmd sr
|
||||||
, notificationCmd sr
|
, notificationCmd sr
|
||||||
, setScrollCmd sr
|
, setScrollCmd sr
|
||||||
, setReadReceiptCmd sr
|
, setReadReceiptCmd sr
|
||||||
|
|
|
@ -1,30 +1,21 @@
|
||||||
module Scylla.AccountData exposing (..)
|
module Scylla.AccountData exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
|
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
|
||||||
import Json.Decode as Decode
|
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
|
directMessagesDecoder : Decode.Decoder DirectMessages
|
||||||
notificationSettingDecoder =
|
directMessagesDecoder =
|
||||||
let
|
Decode.dict (Decode.list Decode.string)
|
||||||
checkString s = case s of
|
|> Decode.map (invertDirectMessages)
|
||||||
"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
|
|
||||||
|
|
||||||
roomNotificationSetting : JoinedRoom -> NotificationSetting
|
invertDirectMessages : DirectMessagesRaw -> DirectMessages
|
||||||
roomNotificationSetting jr = Maybe.withDefault Normal
|
invertDirectMessages dmr =
|
||||||
<| Maybe.andThen Result.toMaybe
|
Dict.foldl
|
||||||
<| Maybe.map (Decode.decodeValue notificationSettingDecoder)
|
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
|
||||||
<| roomAccountData jr "com.danilafe.scylla.notifications"
|
Dict.empty
|
||||||
|
dmr
|
||||||
roomIdNotificationSetting : SyncResponse -> String -> NotificationSetting
|
|
||||||
roomIdNotificationSetting sr s = Maybe.withDefault Normal
|
|
||||||
<| Maybe.map roomNotificationSetting
|
|
||||||
<| Maybe.andThen (Dict.get s)
|
|
||||||
<| Maybe.andThen .join sr.rooms
|
|
||||||
|
|
||||||
|
|
|
@ -149,7 +149,7 @@ userData apiUrl token username = request
|
||||||
, tracker = Nothing
|
, 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 =
|
setReadMarkers apiUrl token roomId fullyRead readReceipt =
|
||||||
let
|
let
|
||||||
readReciptFields = case readReceipt of
|
readReciptFields = case readReceipt of
|
||||||
|
@ -176,3 +176,14 @@ sendTypingIndicator apiUrl token room user isTyping timeout = request
|
||||||
, timeout = Nothing
|
, timeout = Nothing
|
||||||
, tracker = 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
|
||||||
|
}
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
module Scylla.Model exposing (..)
|
module Scylla.Model exposing (..)
|
||||||
import Scylla.Api 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.Login exposing (LoginResponse, Username, Password)
|
||||||
import Scylla.UserData exposing (UserData)
|
import Scylla.UserData exposing (UserData)
|
||||||
import Scylla.Route exposing (Route(..), RoomId)
|
import Scylla.Route exposing (Route(..), RoomId)
|
||||||
|
@ -59,25 +60,25 @@ type Msg =
|
||||||
| TypingTick Posix -- Tick for updating the typing status
|
| TypingTick Posix -- Tick for updating the typing status
|
||||||
| History RoomId -- Load history for a room
|
| History RoomId -- Load history for a room
|
||||||
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
|
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
|
||||||
| SendImages RoomId
|
| SendImages RoomId -- Image selection triggered
|
||||||
| SendFiles RoomId
|
| SendFiles RoomId -- File selection triggered
|
||||||
| ImagesSelected RoomId File (List File)
|
| ImagesSelected RoomId File (List File) -- Images to send selected
|
||||||
| FilesSelected RoomId File (List File)
|
| FilesSelected RoomId File (List File) -- Files to send selected
|
||||||
| ImageUploadComplete RoomId File (Result Http.Error String)
|
| ImageUploadComplete RoomId File (Result Http.Error String) -- Image has been uploaded
|
||||||
| FileUploadComplete RoomId File (Result Http.Error String)
|
| FileUploadComplete RoomId File (Result Http.Error String) -- File has been uploaded
|
||||||
| SendImageResponse (Result Http.Error String)
|
| SendImageResponse (Result Http.Error String) -- Server responded to image
|
||||||
| SendFileResponse (Result Http.Error String)
|
| SendFileResponse (Result Http.Error String) -- Server responded to file
|
||||||
| ReceiveMarkdown MarkdownResponse
|
| ReceiveMarkdown MarkdownResponse -- Markdown was rendered
|
||||||
| DismissError Int
|
| DismissError Int -- User dismisses error
|
||||||
| AttemptReconnect
|
| AttemptReconnect -- User wants to reconnect to server
|
||||||
| UpdateSearchText String
|
| UpdateSearchText String -- Change search text in room list
|
||||||
|
|
||||||
displayName : Dict String UserData -> Username -> String
|
displayName : Dict String UserData -> Username -> String
|
||||||
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
|
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
|
||||||
|
|
||||||
roomDisplayName : Model -> RoomId -> String
|
roomDisplayName : Dict RoomId String -> RoomId -> String
|
||||||
roomDisplayName m rid =
|
roomDisplayName rd rid =
|
||||||
Maybe.withDefault "<No Name>" <| Dict.get rid m.roomNames
|
Maybe.withDefault "<No Name>" <| Dict.get rid rd
|
||||||
|
|
||||||
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
|
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
|
||||||
computeRoomDisplayName ud ad rid jr =
|
computeRoomDisplayName ud ad rid jr =
|
||||||
|
|
|
@ -13,12 +13,6 @@ type alias Notification =
|
||||||
port sendNotificationPort : Notification -> Cmd msg
|
port sendNotificationPort : Notification -> Cmd msg
|
||||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
port onNotificationClickPort : (String -> msg) -> Sub msg
|
||||||
|
|
||||||
producesNotification : NotificationSetting -> RoomEvent -> Bool
|
|
||||||
producesNotification ns re = case ns of
|
|
||||||
Normal -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
|
|
||||||
notificationText : RoomEvent -> String
|
notificationText : RoomEvent -> String
|
||||||
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
||||||
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
||||||
|
@ -31,6 +25,5 @@ joinedRoomNotificationEvents s =
|
||||||
in
|
in
|
||||||
List.sortBy (\(k, v) -> v.originServerTs)
|
List.sortBy (\(k, v) -> v.originServerTs)
|
||||||
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
||||||
<| Dict.map (\k v -> List.filter (producesNotification (roomIdNotificationSetting s k)) v)
|
|
||||||
<| joinedRoomsTimelineEvents s
|
<| joinedRoomsTimelineEvents s
|
||||||
|
|
||||||
|
|
|
@ -258,22 +258,6 @@ historyResponseDecoder =
|
||||||
|> required "end" string
|
|> required "end" string
|
||||||
|> required "chunk" (list roomEventDecoder)
|
|> 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
|
-- Business Logic: Helper Functions
|
||||||
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
|
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
|
||||||
groupBy f xs =
|
groupBy f xs =
|
||||||
|
|
|
@ -112,14 +112,14 @@ homeserverView m hs rs =
|
||||||
let
|
let
|
||||||
roomList = div [ class "rooms-list" ]
|
roomList = div [ class "rooms-list" ]
|
||||||
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
<| 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
|
in
|
||||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||||
|
|
||||||
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||||
roomListElementView m rid jr =
|
roomListElementView m rid jr =
|
||||||
let
|
let
|
||||||
name = roomDisplayName m rid
|
name = roomDisplayName m.roomNames rid
|
||||||
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
||||||
isCurrentRoom = case currentRoomId m of
|
isCurrentRoom = case currentRoomId m of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
@ -183,7 +183,7 @@ joinedRoomView m roomId jr =
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
div [ class "room-wrapper" ]
|
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
|
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
|
||||||
, messageInput
|
, messageInput
|
||||||
, typingWrapper
|
, typingWrapper
|
||||||
|
|
Loading…
Reference in New Issue
Block a user