Compare commits

...

6 Commits

14 changed files with 638 additions and 609 deletions

View File

@ -1,7 +1,11 @@
import Browser exposing (application, UrlRequest(..))
import Browser.Navigation as Nav
import Browser.Dom exposing (Viewport, setViewportOf)
import Scylla.Room exposing (OpenRooms, applySync)
import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (toMessageEvent, getType, getSender, getUnsigned)
import Scylla.Sync.AccountData exposing (..)
import Scylla.ListUtils exposing (..)
import Scylla.Messages exposing (..)
import Scylla.Login exposing (..)
import Scylla.Api exposing (..)
@ -13,7 +17,7 @@ import Scylla.UserData exposing (..)
import Scylla.Notification exposing (..)
import Scylla.Storage exposing (..)
import Scylla.Markdown exposing (..)
import Scylla.AccountData exposing (..)
import Scylla.Room exposing (..)
import Url exposing (Url)
import Url.Parser exposing (parse)
import Url.Builder
@ -40,12 +44,8 @@ init _ url key =
, loginUsername = ""
, loginPassword = ""
, apiUrl = "https://matrix.org"
, sync =
{ nextBatch = ""
, rooms = Nothing
, presence = Nothing
, accountData = Nothing
}
, nextBatch = ""
, accountData = { events = Just [] }
, errors = []
, roomText = Dict.empty
, sending = Dict.empty
@ -54,6 +54,7 @@ init _ url key =
, roomNames = Dict.empty
, connected = True
, searchText = ""
, rooms = emptyOpenRooms
}
cmd = getStoreValuePort "scylla.loginInfo"
in
@ -62,7 +63,7 @@ init _ url key =
view : Model -> Browser.Document Msg
view m =
let
notificationString = totalNotificationCountString m.sync
notificationString = getTotalNotificationCountString m.rooms
titleString = case notificationString of
Nothing -> "Scylla"
Just s -> s ++ " Scylla"
@ -182,21 +183,18 @@ updateHistoryResponse m r hr =
userDataCmd h = newUsersCmd m
<| newUsers m
<| uniqueBy identity
<| List.map .sender
<| List.map getSender
<| h.chunk
in
case hr of
Ok h -> ({ m | sync = appendHistoryResponse m.sync r h }, userDataCmd h)
Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, userDataCmd h)
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
updateHistory m r =
let
prevBatch = Maybe.andThen .prevBatch
<| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| m.sync.rooms
prevBatch = Dict.get r m.rooms
|> Maybe.andThen (.prevHistoryBatch)
command = case prevBatch of
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
Nothing -> Cmd.none
@ -251,9 +249,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
updateChangeRoute m r =
let
joinedRoom = case r of
Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
Room rid -> Dict.get rid m.rooms
_ -> Nothing
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
lastMessage = Maybe.map .messages joinedRoom
|> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_))
readMarkerCmd = case (r, lastMessage) of
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
_ -> Cmd.none
@ -309,7 +308,7 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
updateSyncResponse model r notify =
let
token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.nextBatch
nextBatch = Result.withDefault model.nextBatch
<| Result.map .nextBatch r
syncCmd = sync model.apiUrl token nextBatch
userDataCmd sr = newUsersCmd model
@ -322,7 +321,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 = getDisplayName model.userData e.sender
, text = notificationText e
, room = s
}) <| notification sr
@ -331,6 +330,7 @@ updateSyncResponse model r notify =
roomMessages sr = case room of
Just rid -> List.filter (((==) "m.room.message") << .type_)
<| Maybe.withDefault []
<| Maybe.map (List.filterMap (toMessageEvent))
<| Maybe.andThen .events
<| Maybe.andThen .timeline
<| Maybe.andThen (Dict.get rid)
@ -345,14 +345,14 @@ updateSyncResponse model r notify =
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
_ -> Cmd.none
receivedEvents sr = List.map Just <| allTimelineEventIds sr
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << .unsigned)
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << getUnsigned)
<| allTimelineEvents sr
sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions 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)
{ model | nextBatch = nextBatch
, sending = sending sr
, rooms = applySync sr model.rooms
, accountData = applyAccountData sr.accountData model.accountData
}
in
case r of

View File

@ -1,21 +0,0 @@
module Scylla.AccountData exposing (..)
import Scylla.Sync exposing (SyncResponse, AccountData, JoinedRoom, roomAccountData)
import Json.Decode as Decode
import Json.Encode as Encode
import Dict exposing (Dict)
type alias DirectMessages = Dict String String
type alias DirectMessagesRaw = Dict String (List String)
directMessagesDecoder : Decode.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

39
src/Scylla/ListUtils.elm Normal file
View File

@ -0,0 +1,39 @@
module Scylla.ListUtils exposing (..)
import Dict exposing (Dict)
import Set exposing (Set)
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs =
let
update v ml = case ml of
Just l -> Just (v::l)
Nothing -> Just [ v ]
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 (Set.insert (f x) s) (x::acc)
[] -> List.reverse acc
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
x::xs -> if cond x then Just x else findFirst cond xs
[] -> Nothing
findLast : (a -> Bool) -> List a -> Maybe a
findLast cond l = findFirst cond <| List.reverse l
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l

View File

@ -1,7 +1,8 @@
module Scylla.Messages exposing (..)
import Scylla.Sync exposing (RoomEvent)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Scylla.Room exposing (RoomData)
import Dict exposing (Dict)
type SendingMessageBody = TextMessage String
@ -13,7 +14,7 @@ type alias SendingMessage =
type Message
= Sending SendingMessage
| Received RoomEvent
| Received MessageEvent
messageUsername : Username -> Message -> Username
messageUsername u msg = case msg of
@ -36,9 +37,10 @@ mergeMessages du xs =
in
appendNamed fmu fms fmsl
receivedMessagesRoom : List RoomEvent -> List Message
receivedMessagesRoom es = List.map Received
<| List.filter (\e -> e.type_ == "m.room.message") es
receivedMessagesRoom : RoomData -> List Message
receivedMessagesRoom rd = rd.messages
|> List.filter (\e -> e.type_ == "m.room.message")
|> List.map Received
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)

