Compare commits
6 Commits
ccfd2fe76b
...
71e0b3f64e
Author | SHA1 | Date | |
---|---|---|---|
71e0b3f64e | |||
8627123143 | |||
5c02ae8a58 | |||
29e81a88ac | |||
676d6c28a7 | |||
595e28853e |
48
src/Main.elm
48
src/Main.elm
|
@ -1,7 +1,11 @@
|
||||||
import Browser exposing (application, UrlRequest(..))
|
import Browser exposing (application, UrlRequest(..))
|
||||||
import Browser.Navigation as Nav
|
import Browser.Navigation as Nav
|
||||||
import Browser.Dom exposing (Viewport, setViewportOf)
|
import Browser.Dom exposing (Viewport, setViewportOf)
|
||||||
|
import Scylla.Room exposing (OpenRooms, applySync)
|
||||||
import Scylla.Sync exposing (..)
|
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.Messages exposing (..)
|
||||||
import Scylla.Login exposing (..)
|
import Scylla.Login exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
|
@ -13,7 +17,7 @@ import Scylla.UserData exposing (..)
|
||||||
import Scylla.Notification exposing (..)
|
import Scylla.Notification exposing (..)
|
||||||
import Scylla.Storage exposing (..)
|
import Scylla.Storage exposing (..)
|
||||||
import Scylla.Markdown exposing (..)
|
import Scylla.Markdown exposing (..)
|
||||||
import Scylla.AccountData exposing (..)
|
import Scylla.Room exposing (..)
|
||||||
import Url exposing (Url)
|
import Url exposing (Url)
|
||||||
import Url.Parser exposing (parse)
|
import Url.Parser exposing (parse)
|
||||||
import Url.Builder
|
import Url.Builder
|
||||||
|
@ -40,12 +44,8 @@ init _ url key =
|
||||||
, loginUsername = ""
|
, loginUsername = ""
|
||||||
, loginPassword = ""
|
, loginPassword = ""
|
||||||
, apiUrl = "https://matrix.org"
|
, apiUrl = "https://matrix.org"
|
||||||
, sync =
|
, nextBatch = ""
|
||||||
{ nextBatch = ""
|
, accountData = { events = Just [] }
|
||||||
, rooms = Nothing
|
|
||||||
, presence = Nothing
|
|
||||||
, accountData = Nothing
|
|
||||||
}
|
|
||||||
, errors = []
|
, errors = []
|
||||||
, roomText = Dict.empty
|
, roomText = Dict.empty
|
||||||
, sending = Dict.empty
|
, sending = Dict.empty
|
||||||
|
@ -54,6 +54,7 @@ init _ url key =
|
||||||
, roomNames = Dict.empty
|
, roomNames = Dict.empty
|
||||||
, connected = True
|
, connected = True
|
||||||
, searchText = ""
|
, searchText = ""
|
||||||
|
, rooms = emptyOpenRooms
|
||||||
}
|
}
|
||||||
cmd = getStoreValuePort "scylla.loginInfo"
|
cmd = getStoreValuePort "scylla.loginInfo"
|
||||||
in
|
in
|
||||||
|
@ -62,7 +63,7 @@ init _ url key =
|
||||||
view : Model -> Browser.Document Msg
|
view : Model -> Browser.Document Msg
|
||||||
view m =
|
view m =
|
||||||
let
|
let
|
||||||
notificationString = totalNotificationCountString m.sync
|
notificationString = getTotalNotificationCountString m.rooms
|
||||||
titleString = case notificationString of
|
titleString = case notificationString of
|
||||||
Nothing -> "Scylla"
|
Nothing -> "Scylla"
|
||||||
Just s -> s ++ " Scylla"
|
Just s -> s ++ " Scylla"
|
||||||
|
@ -182,21 +183,18 @@ updateHistoryResponse m r hr =
|
||||||
userDataCmd h = newUsersCmd m
|
userDataCmd h = newUsersCmd m
|
||||||
<| newUsers m
|
<| newUsers m
|
||||||
<| uniqueBy identity
|
<| uniqueBy identity
|
||||||
<| List.map .sender
|
<| List.map getSender
|
||||||
<| h.chunk
|
<| h.chunk
|
||||||
in
|
in
|
||||||
case hr of
|
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)
|
Err _ -> ({ m | errors = "Unable to load older history from server"::m.errors }, Cmd.none)
|
||||||
|
|
||||||
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
updateHistory : Model -> RoomId -> (Model, Cmd Msg)
|
||||||
updateHistory m r =
|
updateHistory m r =
|
||||||
let
|
let
|
||||||
prevBatch = Maybe.andThen .prevBatch
|
prevBatch = Dict.get r m.rooms
|
||||||
<| Maybe.andThen .timeline
|
|> Maybe.andThen (.prevHistoryBatch)
|
||||||
<| Maybe.andThen (Dict.get r)
|
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| m.sync.rooms
|
|
||||||
command = case prevBatch of
|
command = case prevBatch of
|
||||||
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
Just pv -> getHistory m.apiUrl (Maybe.withDefault "" m.token) r pv
|
||||||
Nothing -> Cmd.none
|
Nothing -> Cmd.none
|
||||||
|
@ -251,9 +249,10 @@ updateChangeRoute : Model -> Route -> (Model, Cmd Msg)
|
||||||
updateChangeRoute m r =
|
updateChangeRoute m r =
|
||||||
let
|
let
|
||||||
joinedRoom = case r of
|
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
|
_ -> 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
|
readMarkerCmd = case (r, lastMessage) of
|
||||||
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
(Room rid, Just re) -> setReadMarkers m.apiUrl (Maybe.withDefault "" m.token) rid re.eventId <| Just re.eventId
|
||||||
_ -> Cmd.none
|
_ -> Cmd.none
|
||||||
|
@ -309,7 +308,7 @@ updateSyncResponse : Model -> Result Http.Error SyncResponse -> Bool -> (Model,
|
||||||
updateSyncResponse model r notify =
|
updateSyncResponse model r notify =
|
||||||
let
|
let
|
||||||
token = Maybe.withDefault "" model.token
|
token = Maybe.withDefault "" model.token
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| Result.map .nextBatch r
|
||||||
syncCmd = sync model.apiUrl token nextBatch
|
syncCmd = sync model.apiUrl token nextBatch
|
||||||
userDataCmd sr = newUsersCmd model
|
userDataCmd sr = newUsersCmd model
|
||||||
|
@ -322,7 +321,7 @@ updateSyncResponse model r notify =
|
||||||
notificationCmd sr = if notify
|
notificationCmd sr = if notify
|
||||||
then Maybe.withDefault Cmd.none
|
then Maybe.withDefault Cmd.none
|
||||||
<| Maybe.map (\(s, e) -> sendNotificationPort
|
<| Maybe.map (\(s, e) -> sendNotificationPort
|
||||||
{ name = displayName model.userData e.sender
|
{ name = getDisplayName model.userData e.sender
|
||||||
, text = notificationText e
|
, text = notificationText e
|
||||||
, room = s
|
, room = s
|
||||||
}) <| notification sr
|
}) <| notification sr
|
||||||
|
@ -331,6 +330,7 @@ updateSyncResponse model r notify =
|
||||||
roomMessages sr = case room of
|
roomMessages sr = case room of
|
||||||
Just rid -> List.filter (((==) "m.room.message") << .type_)
|
Just rid -> List.filter (((==) "m.room.message") << .type_)
|
||||||
<| Maybe.withDefault []
|
<| Maybe.withDefault []
|
||||||
|
<| Maybe.map (List.filterMap (toMessageEvent))
|
||||||
<| Maybe.andThen .events
|
<| Maybe.andThen .events
|
||||||
<| Maybe.andThen .timeline
|
<| Maybe.andThen .timeline
|
||||||
<| Maybe.andThen (Dict.get rid)
|
<| 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
|
(Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId
|
||||||
_ -> Cmd.none
|
_ -> Cmd.none
|
||||||
receivedEvents sr = List.map Just <| allTimelineEventIds sr
|
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
|
<| allTimelineEvents sr
|
||||||
sending sr = Dict.filter (\tid (rid, { body, id }) -> not <| List.member (String.fromInt tid) <| receivedTransactions sr) model.sending
|
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 =
|
newModel sr =
|
||||||
{ model | sync = newSync sr
|
{ model | nextBatch = nextBatch
|
||||||
, sending = sending (mergeSyncResponse model.sync sr)
|
, sending = sending sr
|
||||||
, roomNames = computeRoomsDisplayNames model.userData (newSync sr)
|
, rooms = applySync sr model.rooms
|
||||||
|
, accountData = applyAccountData sr.accountData model.accountData
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
case r of
|
case r of
|
||||||
|
|
|
@ -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
39
src/Scylla/ListUtils.elm
Normal 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
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
module Scylla.Messages exposing (..)
|
module Scylla.Messages exposing (..)
|
||||||
import Scylla.Sync exposing (RoomEvent)
|
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.Route exposing (RoomId)
|
import Scylla.Route exposing (RoomId)
|
||||||
|
import Scylla.Room exposing (RoomData)
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
|
|
||||||
type SendingMessageBody = TextMessage String
|
type SendingMessageBody = TextMessage String
|
||||||
|
@ -13,7 +14,7 @@ type alias SendingMessage =
|
||||||
|
|
||||||
type Message
|
type Message
|
||||||
= Sending SendingMessage
|
= Sending SendingMessage
|
||||||
| Received RoomEvent
|
| Received MessageEvent
|
||||||
|
|
||||||
messageUsername : Username -> Message -> Username
|
messageUsername : Username -> Message -> Username
|
||||||
messageUsername u msg = case msg of
|
messageUsername u msg = case msg of
|
||||||
|
@ -36,9 +37,10 @@ mergeMessages du xs =
|
||||||
in
|
in
|
||||||
appendNamed fmu fms fmsl
|
appendNamed fmu fms fmsl
|
||||||
|
|
||||||
receivedMessagesRoom : List RoomEvent -> List Message
|
receivedMessagesRoom : RoomData -> List Message
|
||||||
receivedMessagesRoom es = List.map Received
|
receivedMessagesRoom rd = rd.messages
|
||||||
<| List.filter (\e -> e.type_ == "m.room.message") es
|
|> List.filter (\e -> e.type_ == "m.room.message")
|
||||||
|
|> List.map Received
|
||||||
|
|
||||||
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
sendingMessagesRoom : RoomId -> Dict Int (RoomId, SendingMessage) -> List Message
|
||||||
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
sendingMessagesRoom rid ms = List.map (\(tid, (_, sm)) -> Sending sm)
|
||||||
|
|
|
@ -1,7 +1,10 @@
|
||||||
module Scylla.Model exposing (..)
|
module Scylla.Model exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, HistoryResponse, JoinedRoom, senderName, roomName, roomJoinedUsers, findFirst, AccountData)
|
import Scylla.Sync exposing (SyncResponse, HistoryResponse)
|
||||||
import Scylla.AccountData exposing (directMessagesDecoder)
|
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.Login exposing (LoginResponse, Username, Password)
|
||||||
import Scylla.UserData exposing (UserData)
|
import Scylla.UserData exposing (UserData)
|
||||||
import Scylla.Route exposing (Route(..), RoomId)
|
import Scylla.Route exposing (Route(..), RoomId)
|
||||||
|
@ -26,7 +29,8 @@ type alias Model =
|
||||||
, loginUsername : Username
|
, loginUsername : Username
|
||||||
, loginPassword : Password
|
, loginPassword : Password
|
||||||
, apiUrl : ApiUrl
|
, apiUrl : ApiUrl
|
||||||
, sync : SyncResponse
|
, accountData : AccountData
|
||||||
|
, nextBatch : String
|
||||||
, errors : List String
|
, errors : List String
|
||||||
, roomText : Dict RoomId String
|
, roomText : Dict RoomId String
|
||||||
, sending : Dict Int (RoomId, SendingMessage)
|
, sending : Dict Int (RoomId, SendingMessage)
|
||||||
|
@ -35,6 +39,7 @@ type alias Model =
|
||||||
, roomNames : Dict RoomId String
|
, roomNames : Dict RoomId String
|
||||||
, connected : Bool
|
, connected : Bool
|
||||||
, searchText : String
|
, searchText : String
|
||||||
|
, rooms : OpenRooms
|
||||||
}
|
}
|
||||||
|
|
||||||
type Msg =
|
type Msg =
|
||||||
|
@ -73,41 +78,6 @@ type Msg =
|
||||||
| AttemptReconnect -- User wants to reconnect to server
|
| AttemptReconnect -- User wants to reconnect to server
|
||||||
| UpdateSearchText String -- Change search text in room list
|
| 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 : String -> String
|
||||||
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
roomUrl s = Url.Builder.absolute [ "room", s ] []
|
||||||
|
|
||||||
|
@ -117,13 +87,6 @@ loginUrl = Url.Builder.absolute [ "login" ] []
|
||||||
newUsers : Model -> List Username -> List Username
|
newUsers : Model -> List Username -> List Username
|
||||||
newUsers m lus = List.filter (\u -> not <| Dict.member u m.userData) lus
|
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 : Model -> Maybe RoomId
|
||||||
currentRoomId m = case m.route of
|
currentRoomId m = case m.route of
|
||||||
Room r -> Just r
|
Room r -> Just r
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
port module Scylla.Notification exposing (..)
|
port module Scylla.Notification exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, RoomEvent, joinedRoomsTimelineEvents)
|
import Scylla.Sync exposing (SyncResponse, joinedRoomsTimelineEvents)
|
||||||
import Scylla.AccountData exposing (..)
|
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent)
|
||||||
import Json.Decode as Decode exposing (string, field)
|
import Json.Decode as Decode exposing (string, field)
|
||||||
import Dict
|
import Dict
|
||||||
|
|
||||||
|
@ -13,17 +13,18 @@ type alias Notification =
|
||||||
port sendNotificationPort : Notification -> Cmd msg
|
port sendNotificationPort : Notification -> Cmd msg
|
||||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
port onNotificationClickPort : (String -> msg) -> Sub msg
|
||||||
|
|
||||||
notificationText : RoomEvent -> String
|
notificationText : MessageEvent -> String
|
||||||
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
||||||
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
||||||
_ -> ""
|
_ -> ""
|
||||||
|
|
||||||
joinedRoomNotificationEvents : SyncResponse -> List (String, RoomEvent)
|
joinedRoomNotificationEvents : SyncResponse -> List (String, MessageEvent)
|
||||||
joinedRoomNotificationEvents s =
|
joinedRoomNotificationEvents s =
|
||||||
let
|
let
|
||||||
applyPair k = List.map (\v -> (k, v))
|
applyPair k = List.map (\v -> (k, v))
|
||||||
in
|
in
|
||||||
List.sortBy (\(k, v) -> v.originServerTs)
|
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) []
|
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
||||||
<| joinedRoomsTimelineEvents s
|
<| joinedRoomsTimelineEvents s
|
||||||
|
|
||||||
|
|
179
src/Scylla/Room.elm
Normal file
179
src/Scylla/Room.elm
Normal 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
|
||||||
|
|
|
@ -2,223 +2,16 @@ module Scylla.Sync exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.Route exposing (RoomId)
|
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 Dict exposing (Dict)
|
||||||
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
import Json.Decode as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||||
import Json.Decode.Pipeline exposing (required, optional)
|
import Json.Decode.Pipeline exposing (required, optional)
|
||||||
import Set exposing (Set)
|
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
|
-- General Sync Response
|
||||||
type alias SyncResponse =
|
type alias SyncResponse =
|
||||||
{ nextBatch : String
|
{ nextBatch : String
|
||||||
|
@ -259,213 +52,20 @@ historyResponseDecoder =
|
||||||
|> required "chunk" (list roomEventDecoder)
|
|> required "chunk" (list roomEventDecoder)
|
||||||
|
|
||||||
-- Business Logic: Helper Functions
|
-- 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 : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||||
findFirstEvent = findFirstBy .originServerTs
|
findFirstEvent = findFirstBy .originServerTs
|
||||||
|
|
||||||
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
|
||||||
findLastEvent = findLastBy .originServerTs
|
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
|
-- 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 String { a | timeline : Maybe Timeline } -> List RoomEvent
|
||||||
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events)
|
||||||
<| List.filterMap .timeline
|
<| List.filterMap .timeline
|
||||||
<| Dict.values dict
|
<| Dict.values dict
|
||||||
|
|
||||||
allTimelineEventIds : SyncResponse -> List String
|
allTimelineEventIds : SyncResponse -> List String
|
||||||
allTimelineEventIds s = List.map .eventId <| allTimelineEvents s
|
allTimelineEventIds s = List.map getEventId <| allTimelineEvents s
|
||||||
|
|
||||||
allTimelineEvents : SyncResponse -> List RoomEvent
|
allTimelineEvents : SyncResponse -> List RoomEvent
|
||||||
allTimelineEvents s =
|
allTimelineEvents s =
|
||||||
|
@ -476,7 +76,7 @@ allTimelineEvents s =
|
||||||
joinedEvents = eventsFor .join
|
joinedEvents = eventsFor .join
|
||||||
leftEvents = eventsFor .leave
|
leftEvents = eventsFor .leave
|
||||||
in
|
in
|
||||||
uniqueBy .eventId <| leftEvents ++ joinedEvents
|
leftEvents ++ joinedEvents
|
||||||
|
|
||||||
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
joinedRoomsTimelineEvents : SyncResponse -> Dict String (List RoomEvent)
|
||||||
joinedRoomsTimelineEvents s =
|
joinedRoomsTimelineEvents s =
|
||||||
|
@ -484,65 +84,6 @@ joinedRoomsTimelineEvents s =
|
||||||
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
|
<| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline))
|
||||||
<| Maybe.andThen .join s.rooms
|
<| 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
|
-- Business Logic: Users
|
||||||
allUsers : SyncResponse -> List Username
|
allUsers : SyncResponse -> List Username
|
||||||
allUsers s = uniqueBy (\u -> u) <| List.map .sender <| allTimelineEvents s
|
allUsers s = uniqueBy (\u -> u) <| List.map getSender <| 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
|
|
||||||
|
|
50
src/Scylla/Sync/AccountData.elm
Normal file
50
src/Scylla/Sync/AccountData.elm
Normal 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
|
9
src/Scylla/Sync/DecodeTools.elm
Normal file
9
src/Scylla/Sync/DecodeTools.elm
Normal 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
143
src/Scylla/Sync/Events.elm
Normal 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
109
src/Scylla/Sync/Rooms.elm
Normal 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
|
|
@ -1,6 +1,8 @@
|
||||||
module Scylla.UserData exposing (..)
|
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 as Decode exposing (Decoder, int, string, float, list, value, dict, bool, field)
|
||||||
import Json.Decode.Pipeline exposing (required, optional)
|
import Json.Decode.Pipeline exposing (required, optional)
|
||||||
|
import Dict exposing (Dict)
|
||||||
|
|
||||||
type alias UserData =
|
type alias UserData =
|
||||||
{ displayName : Maybe String
|
{ displayName : Maybe String
|
||||||
|
@ -12,3 +14,18 @@ userDataDecoder =
|
||||||
Decode.succeed UserData
|
Decode.succeed UserData
|
||||||
|> optional "displayname" (Decode.map Just string) Nothing
|
|> optional "displayname" (Decode.map Just string) Nothing
|
||||||
|> optional "avatar_url" (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,13 +1,17 @@
|
||||||
module Scylla.Views exposing (..)
|
module Scylla.Views exposing (..)
|
||||||
import Scylla.Model exposing (..)
|
import Scylla.Model exposing (..)
|
||||||
import Scylla.Sync 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.Route exposing (..)
|
||||||
import Scylla.Fnv as Fnv
|
import Scylla.Fnv as Fnv
|
||||||
import Scylla.Messages exposing (..)
|
import Scylla.Messages exposing (..)
|
||||||
import Scylla.Login exposing (Username)
|
import Scylla.Login exposing (Username)
|
||||||
import Scylla.UserData exposing (UserData)
|
import Scylla.UserData exposing (UserData, getDisplayName)
|
||||||
import Scylla.Http exposing (fullMediaUrl)
|
import Scylla.Http exposing (fullMediaUrl)
|
||||||
import Scylla.Api exposing (ApiUrl)
|
import Scylla.Api exposing (ApiUrl)
|
||||||
|
import Scylla.ListUtils exposing (groupBy)
|
||||||
import Html.Parser
|
import Html.Parser
|
||||||
import Html.Parser.Util
|
import Html.Parser.Util
|
||||||
import Svg
|
import Svg
|
||||||
|
@ -44,10 +48,8 @@ stringColor s =
|
||||||
viewFull : Model -> List (Html Msg)
|
viewFull : Model -> List (Html Msg)
|
||||||
viewFull model =
|
viewFull model =
|
||||||
let
|
let
|
||||||
room r = Maybe.map (\jr -> (r, jr))
|
room r = Dict.get r model.rooms
|
||||||
<| Maybe.andThen (Dict.get r)
|
|> Maybe.map (\rd -> (r, rd))
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| model.sync.rooms
|
|
||||||
core = case model.route of
|
core = case model.route of
|
||||||
Login -> loginView model
|
Login -> loginView model
|
||||||
Base -> baseView model Nothing
|
Base -> baseView model Nothing
|
||||||
|
@ -63,10 +65,10 @@ errorsView = div [ class "errors-wrapper" ] << List.indexedMap errorView
|
||||||
errorView : Int -> String -> Html Msg
|
errorView : Int -> String -> Html Msg
|
||||||
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
|
errorView i s = div [ class "error-wrapper", onClick <| DismissError i ] [ iconView "alert-triangle", text s ]
|
||||||
|
|
||||||
baseView : Model -> Maybe (RoomId, JoinedRoom) -> Html Msg
|
baseView : Model -> Maybe (RoomId, RoomData) -> Html Msg
|
||||||
baseView m jr =
|
baseView m rd =
|
||||||
let
|
let
|
||||||
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) jr
|
roomView = Maybe.map (\(id, r) -> joinedRoomView m id r) rd
|
||||||
reconnect = reconnectView m
|
reconnect = reconnectView m
|
||||||
in
|
in
|
||||||
div [ class "base-wrapper" ] <| maybeHtml
|
div [ class "base-wrapper" ] <| maybeHtml
|
||||||
|
@ -83,11 +85,8 @@ reconnectView m = if m.connected
|
||||||
roomListView : Model -> Html Msg
|
roomListView : Model -> Html Msg
|
||||||
roomListView m =
|
roomListView m =
|
||||||
let
|
let
|
||||||
rooms = Maybe.withDefault (Dict.empty)
|
|
||||||
<| Maybe.andThen .join
|
|
||||||
<| m.sync.rooms
|
|
||||||
groups = roomGroups
|
groups = roomGroups
|
||||||
<| Dict.toList rooms
|
<| Dict.toList m.rooms
|
||||||
homeserverList = div [ class "homeservers-list" ]
|
homeserverList = div [ class "homeservers-list" ]
|
||||||
<| List.map (\(k, v) -> homeserverView m k v)
|
<| List.map (\(k, v) -> homeserverView m k v)
|
||||||
<| Dict.toList groups
|
<| Dict.toList groups
|
||||||
|
@ -104,22 +103,22 @@ roomListView m =
|
||||||
, homeserverList
|
, homeserverList
|
||||||
]
|
]
|
||||||
|
|
||||||
roomGroups : List (String, JoinedRoom) -> Dict String (List (String, JoinedRoom))
|
roomGroups : List (String, RoomData) -> Dict String (List (String, RoomData))
|
||||||
roomGroups jrs = groupBy (homeserver << Tuple.first) jrs
|
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 =
|
homeserverView m hs rs =
|
||||||
let
|
let
|
||||||
roomList = div [ class "rooms-list" ]
|
roomList = div [ class "rooms-list" ]
|
||||||
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
<| List.map (\(rid, r) -> roomListElementView m rid r)
|
||||||
<| List.sortBy (\(rid, r) -> roomDisplayName m.roomNames rid) rs
|
<| List.sortBy (\(rid, r) -> getRoomName m.accountData m.userData rid r) rs
|
||||||
in
|
in
|
||||||
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
div [ class "homeserver-wrapper" ] [ h3 [] [ text hs ], roomList ]
|
||||||
|
|
||||||
roomListElementView : Model -> RoomId -> JoinedRoom -> Html Msg
|
roomListElementView : Model -> RoomId -> RoomData -> Html Msg
|
||||||
roomListElementView m rid jr =
|
roomListElementView m rid rd =
|
||||||
let
|
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)
|
isVisible = m.searchText == "" || (String.contains (String.toLower m.searchText) <| String.toLower name)
|
||||||
isCurrentRoom = case currentRoomId m of
|
isCurrentRoom = case currentRoomId m of
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
|
@ -131,10 +130,10 @@ roomListElementView m rid jr =
|
||||||
, ("hidden", not isVisible)
|
, ("hidden", not isVisible)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
<| roomNotificationCountView jr.unreadNotifications ++
|
<| roomNotificationCountView rd.unreadNotifications ++
|
||||||
[ a [ href <| roomUrl rid ] [ text name ] ]
|
[ a [ href <| roomUrl rid ] [ text name ] ]
|
||||||
|
|
||||||
roomNotificationCountView : Maybe UnreadNotificationCounts -> List (Html Msg)
|
roomNotificationCountView : UnreadNotificationCounts -> List (Html Msg)
|
||||||
roomNotificationCountView ns =
|
roomNotificationCountView ns =
|
||||||
let
|
let
|
||||||
wrap b = span
|
wrap b = span
|
||||||
|
@ -143,7 +142,7 @@ roomNotificationCountView ns =
|
||||||
, ("bright", b)
|
, ("bright", b)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
getCount f = Maybe.withDefault 0 << Maybe.andThen f
|
getCount f = Maybe.withDefault 0 << f
|
||||||
in
|
in
|
||||||
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
case (getCount .notificationCount ns, getCount .highlightCount ns) of
|
||||||
(0, 0) -> []
|
(0, 0) -> []
|
||||||
|
@ -159,10 +158,10 @@ loginView m = div [ class "login-wrapper" ]
|
||||||
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
, button [ onClick AttemptLogin ] [ text "Log In" ]
|
||||||
]
|
]
|
||||||
|
|
||||||
joinedRoomView : Model -> RoomId -> JoinedRoom -> Html Msg
|
joinedRoomView : Model -> RoomId -> RoomData -> Html Msg
|
||||||
joinedRoomView m roomId jr =
|
joinedRoomView m roomId rd =
|
||||||
let
|
let
|
||||||
typing = List.map (displayName m.userData) <| roomTypingUsers jr
|
typing = List.map (getDisplayName m.userData) <| getRoomTypingUsers rd
|
||||||
typingText = String.join ", " typing
|
typingText = String.join ", " typing
|
||||||
typingSuffix = case List.length typing of
|
typingSuffix = case List.length typing of
|
||||||
0 -> ""
|
0 -> ""
|
||||||
|
@ -183,18 +182,16 @@ joinedRoomView m roomId jr =
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
div [ class "room-wrapper" ]
|
div [ class "room-wrapper" ]
|
||||||
[ h2 [] [ text <| roomDisplayName m.roomNames roomId ]
|
[ h2 [] [ text <| getRoomName m.accountData m.userData roomId rd ]
|
||||||
, lazy6 lazyMessagesView m.userData roomId jr m.apiUrl m.loginUsername m.sending
|
, lazy6 lazyMessagesView m.userData roomId rd m.apiUrl m.loginUsername m.sending
|
||||||
, messageInput
|
, messageInput
|
||||||
, typingWrapper
|
, typingWrapper
|
||||||
]
|
]
|
||||||
|
|
||||||
lazyMessagesView : Dict String UserData -> RoomId -> JoinedRoom -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
lazyMessagesView : Dict String UserData -> RoomId -> RoomData -> ApiUrl -> Username -> Dict Int (RoomId, SendingMessage) -> Html Msg
|
||||||
lazyMessagesView ud rid jr au lu snd =
|
lazyMessagesView ud rid rd au lu snd =
|
||||||
let
|
let
|
||||||
roomReceived = receivedMessagesRoom
|
roomReceived = receivedMessagesRoom rd
|
||||||
<| Maybe.withDefault []
|
|
||||||
<| Maybe.andThen .events jr.timeline
|
|
||||||
roomSending = sendingMessagesRoom rid snd
|
roomSending = sendingMessagesRoom rid snd
|
||||||
renderedMessages = List.map (userMessagesView ud au)
|
renderedMessages = List.map (userMessagesView ud au)
|
||||||
<| mergeMessages lu
|
<| mergeMessages lu
|
||||||
|
@ -229,7 +226,7 @@ messagesWrapperView rid es = div [ class "messages-wrapper", id "messages-wrappe
|
||||||
|
|
||||||
senderView : Dict String UserData -> Username -> Html Msg
|
senderView : Dict String UserData -> Username -> Html Msg
|
||||||
senderView ud s =
|
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 : Dict String UserData -> ApiUrl -> (Username, List Message) -> Html Msg
|
||||||
userMessagesView ud apiUrl (u, ms) =
|
userMessagesView ud apiUrl (u, ms) =
|
||||||
|
@ -250,7 +247,7 @@ sendingMessageView : SendingMessage -> Html Msg
|
||||||
sendingMessageView msg = case msg.body of
|
sendingMessageView msg = case msg.body of
|
||||||
TextMessage t -> span [ class "sending"] [ text t ]
|
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 =
|
roomEventView ud apiUrl re =
|
||||||
let
|
let
|
||||||
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
msgtype = Decode.decodeValue (Decode.field "msgtype" Decode.string) re.content
|
||||||
|
@ -264,13 +261,13 @@ roomEventView ud apiUrl re =
|
||||||
Ok "m.video" -> roomEventVideoView apiUrl re
|
Ok "m.video" -> roomEventVideoView apiUrl re
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
roomEventFormattedContent : RoomEvent -> Maybe (List (Html Msg))
|
roomEventFormattedContent : MessageEvent -> Maybe (List (Html Msg))
|
||||||
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
|
roomEventFormattedContent re = Maybe.map Html.Parser.Util.toVirtualDom
|
||||||
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
|
<| Maybe.andThen (Result.toMaybe << Html.Parser.run )
|
||||||
<| Result.toMaybe
|
<| Result.toMaybe
|
||||||
<| Decode.decodeValue (Decode.field "formatted_body" Decode.string) re.content
|
<| 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 =
|
roomEventContent f re =
|
||||||
let
|
let
|
||||||
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
body = Decode.decodeValue (Decode.field "body" Decode.string) re.content
|
||||||
|
@ -280,20 +277,20 @@ roomEventContent f re =
|
||||||
Just c -> Just <| f c
|
Just c -> Just <| f c
|
||||||
Nothing -> Maybe.map (f << List.singleton << text) <| Result.toMaybe body
|
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 =
|
roomEventEmoteView ud re =
|
||||||
let
|
let
|
||||||
emoteText = "* " ++ displayName ud re.sender ++ " "
|
emoteText = "* " ++ getDisplayName ud re.sender ++ " "
|
||||||
in
|
in
|
||||||
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
roomEventContent (\cs -> span [] (text emoteText :: cs)) re
|
||||||
|
|
||||||
roomEventNoticeView : RoomEvent -> Maybe (Html Msg)
|
roomEventNoticeView : MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
roomEventNoticeView = roomEventContent (span [ class "message-notice" ])
|
||||||
|
|
||||||
roomEventTextView : RoomEvent -> Maybe (Html Msg)
|
roomEventTextView : MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventTextView = roomEventContent (span [])
|
roomEventTextView = roomEventContent (span [])
|
||||||
|
|
||||||
roomEventImageView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventImageView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventImageView apiUrl re =
|
roomEventImageView apiUrl re =
|
||||||
let
|
let
|
||||||
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
body = Decode.decodeValue (Decode.field "url" Decode.string) re.content
|
||||||
|
@ -302,7 +299,7 @@ roomEventImageView apiUrl re =
|
||||||
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
<| Maybe.map (contentRepositoryDownloadUrl apiUrl)
|
||||||
<| Result.toMaybe body
|
<| Result.toMaybe body
|
||||||
|
|
||||||
roomEventFileView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventFileView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventFileView apiUrl re =
|
roomEventFileView apiUrl re =
|
||||||
let
|
let
|
||||||
decoder = Decode.map2 (\l r -> (l, r)) (Decode.field "url" Decode.string) (Decode.field "body" Decode.string)
|
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))
|
<| Maybe.map (\(url, name) -> (contentRepositoryDownloadUrl apiUrl url, name))
|
||||||
<| Result.toMaybe fileData
|
<| Result.toMaybe fileData
|
||||||
|
|
||||||
roomEventVideoView : ApiUrl -> RoomEvent -> Maybe (Html Msg)
|
roomEventVideoView : ApiUrl -> MessageEvent -> Maybe (Html Msg)
|
||||||
roomEventVideoView apiUrl re =
|
roomEventVideoView apiUrl re =
|
||||||
let
|
let
|
||||||
decoder = Decode.map2 (\l r -> (l, r))
|
decoder = Decode.map2 (\l r -> (l, r))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user