Compare commits
3 Commits
f6ce669fb4
...
f395259137
Author | SHA1 | Date | |
---|---|---|---|
f395259137 | |||
5d5418e9c6 | |||
b23c80f463 |
12
src/Main.elm
12
src/Main.elm
|
@ -52,6 +52,7 @@ init _ url key =
|
||||||
, sending = Dict.empty
|
, sending = Dict.empty
|
||||||
, transactionId = 0
|
, transactionId = 0
|
||||||
, userData = Dict.empty
|
, userData = Dict.empty
|
||||||
|
, roomNames = Dict.empty
|
||||||
, connected = True
|
, connected = True
|
||||||
, searchText = ""
|
, searchText = ""
|
||||||
}
|
}
|
||||||
|
@ -319,7 +320,7 @@ updateSyncResponse model r notify =
|
||||||
notificationCmd sr = if notify
|
notificationCmd sr = if notify
|
||||||
then Maybe.withDefault Cmd.none
|
then Maybe.withDefault Cmd.none
|
||||||
<| Maybe.map (\(s, e) -> sendNotificationPort
|
<| Maybe.map (\(s, e) -> sendNotificationPort
|
||||||
{ name = displayName model e.sender
|
{ name = displayName model.userData e.sender
|
||||||
, text = notificationText e
|
, text = notificationText e
|
||||||
, room = s
|
, room = s
|
||||||
}) <| notification sr
|
}) <| notification sr
|
||||||
|
@ -343,9 +344,16 @@ updateSyncResponse model r notify =
|
||||||
_ -> Cmd.none
|
_ -> Cmd.none
|
||||||
receivedEvents sr = List.map Just <| allTimelineEventIds sr
|
receivedEvents sr = List.map Just <| allTimelineEventIds sr
|
||||||
sending sr = Dict.filter (\_ (rid, { body, id }) -> not <| List.member id <| receivedEvents sr) model.sending
|
sending sr = Dict.filter (\_ (rid, { body, id }) -> not <| List.member id <| receivedEvents sr) model.sending
|
||||||
|
newSync sr = mergeSyncResponse model.sync sr
|
||||||
|
newModel sr =
|
||||||
|
{ model | sync = newSync sr
|
||||||
|
, sending = sending (mergeSyncResponse model.sync sr)
|
||||||
|
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
|
||||||
|
}
|
||||||
in
|
in
|
||||||
case r of
|
case r of
|
||||||
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr, sending = sending (mergeSyncResponse model.sync sr) }, Cmd.batch
|
Ok sr -> (newModel sr
|
||||||
|
, Cmd.batch
|
||||||
[ syncCmd
|
[ syncCmd
|
||||||
, newUserCmd sr
|
, newUserCmd sr
|
||||||
, notificationCmd sr
|
, notificationCmd sr
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
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)
|
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, directMessagesDecoder, AccountData)
|
||||||
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)
|
||||||
|
@ -13,7 +13,7 @@ import Url.Builder
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
import Time exposing (Posix)
|
import Time exposing (Posix)
|
||||||
import File exposing (File)
|
import File exposing (File)
|
||||||
import Json.Decode
|
import Json.Decode as Decode
|
||||||
import Browser
|
import Browser
|
||||||
import Http
|
import Http
|
||||||
import Url exposing (Url)
|
import Url exposing (Url)
|
||||||
|
@ -31,6 +31,7 @@ type alias Model =
|
||||||
, sending : Dict Int (RoomId, SendingMessage)
|
, sending : Dict Int (RoomId, SendingMessage)
|
||||||
, transactionId : Int
|
, transactionId : Int
|
||||||
, userData : Dict Username UserData
|
, userData : Dict Username UserData
|
||||||
|
, roomNames : Dict RoomId String
|
||||||
, connected : Bool
|
, connected : Bool
|
||||||
, searchText : String
|
, searchText : String
|
||||||
}
|
}
|
||||||
|
@ -54,7 +55,7 @@ type Msg =
|
||||||
| ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data
|
| ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data
|
||||||
| ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed
|
| ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed
|
||||||
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
|
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
|
||||||
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
|
| ReceiveStoreData Decode.Value -- We are send back a value on request from localStorage.
|
||||||
| 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
|
||||||
|
@ -71,27 +72,40 @@ type Msg =
|
||||||
| AttemptReconnect
|
| AttemptReconnect
|
||||||
| UpdateSearchText String
|
| UpdateSearchText String
|
||||||
|
|
||||||
displayName : Model -> Username -> String
|
displayName : Dict String UserData -> Username -> String
|
||||||
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
|
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
|
||||||
|
|
||||||
roomDisplayName : Model -> JoinedRoom -> String
|
roomDisplayName : Model -> RoomId -> String
|
||||||
roomDisplayName m jr =
|
roomDisplayName m rid =
|
||||||
|
Maybe.withDefault "<No Name>" <| Dict.get rid m.roomNames
|
||||||
|
|
||||||
|
computeRoomDisplayName : Dict String UserData -> Maybe AccountData -> RoomId -> JoinedRoom -> Maybe String
|
||||||
|
computeRoomDisplayName ud ad rid jr =
|
||||||
let
|
let
|
||||||
customName = roomName jr
|
customName = roomName jr
|
||||||
roomUsers = List.filter ((/=) m.loginUsername) <| roomJoinedUsers jr
|
direct = ad
|
||||||
singleUserName = if List.length roomUsers == 1 then List.head roomUsers else Nothing
|
|> Maybe.andThen .events
|
||||||
singleUserDisplayName = Maybe.andThen
|
|> Maybe.andThen (findFirst ((==) "m.direct" << .type_))
|
||||||
(\u -> Maybe.andThen .displayName <| Dict.get u m.userData) singleUserName
|
|> Maybe.map (Decode.decodeValue directMessagesDecoder << .content)
|
||||||
firstOption d os = case os of
|
|> Maybe.andThen Result.toMaybe
|
||||||
[] -> d
|
|> Maybe.andThen (Dict.get rid)
|
||||||
((Just v)::_) -> v
|
|
||||||
(Nothing::xs) -> firstOption d xs
|
|
||||||
in
|
in
|
||||||
firstOption "<No Name>"
|
case (customName, direct) of
|
||||||
[ customName
|
(Just s, _) -> customName
|
||||||
, singleUserDisplayName
|
(_, Just u) -> direct
|
||||||
, singleUserName
|
_ -> Nothing
|
||||||
]
|
|
||||||
|
computeRoomsDisplayNames : Dict String UserData -> SyncResponse -> Dict String String
|
||||||
|
computeRoomsDisplayNames ud sr =
|
||||||
|
sr.rooms
|
||||||
|
|> Maybe.andThen .join
|
||||||
|
|> Maybe.map Dict.toList
|
||||||
|
|> Maybe.map (List.foldl
|
||||||
|
(\(rid, jr) d ->
|
||||||
|
computeRoomDisplayName ud sr.accountData rid jr
|
||||||
|
|> Maybe.map (\n -> Dict.insert rid n d)
|
||||||
|
|> Maybe.withDefault d) Dict.empty)
|
||||||
|
|> Maybe.withDefault Dict.empty
|
||||||
|
|
||||||
roomUrl : String -> String
|
roomUrl : String -> String
|
||||||
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
||||||
|
|
|
@ -258,6 +258,22 @@ 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 =
|
||||||
|
@ -268,15 +284,17 @@ groupBy f xs =
|
||||||
in
|
in
|
||||||
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
|
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
|
||||||
|
|
||||||
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
|
uniqueByTailRecursive : (a -> comparable) -> List a -> Set comparable -> List a -> List a
|
||||||
uniqueByRecursive f l s = case l of
|
uniqueByTailRecursive f l s acc =
|
||||||
x::tail -> if Set.member (f x) s
|
case l of
|
||||||
then uniqueByRecursive f tail s
|
x::tail ->
|
||||||
else x::uniqueByRecursive f tail (Set.insert (f x) s)
|
if Set.member (f x) s
|
||||||
[] -> []
|
then uniqueByTailRecursive f tail s acc
|
||||||
|
else uniqueByTailRecursive f tail s (x::acc)
|
||||||
|
[] -> List.reverse acc
|
||||||
|
|
||||||
uniqueBy : (a -> comparable) -> List a -> List a
|
uniqueBy : (a -> comparable) -> List a -> List a
|
||||||
uniqueBy f l = uniqueByRecursive f l Set.empty
|
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
|
||||||
|
|
||||||
findFirst : (a -> Bool) -> List a -> Maybe a
|
findFirst : (a -> Bool) -> List a -> Maybe a
|
||||||
findFirst cond l = case l of
|
findFirst cond l = case l of
|
||||||
|
@ -302,18 +320,18 @@ findLastEvent = findLastBy .originServerTs
|
||||||
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
||||||
mergeMaybe f l r = case (l, r) of
|
mergeMaybe f l r = case (l, r) of
|
||||||
(Just v1, Just v2) -> Just <| f v1 v2
|
(Just v1, Just v2) -> Just <| f v1 v2
|
||||||
(Just v, Nothing) -> Just v
|
(Just v, Nothing) -> l
|
||||||
(Nothing, Just v) -> Just v
|
(Nothing, Just v) -> r
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
mergeEvents : List Event -> List Event -> List Event
|
mergeEvents : List Event -> List Event -> List Event
|
||||||
mergeEvents l1 l2 = l1 ++ l2
|
mergeEvents l1 l2 = l1 ++ l2
|
||||||
|
|
||||||
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
|
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
|
||||||
mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
|
mergeStateEvents l1 l2 = l1 ++ l2
|
||||||
|
|
||||||
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
|
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
|
||||||
mergeRoomEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
|
mergeRoomEvents l1 l2 = l1 ++ l2
|
||||||
|
|
||||||
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
|
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
|
||||||
mergeStrippedStates l1 l2 = l1 ++ l2
|
mergeStrippedStates l1 l2 = l1 ++ l2
|
||||||
|
|
|
@ -109,18 +109,18 @@ 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 r) rs
|
<| List.sortBy (\(rid, r) -> roomDisplayName m rid) rs
|
||||||
in
|
in
|
||||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||||
|
|
||||||
roomListElementView : Model -> String -> JoinedRoom -> Html Msg
|
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||||
roomListElementView m s jr =
|
roomListElementView m rid jr =
|
||||||
let
|
let
|
||||||
name = roomDisplayName m jr
|
name = roomDisplayName m 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
|
||||||
Just cr -> cr == s
|
Just cr -> cr == rid
|
||||||
in
|
in
|
||||||
div [ classList
|
div [ classList
|
||||||
[ ("room-link-wrapper", True)
|
[ ("room-link-wrapper", True)
|
||||||
|
@ -129,7 +129,7 @@ roomListElementView m s jr =
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
<| roomNotificationCountView jr.unreadNotifications ++
|
<| roomNotificationCountView jr.unreadNotifications ++
|
||||||
[ a [ href <| roomUrl s ] [ text name ] ]
|
[ a [ href <| roomUrl rid ] [ text name ] ]
|
||||||
|
|
||||||
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
||||||
roomNotificationCountView ns =
|
roomNotificationCountView ns =
|
||||||
|
@ -161,7 +161,7 @@ joinedRoomView m roomId rd =
|
||||||
let
|
let
|
||||||
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd
|
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd
|
||||||
messagesWrapper = messagesWrapperView m roomId renderedMessages
|
messagesWrapper = messagesWrapperView m roomId renderedMessages
|
||||||
typing = List.map (displayName m) <| roomTypingUsers rd.joinedRoom
|
typing = List.map (displayName m.userData) <| roomTypingUsers rd.joinedRoom
|
||||||
typingText = String.join ", " typing
|
typingText = String.join ", " typing
|
||||||
typingSuffix = case List.length typing of
|
typingSuffix = case List.length typing of
|
||||||
0 -> ""
|
0 -> ""
|
||||||
|
@ -182,7 +182,7 @@ joinedRoomView m roomId rd =
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
div [ class "room-wrapper" ]
|
div [ class "room-wrapper" ]
|
||||||
[ h2 [] [ text <| roomDisplayName m rd.joinedRoom ]
|
[ h2 [] [ text <| roomDisplayName m roomId ]
|
||||||
, messagesWrapper
|
, messagesWrapper
|
||||||
, messageInput
|
, messageInput
|
||||||
, typingWrapper
|
, typingWrapper
|
||||||
|
@ -215,7 +215,7 @@ messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrap
|
||||||
|
|
||||||
senderView : Model -> Username -> Html Msg
|
senderView : Model -> Username -> Html Msg
|
||||||
senderView m s =
|
senderView m s =
|
||||||
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
|
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m.userData s ]
|
||||||
|
|
||||||
userMessagesView : Model -> (Username, List Message) -> Html Msg
|
userMessagesView : Model -> (Username, List Message) -> Html Msg
|
||||||
userMessagesView m (u, ms) =
|
userMessagesView m (u, ms) =
|
||||||
|
|
Loading…
Reference in New Issue
Block a user