View File

@ -1,7 +1,10 @@
module Scylla.Model exposing (..)
import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData)
import Scylla.AccountData exposing (directMessagesDecoder)
import Scylla.Sync exposing (SyncResponse, HistoryResponse)
import Scylla.ListUtils exposing (findFirst)
import Scylla.Room exposing (OpenRooms)
import Scylla.Sync.Rooms exposing (JoinedRoom)
import Scylla.Sync.AccountData exposing (AccountData, directMessagesDecoder)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route(..), RoomId)
@ -26,7 +29,8 @@ type alias Model =
, loginUsername : Username
, loginPassword : Password
, apiUrl : ApiUrl
, sync : SyncResponse
, accountData : AccountData
, nextBatch : String
, errors : List String
, roomText : Dict RoomId String
, sending : Dict Int (RoomId, SendingMessage)
@ -35,6 +39,7 @@ type alias Model =
, roomNames : Dict RoomId String
, connected : Bool
, searchText : String
, rooms : OpenRooms
}
type Msg =
@ -73,41 +78,6 @@ type Msg =
| 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 : 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 =
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)
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
roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] []
@ -117,13 +87,6 @@ loginUrl = Url.Builder.absolute [ "login" ] []
newUsers : Model -> List Username -> List Username
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
joinedRooms : Model -> Dict RoomId JoinedRoom
joinedRooms m = Maybe.withDefault Dict.empty <| Maybe.andThen .join <| m.sync.rooms
currentRoom : Model -> Maybe JoinedRoom
currentRoom m =
Maybe.andThen (\s -> Dict.get s <| joinedRooms m) <| currentRoomId m
currentRoomId : Model -> Maybe RoomId
currentRoomId m = case m.route of
Room r -> Just r

View File

@ -1,6 +1,6 @@
port module Scylla.Notification exposing (..)
import Scylla.Sync exposing (SyncResponse, RoomEvent, joinedRoomsTimelineEvents)
import Scylla.AccountData exposing (..)
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
import Json.Decode as Decode exposing (string, field)
import Dict
@ -13,17 +13,18 @@ type alias Notification =
port sendNotificationPort : Notification -> Cmd msg
port onNotificationClickPort : (String -> msg) -> Sub msg
notificationText : RoomEvent -> String
notificationText : MessageEvent -> String
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
_ -> ""
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent)
joinedRoomNotificationEvents : SyncResponse -> List (String, MessageEvent)
joinedRoomNotificationEvents s =
let
applyPair k = List.map (\v -> (k, v))
in
List.sortBy (\(k, v) -> v.originServerTs)
<| List.filterMap (\(k, e) -> Maybe.map (\me -> (k, me)) <| toMessageEvent e)
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
<| joinedRoomsTimelineEvents s

179
src/Scylla/Room.elm Normal file
View File

