Compare commits
No commits in common. "71e0b3f64e327461b6415805cfef40b1aebf83b9" and "ccfd2fe76b1ca73142e641efa5b82a41fdfb75ef" have entirely different histories.
71e0b3f64e
...
ccfd2fe76b
48
src/Main.elm
48
src/Main.elm
|
|
@ -1,11 +1,7 @@
|
|||
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 (..)
|
||||
|
|
@ -17,7 +13,7 @@ import Scylla.UserData exposing (..)
|
|||
import Scylla.Notification exposing (..)
|
||||
import Scylla.Storage exposing (..)
|
||||
import Scylla.Markdown exposing (..)
|
||||
import Scylla.Room exposing (..)
|
||||
import Scylla.AccountData exposing (..)
|
||||
import Url exposing (Url)
|
||||
import Url.Parser exposing (parse)
|
||||
import Url.Builder
|
||||
|
|
@ -44,8 +40,12 @@ init _ url key =
|
|||
, loginUsername = ""
|
||||
, loginPassword = ""
|
||||
, apiUrl = "https://matrix.org"
|
||||
, nextBatch = ""
|
||||
, accountData = { events = Just [] }
|
||||
, sync =
|
||||
{ nextBatch = ""
|
||||
, rooms = Nothing
|
||||
, presence = Nothing
|
||||
, accountData = Nothing
|
||||
}
|
||||
, errors = []
|
||||
, roomText = Dict.empty
|
||||
, sending = Dict.empty
|
||||
|
|
@ -54,7 +54,6 @@ init _ url key =
|
|||
, roomNames = Dict.empty
|
||||
, connected = True
|
||||
, searchText = ""
|
||||
, rooms = emptyOpenRooms
|
||||
}
|
||||
cmd = getStoreValuePort "scylla.loginInfo"
|
||||
in
|
||||
|
|
@ -63,7 +62,7 @@ init _ url key =
|
|||
view : Model -> Browser.Document Msg
|
||||
view m =
|
||||
let
|
||||
notificationString = getTotalNotificationCountString m.rooms
|
||||
notificationString = totalNotificationCountString m.sync
|
||||
titleString = case notificationString of
|
||||
Nothing -> "Scylla"
|
||||
Just s -> s ++ " Scylla"
|
||||
|
|
@ -183,18 +182,21 @@ updateHistoryResponse m r hr =
|
|||
userDataCmd h = newUsersCmd m
|
||||
<| newUsers m
|
||||
<| uniqueBy identity
|
||||
<| List.map getSender
|
||||
<| List.map .sender
|
||||
<| h.chunk
|
||||
in
|
||||
case hr of
|
||||
Ok h -> ({ m | rooms = applyHistoryResponse r h m.rooms }, userDataCmd 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)
|
||||
updateHistory m r =
|
||||
let
|
||||
prevBatch = Dict.get r m.rooms
|
||||
|> Maybe.andThen (.prevHistoryBatch)
|
||||
prevBatch = Maybe.andThen .prevBatch
|
||||
<| Maybe.andThen .timeline
|
||||
<| Maybe.andThen (Dict.get r)
|
||||
<| Maybe.andThen .join
|
||||
<| m.sync.rooms
|
||||
command = case prevBatch of
|
||||
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
||||
Nothing -> Cmd.none
|
||||
|
|
@ -249,10 +251,9 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
|
|||
updateChangeRoute m r =
|
||||
let
|
||||
joinedRoom = case r of
|
||||
Room rid -> Dict.get rid m.rooms
|
||||
Room rid -> Maybe.andThen (Dict.get rid) <| Maybe.andThen .join <| m.sync.rooms
|
||||
_ -> Nothing
|
||||
lastMessage = Maybe.map .messages joinedRoom
|
||||
|> Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_))
|
||||
lastMessage = Maybe.andThen (findLastEvent (((==) "m.room.message") << .type_)) <| Maybe.andThen .events <| Maybe.andThen .timeline joinedRoom
|
||||
readMarkerCmd = case (r, lastMessage) of
|
||||
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
||||
_ -> Cmd.none
|
||||
|
|
@ -308,7 +309,7 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
|
|||
updateSyncResponse model r notify =
|
||||
let
|
||||
token = Maybe.withDefault "" model.token
|
||||
nextBatch = Result.withDefault model.nextBatch
|
||||
nextBatch = Result.withDefault model.sync.nextBatch
|
||||
<| Result.map .nextBatch r
|
||||
syncCmd = sync model.apiUrl token nextBatch
|
||||
userDataCmd sr = newUsersCmd model
|
||||
|
|
@ -321,7 +322,7 @@ updateSyncResponse model r notify =
|
|||
notificationCmd sr = if notify
|
||||
then Maybe.withDefault Cmd.none
|
||||
<| Maybe.map (\(s, e) -> sendNotificationPort
|
||||
{ name = getDisplayName model.userData e.sender
|
||||
{ name = displayName model.userData e.sender
|
||||
, text = notificationText e
|
||||
, room = s
|
||||
}) <| notification sr
|
||||
|
|
@ -330,7 +331,6 @@ 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 << getUnsigned)
|
||||
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << .unsigned)
|
||||
<| 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 | nextBatch = nextBatch
|
||||
, sending = sending sr
|
||||
, rooms = applySync sr model.rooms
|
||||
, accountData = applyAccountData sr.accountData model.accountData
|
||||
{ model | sync = newSync sr
|
||||
, sending = sending (mergeSyncResponse model.sync sr)
|
||||
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
|
||||
}
|
||||
in
|
||||
case r of
|
||||
|
|
|
|||
21
src/Scylla/AccountData.elm
Normal file
21
src/Scylla/AccountData.elm
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
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
|
||||
|
||||
|
|
@ -1,39 +0,0 @@
|
|||
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
|
||||
|
||||
|
|
@ -1,8 +1,7 @@
|
|||
module Scylla.Messages exposing (..)
|
||||
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||
import Scylla.Sync exposing (RoomEvent)
|
||||
import Scylla.Login exposing (Username)
|
||||
import Scylla.Route exposing (RoomId)
|
||||
import Scylla.Room exposing (RoomData)
|
||||
import Dict exposing (Dict)
|
||||
|
||||
type SendingMessageBody = TextMessage String
|
||||
|
|
@ -14,7 +13,7 @@ type alias SendingMessage =
|
|||
|
||||
type Message
|
||||
= Sending SendingMessage
|
||||
| Received MessageEvent
|
||||
| Received RoomEvent
|
||||
|
||||
messageUsername : Username -> Message -> Username
|
||||
messageUsername u msg = case msg of
|
||||
|
|
@ -37,10 +36,9 @@ mergeMessages du xs =
|
|||
in
|
||||
appendNamed fmu fms fmsl
|
||||
|
||||
receivedMessagesRoom : RoomData -> List Message
|
||||
receivedMessagesRoom rd = rd.messages
|
||||
|> List.filter (\e -> e.type_ == "m.room.message")
|
||||
|> List.map Received
|
||||
receivedMessagesRoom : List RoomEvent -> List Message
|
||||
receivedMessagesRoom es = List.map Received
|
||||
<| List.filter (\e -> e.type_ == "m.room.message") es
|
||||
|
||||
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
||||
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
||||
|
|
|
|||
|
|
@ -1,10 +1,7 @@
|
|||
module Scylla.Model exposing (..)
|
||||
import Scylla.Api exposing (..)
|
||||
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.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)
|
||||
|
|
@ -29,8 +26,7 @@ type alias Model =
|
|||
, loginUsername : Username
|
||||
, loginPassword : Password
|
||||
, apiUrl : ApiUrl
|
||||
, accountData : AccountData
|
||||
, nextBatch : String
|
||||
, sync : SyncResponse
|
||||
, errors : List String
|
||||
, roomText : Dict RoomId String
|
||||
, sending : Dict Int (RoomId, SendingMessage)
|
||||
|
|
@ -39,7 +35,6 @@ type alias Model =
|
|||
, roomNames : Dict RoomId String
|
||||
, connected : Bool
|
||||
, searchText : String
|
||||
, rooms : OpenRooms
|
||||
}
|
||||
|
||||
type Msg =
|
||||
|
|
@ -78,6 +73,41 @@ 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 ] []
|
||||
|
||||
|
|
@ -87,6 +117,13 @@ 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
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
port module Scylla.Notification exposing (..)
|
||||
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
|
||||
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||
import Scylla.Sync exposing (SyncResponse, RoomEvent, joinedRoomsTimelineEvents)
|
||||
import Scylla.AccountData exposing (..)
|
||||
import Json.Decode as Decode exposing (string, field)
|
||||
import Dict
|
||||
|
||||
|
|
@ -13,18 +13,17 @@ type alias Notification =
|
|||
port sendNotificationPort : Notification -> Cmd msg
|
||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
||||
|
||||
notificationText : MessageEvent -> String
|
||||
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)
|
||||
_ -> ""
|
||||
|
||||
joinedRoomNotificationEvents : SyncResponse -> List (String, MessageEvent)
|
||||
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent)
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,179 +0,0 @@
|
|||
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
|
||||
|
||||
|
|
@ -2,16 +2,223 @@ 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
|
||||
|
|
@ -52,20 +259,213 @@ 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 getEventId <| allTimelineEvents s
|
||||
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
|
||||
|
||||
allTimelineEvents : SyncResponse -> List RoomEvent
|
||||
allTimelineEvents s =
|
||||
|
|
@ -76,7 +476,7 @@ allTimelineEvents s =
|
|||
joinedEvents = eventsFor .join
|
||||
leftEvents = eventsFor .leave
|
||||
in
|
||||
leftEvents ++ joinedEvents
|
||||
uniqueBy .eventId <| leftEvents ++ joinedEvents
|
||||
|
||||
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
||||
joinedRoomsTimelineEvents s =
|
||||
|
|
@ -84,6 +484,65 @@ 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 getSender <| allTimelineEvents s
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,50 +0,0 @@
|
|||
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
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
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
|
||||
|
|
@ -1,143 +0,0 @@
|
|||
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_ }
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
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
|
||||
|
|
@ -1,8 +1,6 @@
|
|||
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
|
||||
|
|
@ -14,18 +12,3 @@ 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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,17 +1,13 @@
|
|||
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, getDisplayName)
|
||||
import Scylla.UserData exposing (UserData)
|
||||
import Scylla.Http exposing (fullMediaUrl)
|
||||
import Scylla.Api exposing (ApiUrl)
|
||||
import Scylla.ListUtils exposing (groupBy)
|
||||
import Html.Parser
|
||||
import Html.Parser.Util
|
||||
import Svg
|
||||
|
|
@ -48,8 +44,10 @@ stringColor s =
|
|||
viewFull : Model -> List (Html Msg)
|
||||
viewFull model =
|
||||
let
|
||||
room r = Dict.get r model.rooms
|
||||
|> Maybe.map (\rd -> (r, rd))
|
||||
room r = Maybe.map (\jr -> (r, jr))
|
||||
<| Maybe.andThen (Dict.get r)
|
||||
<| Maybe.andThen .join
|
||||
<| model.sync.rooms
|
||||
core = case model.route of
|
||||
Login -> loginView model
|
||||
Base -> baseView model Nothing
|
||||
|
|
@ -65,10 +63,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, RoomData) -> Html Msg
|
||||
baseView m rd =
|
||||
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
|
||||
baseView m jr =
|
||||
let
|
||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
|
||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
|
||||
reconnect = reconnectView m
|
||||
in
|
||||
div [ class "base-wrapper" ] <| maybeHtml
|
||||
|
|
@ -85,8 +83,11 @@ 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 m.rooms
|
||||
<| Dict.toList rooms
|
||||
homeserverList = div [ class "homeservers-list" ]
|
||||
<| List.map (\(k, v) -> homeserverView m k v)
|
||||
<| Dict.toList groups
|
||||
|
|
@ -103,22 +104,22 @@ roomListView m =
|
|||
, homeserverList
|
||||
]
|
||||
|
||||
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
|
||||
roomGroups jrs = groupBy (getHomeserver << Tuple.first) jrs
|
||||
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
|
||||
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
|
||||
|
||||
homeserverView : Model -> String -> List (String, RoomData) -> Html Msg
|
||||
homeserverView : Model -> String -> List (String, JoinedRoom) -> Html Msg
|
||||
homeserverView m hs rs =
|
||||
let
|
||||
roomList = div [ class "rooms-list" ]
|
||||
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
||||
<| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs
|
||||
<| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
|
||||
in
|
||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||
|
||||
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
|
||||
roomListElementView m rid rd =
|
||||
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||
roomListElementView m rid jr =
|
||||
let
|
||||
name = getRoomName m.accountData m.userData rid rd
|
||||
name = roomDisplayName m.roomNames rid
|
||||
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
||||
isCurrentRoom = case currentRoomId m of
|
||||
Nothing -> False
|
||||
|
|
@ -130,10 +131,10 @@ roomListElementView m rid rd =
|
|||
, ("hidden", not isVisible)
|
||||
]
|
||||
]
|
||||
<| roomNotificationCountView rd.unreadNotifications ++
|
||||
<| roomNotificationCountView jr.unreadNotifications ++
|
||||
[ a [ href <| roomUrl rid ] [ text name ] ]
|
||||
|
||||
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
|
||||
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
||||
roomNotificationCountView ns =
|
||||
let
|
||||
wrap b = span
|
||||
|
|
@ -142,7 +143,7 @@ roomNotificationCountView ns =
|
|||
, ("bright", b)
|
||||
]
|
||||
]
|
||||
getCount f = Maybe.withDefault 0 << f
|
||||
getCount f = Maybe.withDefault 0 << Maybe.andThen f
|
||||
in
|
||||
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
||||
(0, 0) -> []
|
||||
|
|
@ -158,10 +159,10 @@ loginView m = div [ class "login-wrapper" ]
|
|||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||
]
|
||||
|
||||
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
|
||||
joinedRoomView m roomId rd =
|
||||
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
||||
joinedRoomView m roomId jr =
|
||||
let
|
||||
typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd
|
||||
typing = List.map (displayName m.userData) <| roomTypingUsers jr
|
||||
typingText = String.join ", " typing
|
||||
typingSuffix = case List.length typing of
|
||||
0 -> ""
|
||||
|
|
@ -182,16 +183,18 @@ joinedRoomView m roomId rd =
|
|||
]
|
||||
in
|
||||
div [ class "room-wrapper" ]
|
||||
[ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ]
|
||||
, lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending
|
||||
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
|
||||
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
|
||||
, messageInput
|
||||
, typingWrapper
|
||||
]
|
||||
|
||||
lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||
lazyMessagesView ud rid rd au lu snd =
|
||||
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||
lazyMessagesView ud rid jr au lu snd =
|
||||
let
|
||||
roomReceived = receivedMessagesRoom rd
|
||||
roomReceived = receivedMessagesRoom
|
||||
<| Maybe.withDefault []
|
||||
<| Maybe.andThen .events jr.timeline
|
||||
roomSending = sendingMessagesRoom rid snd
|
||||
renderedMessages = List.map (userMessagesView ud au)
|
||||
<| mergeMessages lu
|
||||
|
|
@ -226,7 +229,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 <| getDisplayName ud s ]
|
||||
span [ style "color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName ud s ]
|
||||
|
||||
userMessagesView : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
|
||||
userMessagesView ud apiUrl (u, ms) =
|
||||
|
|
@ -247,7 +250,7 @@ sendingMessageView : SendingMessage -> Html Msg
|
|||
sendingMessageView msg = case msg.body of
|
||||
TextMessage t -> span [ class "sending"] [ text t ]
|
||||
|
||||
roomEventView : Dict String UserData -> ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventView : Dict String UserData -> ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventView ud apiUrl re =
|
||||
let
|
||||
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
||||
|
|
@ -261,13 +264,13 @@ roomEventView ud apiUrl re =
|
|||
Ok "m.video" -> roomEventVideoView apiUrl re
|
||||
_ -> Nothing
|
||||
|
||||
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
|
||||
roomEventFormattedContent : RoomEvent -> 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) -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventContent : (List (Html Msg) -> Html Msg) -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventContent f re =
|
||||
let
|
||||
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
||||
|
|
@ -277,20 +280,20 @@ roomEventContent f re =
|
|||
Just c -> Just <| f c
|
||||
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
|
||||
|
||||
roomEventEmoteView : Dict String UserData -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventEmoteView : Dict String UserData -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventEmoteView ud re =
|
||||
let
|
||||
emoteText = "* " ++ getDisplayName ud re.sender ++ " "
|
||||
emoteText = "* " ++ displayName ud re.sender ++ " "
|
||||
in
|
||||
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
||||
|
||||
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
|
||||
roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
|
||||
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
||||
|
||||
roomEventTextView : MessageEvent -> Maybe (Html Msg)
|
||||
roomEventTextView : RoomEvent -> Maybe (Html Msg)
|
||||
roomEventTextView = roomEventContent (span [])
|
||||
|
||||
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventImageView apiUrl re =
|
||||
let
|
||||
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
||||
|
|
@ -299,7 +302,7 @@ roomEventImageView apiUrl re =
|
|||
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
||||
<| Result.toMaybe body
|
||||
|
||||
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventFileView apiUrl re =
|
||||
let
|
||||
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
|
||||
|
|
@ -309,7 +312,7 @@ roomEventFileView apiUrl re =
|
|||
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
|
||||
<| Result.toMaybe fileData
|
||||
|
||||
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||
roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
||||
roomEventVideoView apiUrl re =
|
||||
let
|
||||
decoder = Decode.map2 (\l r -> (l, r))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user