Matrix-Programs/Scylla
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Compare commits

base: Matrix-Programs:f395259137f639cc5401ea63690e9f4957851a33
Branches Tags
Matrix-Programs:master
..
compare: Matrix-Programs:f6ce669fb4e92d1c4a22658ac29bb1ed1e98b327
Branches Tags
Matrix-Programs:master

No commits in common. "f395259137f639cc5401ea63690e9f4957851a33" and "f6ce669fb4e92d1c4a22658ac29bb1ed1e98b327" have entirely different histories.
f395259137 ... f6ce669fb4

4 changed files with 42 additions and 82 deletions
Show Stats Expand all files Collapse all files

12
src/Main.elm
View File

@ -52,7 +52,6 @@ init _ url key =
, sending = Dict.empty
, transactionId = 0
, userData = Dict.empty
, roomNames = Dict.empty
, connected = True
, searchText = ""
}
@ -320,7 +319,7 @@ updateSyncResponse model r notify =
notificationCmd sr = if notify
then Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort
{ name = displayName model.userData e.sender
{ name = displayName model e.sender
, text = notificationText e
, room = s
}) <| notification sr
@ -344,16 +343,9 @@ updateSyncResponse model r notify =
_ -> Cmd.none
receivedEvents sr = List.map Just <| allTimelineEventIds sr
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
case r of
Ok sr -> (newModel sr
, Cmd.batch
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr, sending = sending (mergeSyncResponse model.sync sr) }, Cmd.batch
[ syncCmd
, newUserCmd sr
, notificationCmd sr

54
src/Scylla/Model.elm
View File

@ -1,6 +1,6 @@
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)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
@ -13,7 +13,7 @@ import Url.Builder
import Dict exposing (Dict)
import Time exposing (Posix)
import File exposing (File)
import Json.Decode as Decode
import Json.Decode
import Browser
import Http
import Url exposing (Url)
@ -31,7 +31,6 @@ type alias Model =
, sending : Dict Int (RoomId, SendingMessage)
, transactionId : Int
, userData : Dict Username UserData
, roomNames : Dict RoomId String
, connected : Bool
, searchText : String
}
@ -55,7 +54,7 @@ type Msg =
| ReceiveUserData Username (Result Http.Error UserData) -- HTTP, receive user data
| ReceiveCompletedReadMarker (Result Http.Error ()) -- HTTP, read marker request completed
| ReceiveCompletedTypingIndicator (Result Http.Error ()) -- HTTP, typing indicator request completed
| ReceiveStoreData Decode.Value -- We are send back a value on request from localStorage.
| ReceiveStoreData Json.Decode.Value -- We are send back a value on request from localStorage.
| TypingTick Posix -- Tick for updating the typing status
| History RoomId -- Load history for a room
| ReceiveHistoryResponse RoomId (Result Http.Error HistoryResponse) -- HTTP, receive history
@ -72,40 +71,27 @@ type Msg =
| AttemptReconnect
| UpdateSearchText String
displayName : Dict String UserData -> Username -> String
displayName ud s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s ud
displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
roomDisplayName : Model -> RoomId -> String
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 =
roomDisplayName : Model -> JoinedRoom -> String
roomDisplayName m jr =
let
customName = roomName jr
direct = ad
|> Maybe.andThen .events
|> Maybe.andThen (findFirst ((==) "m.direct" << .type_))
|> Maybe.map (Decode.decodeValue directMessagesDecoder << .content)
|> Maybe.andThen Result.toMaybe
|> Maybe.andThen (Dict.get rid)
roomUsers = List.filter ((/=) m.loginUsername) <| roomJoinedUsers jr
singleUserName = if List.length roomUsers == 1 then List.head roomUsers else Nothing
singleUserDisplayName = Maybe.andThen
(\u -> Maybe.andThen .displayName <| Dict.get u m.userData) singleUserName
firstOption d os = case os of
[] -> d
((Just v)::_) -> v
(Nothing::xs) -> firstOption d xs
in
case (customName, direct) of
(Just s, _) -> customName
(_, Just u) -> direct
_ -> 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
firstOption "<No Name>"
[ customName
, singleUserDisplayName
, singleUserName
]
roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] []

40
src/Scylla/Sync.elm
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 =
@ -284,17 +268,15 @@ groupBy f xs =
in
List.foldl (\v acc -> Dict.update (f v) (update v) acc) Dict.empty xs
uniqueByTailRecursive : (a -> comparable) -> List a -> Set comparable -> List a -> List a
uniqueByTailRecursive f l s acc =
case l of
x::tail ->
if Set.member (f x) s
then uniqueByTailRecursive f tail s acc
else uniqueByTailRecursive f tail s (x::acc)
[] -> List.reverse acc
uniqueByRecursive : (a -> comparable) -> List a -> Set comparable -> List a
uniqueByRecursive f l s = case l of
x::tail -> if Set.member (f x) s
then uniqueByRecursive f tail s
else x::uniqueByRecursive f tail (Set.insert (f x) s)
[] -> []
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
uniqueBy f l = uniqueByRecursive f l Set.empty
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
@ -320,18 +302,18 @@ findLastEvent = findLastBy .originServerTs
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mergeMaybe f l r = case (l, r) of
(Just v1, Just v2) -> Just <| f v1 v2
(Just v, Nothing) -> l
(Nothing, Just v) -> r
(Just v, Nothing) -> Just v
(Nothing, Just v) -> Just v
_ -> Nothing
mergeEvents : List Event -> List Event -> List Event
mergeEvents l1 l2 = l1 ++ l2
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
mergeStateEvents l1 l2 = l1 ++ l2
mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
mergeRoomEvents l1 l2 = l1 ++ l2
mergeRoomEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
mergeStrippedStates l1 l2 = l1 ++ l2

18
src/Scylla/Views.elm
View File

@ -109,18 +109,18 @@ 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 r) rs
in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
roomListElementView m rid jr =
roomListElementView : Model -> String -> JoinedRoom -> Html Msg
roomListElementView m s jr =
let
name = roomDisplayName m rid
name = roomDisplayName m jr
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of
Nothing -> False
Just cr -> cr == rid
Just cr -> cr == s
in
div [ classList
[ ("room-link-wrapper", True)
@ -129,7 +129,7 @@ roomListElementView m rid jr =
]
]
<| roomNotificationCountView jr.unreadNotifications ++
[ a [ href <| roomUrl rid ] [ text name ] ]
[ a [ href <| roomUrl s ] [ text name ] ]
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
roomNotificationCountView ns =
@ -161,7 +161,7 @@ joinedRoomView m roomId rd =
let
renderedMessages = List.map (userMessagesView m) <| mergeMessages m.loginUsername <| extractMessages rd
messagesWrapper = messagesWrapperView m roomId renderedMessages
typing = List.map (displayName m.userData) <| roomTypingUsers rd.joinedRoom
typing = List.map (displayName m) <| roomTypingUsers rd.joinedRoom
typingText = String.join ", " typing
typingSuffix = case List.length typing of
0 -> ""
@ -182,7 +182,7 @@ joinedRoomView m roomId rd =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m roomId ]
[ h2 [] [ text <| roomDisplayName m rd.joinedRoom ]
, messagesWrapper
, messageInput
, typingWrapper
@ -215,7 +215,7 @@ messagesWrapperView m rid es = div [ class "messages-wrapper", id "messages-wrap
senderView : Model -> Username -> Html Msg
senderView m s =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m.userData s ]
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
userMessagesView : Model -> (Username, List Message) -> Html Msg
userMessagesView m (u, ms) =