@ -0,0 +1,179 @@
module Scylla.Room exposing (..)
import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (SyncResponse)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Sync exposing (HistoryResponse)
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral)
import Scylla.ListUtils exposing (findFirst, uniqueBy)
import Json.Decode as Decode exposing (Decoder, Value, decodeValue, field, string, list)
import Dict exposing (Dict)
type alias RoomState = Dict (String, String) Value
type alias RoomData =
{ roomState : RoomState
, messages : List (MessageEvent)
, accountData : AccountData
, ephemeral : Ephemeral
, unreadNotifications : UnreadNotificationCounts
, prevHistoryBatch : Maybe String
, text : String
}
type alias OpenRooms = Dict RoomId RoomData
emptyOpenRooms : OpenRooms
emptyOpenRooms = Dict.empty
emptyRoomData : RoomData
emptyRoomData =
{ roomState = Dict.empty
, messages = []
, accountData = { events = Just [] }
, ephemeral = { events = Just [] }
, unreadNotifications =
{ highlightCount = Just 0
, notificationCount = Just 0
}
, prevHistoryBatch = Nothing
, text = ""
}
changeRoomStateEvent : StateEvent -> RoomState -> RoomState
changeRoomStateEvent se = Dict.insert (se.type_, se.stateKey) se.content
changeRoomStateEvents : List StateEvent -> RoomState -> RoomState
changeRoomStateEvents es rs = List.foldr (changeRoomStateEvent) rs es
changeRoomState : JoinedRoom -> RoomState -> RoomState
changeRoomState jr rs =
let
stateDiff = jr.state
|> Maybe.andThen .events
|> Maybe.withDefault []
timelineDiff = jr.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filterMap toStateEvent)
|> Maybe.withDefault []
in
rs
|> changeRoomStateEvents stateDiff
|> changeRoomStateEvents timelineDiff
changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent)
changeTimeline jr tl =
let
newMessages = jr.timeline
|> Maybe.andThen .events
|> Maybe.map (List.filterMap toMessageEvent)
|> Maybe.withDefault []
in
tl ++ newMessages
changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral
changeEphemeral jr e = Maybe.withDefault e jr.ephemeral
changeNotifications : JoinedRoom -> UnreadNotificationCounts -> UnreadNotificationCounts
changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications
changeRoomData : JoinedRoom -> RoomData -> RoomData
changeRoomData jr rd =
{ rd | accountData = applyAccountData jr.accountData rd.accountData
, roomState = changeRoomState jr rd.roomState
, messages = changeTimeline jr rd.messages
, ephemeral = changeEphemeral jr rd.ephemeral
, unreadNotifications = changeNotifications jr rd.unreadNotifications
, prevHistoryBatch = Maybe.andThen .prevBatch jr.timeline
}
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
updateRoomData jr mrd = Maybe.withDefault emptyRoomData mrd
|> changeRoomData jr
|> Just
applyJoinedRoom : RoomId -> JoinedRoom -> OpenRooms -> OpenRooms
applyJoinedRoom rid jr = Dict.update rid (updateRoomData jr)
applySync : SyncResponse -> OpenRooms -> OpenRooms
applySync sr or =
let
joinedRooms = sr.rooms
|> Maybe.andThen .join
|> Maybe.withDefault Dict.empty
in
Dict.foldl applyJoinedRoom or joinedRooms
addHistoryRoomData : HistoryResponse -> Maybe RoomData -> Maybe RoomData
addHistoryRoomData hr = Maybe.map
(\rd ->
{ rd | messages = uniqueBy .eventId
<| (List.reverse <| List.filterMap toMessageEvent hr.chunk) ++ rd.messages
, prevHistoryBatch = Just hr.end
})
applyHistoryResponse : RoomId -> HistoryResponse -> OpenRooms -> OpenRooms
applyHistoryResponse rid hr = Dict.update rid (addHistoryRoomData hr)
getStateData : (String, String) -> Decoder a -> RoomData -> Maybe a
getStateData k d rd = Dict.get k rd.roomState
|> Maybe.andThen (Result.toMaybe << decodeValue d)
getEphemeralData : String -> Decoder a -> RoomData -> Maybe a
getEphemeralData k d rd = rd.ephemeral.events
|> Maybe.andThen (findFirst ((==) k << .type_))
|> Maybe.andThen (Result.toMaybe << decodeValue d << .content)
getRoomTypingUsers : RoomData -> List String
getRoomTypingUsers = Maybe.withDefault []
<< getEphemeralData "m.typing" (field "user_ids" (list string))
getRoomName : AccountData -> Dict Username UserData -> RoomId -> RoomData -> String
getRoomName ad ud rid rd =
let
customName = getStateData ("m.room.name", "") (field "name" (string)) rd
direct = getDirectMessages ad
|> Maybe.andThen (Dict.get rid)
in
case (customName, direct) of
(Just cn, _) -> cn
(_, Just d) -> getDisplayName ud d
_ -> rid
getRoomNotificationCount : RoomData -> (Int, Int)
getRoomNotificationCount rd =
( Maybe.withDefault 0 rd.unreadNotifications.notificationCount
, Maybe.withDefault 0 rd.unreadNotifications.highlightCount
)
getTotalNotificationCount : OpenRooms -> (Int, Int)
getTotalNotificationCount =
let
sumTuples (x1, y1) (x2, y2) = (x1+x2, y1+y2)
in
Dict.foldl (\_ -> sumTuples << getRoomNotificationCount) (0, 0)
getTotalNotificationCountString : OpenRooms -> Maybe String
getTotalNotificationCountString or =
let
(n, h) = getTotalNotificationCount or
suffix = case h of
0 -> ""
_ -> "!"
in
case n of
0 -> Nothing
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
getHomeserver : String -> String
getHomeserver s =
let
colonIndex = Maybe.withDefault 0
<| Maybe.map ((+) 1)
<| List.head
<| String.indexes ":" s
in
String.dropLeft colonIndex s

View File

