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 = 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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user