@ -2,223 +2,16 @@ module Scylla.Sync exposing (..)
import Scylla.Api exposing (..)
import Scylla.Login exposing (Username)
import Scylla.Route exposing (RoomId)
import Scylla.ListUtils exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..)
import Scylla.Sync.AccountData exposing (..)
import Dict exposing (Dict)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional)
import Set exposing (Set)
-- Special Decoding
decodeJust : Decoder a -> Decoder (Maybe a)
decodeJust = Decode.map Just
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
maybeDecode s d = optional s (decodeJust d) Nothing
-- General Events
type alias Event =
{ content : Decode.Value
, type_ : String
}
eventDecoder : Decoder Event
eventDecoder =
Decode.succeed Event
|> required "content" value
|> required "type" string
type alias EventContent = Decode.Value
eventContentDecoder : Decoder EventContent
eventContentDecoder = Decode.value
-- Unsigned Data
type alias UnsignedData =
{ age : Maybe Int
, redactedBecause : Maybe Event
, transactionId : Maybe String
}
unsignedDataDecoder : Decoder UnsignedData
unsignedDataDecoder =
Decode.succeed UnsignedData
|> maybeDecode "age" int
|> maybeDecode "redacted_because" eventDecoder
|> maybeDecode "transaction_id" string
-- State
type alias State =
{ events : Maybe (List StateEvent)
}
stateDecoder : Decoder State
stateDecoder =
Decode.succeed State
|> maybeDecode "events" (list stateEventDecoder)
type alias StateEvent =
{ content : Decode.Value
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
, prevContent : Maybe EventContent
, stateKey : String
}
stateEventDecoder : Decoder StateEvent
stateEventDecoder =
Decode.succeed StateEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
|> maybeDecode "prev_content" eventContentDecoder
|> required "state_key" string
-- Rooms
type alias Rooms =
{ join : Maybe (Dict String JoinedRoom)
, invite : Maybe (Dict String InvitedRoom)
, leave : Maybe (Dict String LeftRoom)
}
roomsDecoder : Decoder Rooms
roomsDecoder =
Decode.succeed Rooms
|> maybeDecode "join" (dict joinedRoomDecoder)
|> maybeDecode "invite" (dict invitedRoomDecoder)
|> maybeDecode "leave" (dict leftRoomDecoder)
type alias JoinedRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, ephemeral : Maybe Ephemeral
, accountData : Maybe AccountData
, unreadNotifications : Maybe UnreadNotificationCounts
}
joinedRoomDecoder : Decoder JoinedRoom
joinedRoomDecoder =
Decode.succeed JoinedRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "ephemeral" ephemeralDecoder
|> maybeDecode "account_data" accountDataDecoder
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
-- Joined Room Data
type alias Timeline =
{ events : Maybe (List RoomEvent)
, limited : Maybe Bool
, prevBatch : Maybe String
}
timelineDecoder =
Decode.succeed Timeline
|> maybeDecode "events" (list roomEventDecoder)
|> maybeDecode "limited" bool
|> maybeDecode "prev_batch" string
type alias RoomEvent =
{ content : Decode.Value
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
}
roomEventDecoder : Decoder RoomEvent
roomEventDecoder =
Decode.succeed RoomEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
type alias Ephemeral =
{ events : Maybe (List Event)
}
ephemeralDecoder : Decoder Ephemeral
ephemeralDecoder =
Decode.succeed Ephemeral
|> maybeDecode "events" (list eventDecoder)
type alias AccountData =
{ events : Maybe (List Event)
}
accountDataDecoder : Decoder AccountData
accountDataDecoder =
Decode.succeed AccountData
|> maybeDecode "events" (list eventDecoder)
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
unreadNotificationCountsDecoder =
Decode.succeed UnreadNotificationCounts
|> maybeDecode "highlight_count" int
|> maybeDecode "notification_count" int
-- Invited Room Data
type alias InvitedRoom =
{ inviteState : Maybe InviteState
}
invitedRoomDecoder : Decoder InvitedRoom
invitedRoomDecoder =
Decode.succeed InvitedRoom
|> maybeDecode "invite_state" inviteStateDecoder
type alias InviteState =
{ events : Maybe (List StrippedState)
}
inviteStateDecoder : Decoder InviteState
inviteStateDecoder =
Decode.succeed InviteState
|> maybeDecode "events" (list strippedStateDecoder)
type alias StrippedState =
{ content : EventContent
, stateKey : String
, type_ : String
, sender : String
}
strippedStateDecoder : Decoder StrippedState
strippedStateDecoder =
Decode.succeed StrippedState
|> required "content" eventContentDecoder
|> required "state_key" string
|> required "type" string
|> required "sender" string
-- Left Room Data
type alias LeftRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, accountData : Maybe AccountData
}
leftRoomDecoder : Decoder LeftRoom
leftRoomDecoder =
Decode.succeed LeftRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "account_data" accountDataDecoder
-- General Sync Response
type alias SyncResponse =
{ nextBatch : String
@ -259,213 +52,20 @@ historyResponseDecoder =
|> required "chunk" (list roomEventDecoder)
-- Business Logic: Helper Functions
groupBy : (a -> comparable) -> List a -> Dict comparable (List a)
groupBy f xs =
let
update v ml = case ml of
Just l -> Just (v::l)
Nothing -> Just [ v ]
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 (Set.insert (f x) s) (x::acc)
[] -> List.reverse acc
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByTailRecursive f l Set.empty []
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
x::xs -> if cond x then Just x else findFirst cond xs
[] -> Nothing
findLast : (a -> Bool) -> List a -> Maybe a
findLast cond l = findFirst cond <| List.reverse l
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findFirstEvent = findFirstBy .originServerTs
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findLastEvent = findLastBy .originServerTs
-- Business Logic: Merging
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
_ -> Nothing
mergeEvents : List Event -> List Event -> List Event
mergeEvents l1 l2 = l1 ++ l2
mergeStateEvents : List StateEvent -> List StateEvent -> List StateEvent
mergeStateEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeRoomEvents : List RoomEvent -> List RoomEvent -> List RoomEvent
mergeRoomEvents l1 l2 = uniqueBy .eventId <| l1 ++ l2
mergeStrippedStates : List StrippedState -> List StrippedState -> List StrippedState
mergeStrippedStates l1 l2 = l1 ++ l2
mergeAccountData : AccountData -> AccountData -> AccountData
mergeAccountData a1 a2 = AccountData <| mergeMaybe mergeEvents a1.events a2.events
mergePresence : Presence -> Presence -> Presence
mergePresence p1 p2 = Presence <| mergeMaybe mergeEvents p1.events p2.events
mergeDicts : (b -> b -> b) -> Dict comparable b -> Dict comparable b -> Dict comparable b
mergeDicts f d1 d2 =
let
inOne = Dict.insert
inBoth k v1 v2 = Dict.insert k (f v1 v2)
in
Dict.merge inOne inBoth inOne d1 d2 (Dict.empty)
mergeState : State -> State -> State
mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
mergeTimeline : Timeline -> Timeline -> Timeline
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t1.prevBatch
mergeEphemeral : Ephemeral -> Ephemeral -> Ephemeral
mergeEphemeral e1 e2 = Ephemeral <| mergeMaybe mergeEvents e1.events e2.events
mergeJoinedRoom : JoinedRoom -> JoinedRoom -> JoinedRoom
mergeJoinedRoom r1 r2 =
{ r2 | state = mergeMaybe mergeState r1.state r2.state
, timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
, accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
, ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral
}
mergeInviteState : InviteState -> InviteState -> InviteState
mergeInviteState i1 i2 = InviteState <| mergeMaybe mergeStrippedStates i1.events i2.events
mergeInvitedRoom : InvitedRoom -> InvitedRoom -> InvitedRoom
mergeInvitedRoom i1 i2 = InvitedRoom <| mergeMaybe mergeInviteState i1.inviteState i2.inviteState
mergeLeftRoom : LeftRoom -> LeftRoom -> LeftRoom
mergeLeftRoom l1 l2 = LeftRoom
(mergeMaybe mergeState l1.state l2.state)
(mergeMaybe mergeTimeline l1.timeline l2.timeline)
(mergeMaybe mergeAccountData l1.accountData l2.accountData)
mergeJoin : Dict String JoinedRoom -> Dict String JoinedRoom -> Dict String JoinedRoom
mergeJoin = mergeDicts mergeJoinedRoom
mergeInvite : Dict String InvitedRoom -> Dict String InvitedRoom -> Dict String InvitedRoom
mergeInvite = mergeDicts mergeInvitedRoom
mergeLeave : Dict String LeftRoom -> Dict String LeftRoom -> Dict String LeftRoom
mergeLeave = mergeDicts mergeLeftRoom
mergeRooms : Rooms -> Rooms -> Rooms
mergeRooms r1 r2 =
{ join = mergeMaybe mergeJoin r1.join r2.join
, invite = mergeMaybe mergeInvite r1.invite r2.invite
, leave = mergeMaybe mergeLeave r1.leave r2.leave
}
mergeSyncResponse : SyncResponse -> SyncResponse -> SyncResponse
mergeSyncResponse l r =
{ r | rooms = mergeMaybe mergeRooms l.rooms r.rooms
, accountData = mergeMaybe mergeAccountData l.accountData r.accountData
}
appendRoomHistoryResponse : JoinedRoom -> HistoryResponse -> JoinedRoom
appendRoomHistoryResponse jr hr =
let
oldEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
newEvents = mergeRoomEvents (List.reverse hr.chunk) oldEvents
newTimeline = case jr.timeline of
Just t -> Just { t | events = Just newEvents, prevBatch = Just hr.end }
Nothing -> Just { events = Just newEvents, prevBatch = Just hr.end, limited = Nothing }
in
{ jr | timeline = newTimeline }
appendHistoryResponse : SyncResponse -> RoomId -> HistoryResponse -> SyncResponse
appendHistoryResponse sr r hr =
let
appendMaybeRoomHistoryResponse mr = Just <| case mr of
Just jr -> appendRoomHistoryResponse jr hr
Nothing ->
{ state = Nothing
, timeline = Just
{ events = Just hr.chunk
, limited = Nothing
, prevBatch = Just hr.end
}
, ephemeral = Nothing
, accountData = Nothing
, unreadNotifications = Nothing
}
newRooms = Just <| case sr.rooms of
Just rs -> { rs | join = newJoin rs.join }
Nothing -> { join = newJoin Nothing, leave = Nothing, invite = Nothing }
newJoin j = Maybe.map (Dict.update r appendMaybeRoomHistoryResponse) j
in
{ sr | rooms = newRooms }
-- Business Logic: Names
senderName : String -> String
senderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s
homeserver : String -> String
homeserver s =
let
colonIndex = Maybe.withDefault 0
<| Maybe.map ((+) 1)
<| List.head
<| String.indexes ":" s
in
String.dropLeft colonIndex s
-- Business Logic: Events
allRoomStateEvents : JoinedRoom -> List StateEvent
allRoomStateEvents jr =
let
stateEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.state
timelineEvents = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
roomToStateEvent re =
{ content = re.content
, type_ = re.type_
, eventId = re.eventId
, sender = re.sender
, originServerTs = re.originServerTs
, unsigned = re.unsigned
, prevContent = Nothing
, stateKey = ""
}
allStateEvents = uniqueBy .eventId (stateEvents ++ (List.map roomToStateEvent timelineEvents))
in
allStateEvents
allRoomDictTimelineEvents : Dict String { a | timeline : Maybe Timeline } -> List RoomEvent
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
<| List.filterMap .timeline
<| Dict.values dict
allTimelineEventIds : SyncResponse -> List String
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
allTimelineEventIds s = List.map getEventId <| allTimelineEvents s
allTimelineEvents : SyncResponse -> List RoomEvent
allTimelineEvents s =
@ -476,7 +76,7 @@ allTimelineEvents s =
joinedEvents = eventsFor .join
leftEvents = eventsFor .leave
in
uniqueBy .eventId <| leftEvents ++ joinedEvents
leftEvents ++ joinedEvents
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
joinedRoomsTimelineEvents s =
@ -484,65 +84,6 @@ joinedRoomsTimelineEvents s =
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
<| Maybe.andThen .join s.rooms
totalNotificationCountString : SyncResponse -> Maybe String
totalNotificationCountString sr =
let
(h, n) = totalNotificationCounts sr
suffix = case h of
0 -> ""
_ -> "!"
in
case n of
0 -> Nothing
_ -> Just <| "(" ++ String.fromInt n ++ suffix ++ ")"
totalNotificationCounts : SyncResponse -> (Int, Int)
totalNotificationCounts sr =
let
rooms = Maybe.withDefault []
<| Maybe.map (Dict.values)
<| Maybe.andThen (.join) sr.rooms
zeroDefault = Maybe.withDefault 0
getCounts = Maybe.map (\cs -> (zeroDefault cs.highlightCount, zeroDefault cs.notificationCount))
<< .unreadNotifications
sumCounts (h1, n1) (h2, n2) = (h1 + h2, n1 + n2)
in
List.foldl sumCounts (0, 0)
<| List.filterMap getCounts rooms
-- Business Logic: Room Info
roomAccountData : JoinedRoom -> String -> Maybe Decode.Value
roomAccountData jr et =
Maybe.map .content
<| Maybe.andThen (List.head << List.filter (((==) et) << .type_))
<| Maybe.andThen .events jr.accountData
roomName : JoinedRoom -> Maybe String
roomName jr =
let
name c = Result.toMaybe <| Decode.decodeValue (field "name" string) c
nameEvent = findLastEvent (((==) "m.room.name") << .type_) <| allRoomStateEvents jr
in
Maybe.andThen (name << .content) nameEvent
roomTypingUsers : JoinedRoom -> List Username
roomTypingUsers jr = Maybe.withDefault []
<| Maybe.andThen (Result.toMaybe << Decode.decodeValue (Decode.field "user_ids" (list string)))
<| Maybe.map .content
<| Maybe.andThen (findLast (((==) "m.typing") << .type_))
<| Maybe.andThen .events jr.ephemeral
-- Business Logic: Users
allUsers : SyncResponse -> List Username
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allTimelineEvents s
roomJoinedUsers : JoinedRoom -> List Username
roomJoinedUsers r =
let
contentDecoder = Decode.field "membership" Decode.string
isJoin e = Ok "join" == (Decode.decodeValue contentDecoder e.content)
in
List.map .sender
<| List.filter isJoin
<| List.filter (((==) "m.room.member") << .type_)
<| allRoomStateEvents r
allUsers s = uniqueBy (\u -> u) <| List.map getSender <| allTimelineEvents s

View File

@ -0,0 +1,50 @@
module Scylla.Sync.AccountData exposing (..)
import Scylla.ListUtils exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (Event, eventDecoder)
import Json.Decode as Decode exposing (Decoder, list, decodeValue)
import Dict exposing (Dict)
type alias AccountData =
{ events : Maybe (List Event)
}
accountDataDecoder : Decoder AccountData
accountDataDecoder =
Decode.succeed AccountData
|> maybeDecode "events" (list eventDecoder)
type alias DirectMessages = Dict String String
directMessagesDecoder : Decode.Decoder DirectMessages
directMessagesDecoder =
Decode.dict (Decode.list Decode.string)
|> Decode.map (invertDirectMessages)
type alias DirectMessagesRaw = Dict String (List String)
invertDirectMessages : DirectMessagesRaw -> DirectMessages
invertDirectMessages dmr =
Dict.foldl
(\k lv acc -> List.foldl (\v -> Dict.insert v k) acc lv)
Dict.empty
dmr
applyAccountData : Maybe AccountData -> AccountData -> AccountData
applyAccountData mad ad =
case mad of
Nothing -> ad
Just newAd ->
case (newAd.events, ad.events) of
(Just es, Nothing) -> newAd
(Just newEs, Just es) -> { events = Just (newEs ++ es) }
_ -> ad
getAccountData : String -> Decode.Decoder a -> AccountData -> Maybe a
getAccountData key d ad = ad.events
|> Maybe.andThen (findFirst ((==) key << .type_))
|> Maybe.map .content
|> Maybe.andThen (Result.toMaybe << decodeValue d)
getDirectMessages : AccountData -> Maybe DirectMessages
getDirectMessages = getAccountData "m.direct" directMessagesDecoder

View File

@ -0,0 +1,9 @@
module Scylla.Sync.DecodeTools exposing (..)
import Json.Decode as Decode exposing (Decoder)
import Json.Decode.Pipeline exposing (optional)
decodeJust : Decoder a -> Decoder (Maybe a)
decodeJust = Decode.map Just
maybeDecode : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
maybeDecode s d = optional s (decodeJust d) Nothing

143
src/Scylla/Sync/Events.elm Normal file
View File

@ -0,0 +1,143 @@
module Scylla.Sync.Events exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Json.Decode as Decode exposing (Decoder, int, string, value, oneOf)
import Json.Decode.Pipeline exposing (required)
type alias UnsignedData =
{ age : Maybe Int
, redactedBecause : Maybe Event
, transactionId : Maybe String
}
unsignedDataDecoder : Decoder UnsignedData
unsignedDataDecoder =
Decode.succeed UnsignedData
|> maybeDecode "age" int
|> maybeDecode "redacted_because" eventDecoder
|> maybeDecode "transaction_id" string
type alias EventContent = Decode.Value
eventContentDecoder : Decoder EventContent
eventContentDecoder = Decode.value
type alias Event =
{ content : Decode.Value
, type_ : String
}
eventDecoder : Decoder Event
eventDecoder =
Decode.succeed Event
|> required "content" value
|> required "type" string
type RoomEvent
= StateRoomEvent StateEvent
| MessageRoomEvent MessageEvent
roomEventDecoder : Decoder RoomEvent
roomEventDecoder = oneOf
[ Decode.map MessageRoomEvent messageEventDecoder
, Decode.map StateRoomEvent stateEventDecoder
]
type alias MessageEvent =
{ content : EventContent
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
}
messageEventDecoder : Decoder MessageEvent
messageEventDecoder =
Decode.succeed MessageEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
type alias StateEvent =
{ content : EventContent
, type_ : String
, eventId : String
, sender : String
, originServerTs : Int
, unsigned : Maybe UnsignedData
, prevContent : Maybe EventContent
, stateKey : String
}
stateEventDecoder : Decoder StateEvent
stateEventDecoder =
Decode.succeed StateEvent
|> required "content" value
|> required "type" string
|> required "event_id" string
|> required "sender" string
|> required "origin_server_ts" int
|> maybeDecode "unsigned" unsignedDataDecoder
|> maybeDecode "prev_content" eventContentDecoder
|> required "state_key" string
type alias StrippedStateEvent =
{ content : EventContent
, stateKey : String
, type_ : String
, sender : String
}
strippedStateEventDecoder : Decoder StrippedStateEvent
strippedStateEventDecoder =
Decode.succeed StrippedStateEvent
|> required "content" eventContentDecoder
|> required "state_key" string
|> required "type" string
|> required "sender" string
-- Operations on Room Events
getUnsigned : RoomEvent -> Maybe UnsignedData
getUnsigned re =
case re of
StateRoomEvent e -> e.unsigned
MessageRoomEvent e -> e.unsigned
getEventId : RoomEvent -> String
getEventId re =
case re of
StateRoomEvent e -> e.eventId
MessageRoomEvent e -> e.eventId
getSender : RoomEvent -> String
getSender re =
case re of
StateRoomEvent e -> e.sender
MessageRoomEvent e -> e.sender
getType : RoomEvent -> String
getType re =
case re of
StateRoomEvent e -> e.type_
MessageRoomEvent e -> e.type_
toStateEvent : RoomEvent -> Maybe StateEvent
toStateEvent re =
case re of
StateRoomEvent e -> Just e
_ -> Nothing
toMessageEvent : RoomEvent -> Maybe MessageEvent
toMessageEvent re =
case re of
MessageRoomEvent e -> Just e
_ -> Nothing
toEvent : RoomEvent -> Event
toEvent re =
case re of
StateRoomEvent e -> { content = e.content, type_ = e.type_ }
MessageRoomEvent e -> { content = e.content, type_ = e.type_ }

109
src/Scylla/Sync/Rooms.elm Normal file
View File

@ -0,0 +1,109 @@
module Scylla.Sync.Rooms exposing (..)
import Scylla.Sync.DecodeTools exposing (maybeDecode)
import Scylla.Sync.Events exposing (Event, RoomEvent, StateEvent, StrippedStateEvent, stateEventDecoder, strippedStateEventDecoder, roomEventDecoder, eventDecoder)
import Scylla.Sync.AccountData exposing (AccountData, accountDataDecoder)
import Json.Decode as Decode exposing (Decoder, int, string, dict, list, bool)
import Json.Decode.Pipeline exposing (required)
import Dict exposing (Dict)
type alias Rooms =
{ join : Maybe (Dict String JoinedRoom)
, invite : Maybe (Dict String InvitedRoom)
, leave : Maybe (Dict String LeftRoom)
}
roomsDecoder : Decoder Rooms
roomsDecoder =
Decode.succeed Rooms
|> maybeDecode "join" (dict joinedRoomDecoder)
|> maybeDecode "invite" (dict invitedRoomDecoder)
|> maybeDecode "leave" (dict leftRoomDecoder)
type alias JoinedRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, ephemeral : Maybe Ephemeral
, accountData : Maybe AccountData
, unreadNotifications : Maybe UnreadNotificationCounts
}
joinedRoomDecoder : Decoder JoinedRoom
joinedRoomDecoder =
Decode.succeed JoinedRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "ephemeral" ephemeralDecoder
|> maybeDecode "account_data" accountDataDecoder
|> maybeDecode "unread_notifications" unreadNotificationCountsDecoder
type alias InvitedRoom =
{ inviteState : Maybe InviteState
}
invitedRoomDecoder : Decoder InvitedRoom
invitedRoomDecoder =
Decode.succeed InvitedRoom
|> maybeDecode "invite_state" inviteStateDecoder
type alias LeftRoom =
{ state : Maybe State
, timeline : Maybe Timeline
, accountData : Maybe AccountData
}
leftRoomDecoder : Decoder LeftRoom
leftRoomDecoder =
Decode.succeed LeftRoom
|> maybeDecode "state" stateDecoder
|> maybeDecode "timeline" timelineDecoder
|> maybeDecode "account_data" accountDataDecoder
type alias State =
{ events : Maybe (List StateEvent)
}
stateDecoder : Decoder State
stateDecoder =
Decode.succeed State
|> maybeDecode "events" (list stateEventDecoder)
type alias InviteState =
{ events : Maybe (List StrippedStateEvent)
}
inviteStateDecoder : Decoder InviteState
inviteStateDecoder =
Decode.succeed InviteState
|> maybeDecode "events" (list strippedStateEventDecoder)
type alias Timeline =
{ events : Maybe (List RoomEvent)
, limited : Maybe Bool
, prevBatch : Maybe String
}
timelineDecoder =
Decode.succeed Timeline
|> maybeDecode "events" (list roomEventDecoder)
|> maybeDecode "limited" bool
|> maybeDecode "prev_batch" string
type alias Ephemeral =
{ events : Maybe (List Event)
}
ephemeralDecoder : Decoder Ephemeral
ephemeralDecoder =
Decode.succeed Ephemeral
|> maybeDecode "events" (list eventDecoder)
type alias UnreadNotificationCounts =
{ highlightCount : Maybe Int
, notificationCount : Maybe Int
}
unreadNotificationCountsDecoder : Decoder UnreadNotificationCounts
unreadNotificationCountsDecoder =
Decode.succeed UnreadNotificationCounts
|> maybeDecode "highlight_count" int
|> maybeDecode "notification_count" int

View File

@ -1,6 +1,8 @@
module Scylla.UserData exposing (..)
import Scylla.Login exposing (Username)
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
import Json.Decode.Pipeline exposing (required, optional)
import Dict exposing (Dict)
type alias UserData =
{ displayName : Maybe String
@ -12,3 +14,18 @@ userDataDecoder =
Decode.succeed UserData
|> optional "displayname" (Decode.map Just string) Nothing
|> optional "avatar_url" (Decode.map Just string) Nothing
getDisplayName : Dict Username UserData -> Username -> String
getDisplayName ud s = Dict.get s ud
|> Maybe.andThen .displayName
|> Maybe.withDefault (getSenderName s)
getSenderName : Username -> String
getSenderName s =
let
colonIndex = Maybe.withDefault -1
<| List.head
<| String.indexes ":" s
in
String.slice 1 colonIndex s

View File

@ -1,13 +1,17 @@
module Scylla.Views exposing (..)
import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..)
import Scylla.Room exposing (RoomData, emptyOpenRooms, getHomeserver, getRoomName, getRoomTypingUsers)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Messages exposing (..)
import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData)
import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Http exposing (fullMediaUrl)
import Scylla.Api exposing (ApiUrl)
import Scylla.ListUtils exposing (groupBy)
import Html.Parser
import Html.Parser.Util
import Svg
@ -44,10 +48,8 @@ stringColor s =
viewFull : Model -> List (Html Msg)
viewFull model =
let
room r = Maybe.map (\jr -> (r, jr))
<| Maybe.andThen (Dict.get r)
<| Maybe.andThen .join
<| model.sync.rooms
room r = Dict.get r model.rooms
|> Maybe.map (\rd -> (r, rd))
core = case model.route of
Login -> loginView model
Base -> baseView model Nothing
@ -63,10 +65,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
errorView : Int -> String -> Html Msg
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
baseView m jr =
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
baseView m rd =
let
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
reconnect = reconnectView m
in
div [ class "base-wrapper" ] <| maybeHtml
@ -83,11 +85,8 @@ reconnectView m = if m.connected
roomListView : Model -> Html Msg
roomListView m =
let
rooms = Maybe.withDefault (Dict.empty)
<| Maybe.andThen .join
<| m.sync.rooms
groups = roomGroups
<| Dict.toList rooms
<| Dict.toList m.rooms
homeserverList = div [ class "homeservers-list" ]
<| List.map (\(k, v) -> homeserverView m k v)
<| Dict.toList groups
@ -104,22 +103,22 @@ roomListView m =
, homeserverList
]
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
roomGroups jrs = groupBy (getHomeserver << Tuple.first) jrs
homeserverView : Model -> String -> List (String, JoinedRoom) -> Html Msg
homeserverView : Model -> String -> List (String, RoomData) -> Html Msg
homeserverView m hs rs =
let
roomList = div [ class "rooms-list" ]
<| List.map (\(rid, r) -> roomListElementView m rid r)
<| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
<| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs
in
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
roomListElementView m rid jr =
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
roomListElementView m rid rd =
let
name = roomDisplayName m.roomNames rid
name = getRoomName m.accountData m.userData rid rd
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
isCurrentRoom = case currentRoomId m of
Nothing -> False
@ -131,10 +130,10 @@ roomListElementView m rid jr =
, ("hidden", not isVisible)
]
]
<| roomNotificationCountView jr.unreadNotifications ++
<| roomNotificationCountView rd.unreadNotifications ++
[ a [ href <| roomUrl rid ] [ text name ] ]
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
roomNotificationCountView ns =
let
wrap b = span
@ -143,7 +142,7 @@ roomNotificationCountView ns =
, ("bright", b)
]
]
getCount f = Maybe.withDefault 0 << Maybe.andThen f
getCount f = Maybe.withDefault 0 << f
in
case (getCount .notificationCount ns, getCount .highlightCount ns) of
(0, 0) -> []
@ -159,10 +158,10 @@ loginView m = div [ class "login-wrapper" ]
, button [ onClick AttemptLogin ] [ text "Log In" ]
]
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
joinedRoomView m roomId jr =
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
joinedRoomView m roomId rd =
let
typing = List.map (displayName m.userData) <| roomTypingUsers jr
typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd
typingText = String.join ", " typing
typingSuffix = case List.length typing of
0 -> ""
@ -183,18 +182,16 @@ joinedRoomView m roomId jr =
]
in
div [ class "room-wrapper" ]
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
[ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ]
, lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending
, messageInput
, typingWrapper
]
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid jr au lu snd =
lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
lazyMessagesView ud rid rd au lu snd =
let
roomReceived = receivedMessagesRoom
<| Maybe.withDefault []
<| Maybe.andThen .events jr.timeline
roomReceived = receivedMessagesRoom rd
roomSending = sendingMessagesRoom rid snd
renderedMessages = List.map (userMessagesView ud au)
<| mergeMessages lu
@ -229,7 +226,7 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
senderView : Dict String UserData -> Username -> Html Msg
senderView ud s =
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| getDisplayName ud s ]
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
userMessagesView ud apiUrl (u, ms) =
@ -250,7 +247,7 @@ sendingMessageView : SendingMessage -> Html Msg
sendingMessageView msg = case msg.body of
TextMessage t -> span [ class "sending"] [ text t ]
roomEventView : Dict String UserData -> ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventView : Dict String UserData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventView ud apiUrl re =
let
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
@ -264,13 +261,13 @@ roomEventView ud apiUrl re =
Ok "m.video" -> roomEventVideoView apiUrl re
_ -> Nothing
roomEventFormattedContent : RoomEvent -> Maybe (List (Html Msg))
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
<| Result.toMaybe
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
roomEventContent : (List (Html Msg) -> Html Msg) -> RoomEvent -> Maybe (Html Msg)
roomEventContent : (List (Html Msg) -> Html Msg) -> MessageEvent -> Maybe (Html Msg)
roomEventContent f re =
let
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
@ -280,20 +277,20 @@ roomEventContent f re =
Just c -> Just <| f c
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
roomEventEmoteView : Dict String UserData -> RoomEvent -> Maybe (Html Msg)
roomEventEmoteView : Dict String UserData -> MessageEvent -> Maybe (Html Msg)
roomEventEmoteView ud re =
let
emoteText = "* " ++ displayName ud re.sender ++ " "
emoteText = "* " ++ getDisplayName ud re.sender ++ " "
in
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
roomEventTextView : RoomEvent -> Maybe (Html Msg)
roomEventTextView : MessageEvent -> Maybe (Html Msg)
roomEventTextView = roomEventContent (span [])
roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventImageView apiUrl re =
let
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
@ -302,7 +299,7 @@ roomEventImageView apiUrl re =
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
<| Result.toMaybe body
roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventFileView apiUrl re =
let
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
@ -312,7 +309,7 @@ roomEventFileView apiUrl re =
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
<| Result.toMaybe fileData
roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
roomEventVideoView apiUrl re =
let
decoder = Decode.map2 (\l r -> (l, r))