Fully switch away from keeping sync

This commit is contained in:
Danila Fedorin 2019-09-11 00:52:42 -07:00
parent 29e81a88ac
commit 5c02ae8a58
8 changed files with 127 additions and 120 deletions

View File

@ -44,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
@ -67,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"
@ -191,17 +187,14 @@ updateHistoryResponse m r hr =
<| 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
@ -256,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.map (List.filterMap toMessageEvent) <| 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
@ -314,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
@ -327,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
@ -354,12 +348,11 @@ updateSyncResponse model r notify =
receivedTransactions sr = List.filterMap (Maybe.andThen .transactionId << getUnsigned) 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 , rooms = applySync sr model.rooms
, accountData = applyAccountData sr.accountData model.accountData
} }
in in
case r of case r of

View File

@ -2,6 +2,7 @@ module Scylla.Messages exposing (..)
import Scylla.Sync.Events exposing (RoomEvent, MessageEvent, toMessageEvent) 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
@ -36,10 +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") |> List.filter (\e -> e.type_ == "m.room.message")
<| List.filterMap toMessageEvent es |> 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)

View File

@ -1,6 +1,6 @@
module Scylla.Model exposing (..) module Scylla.Model exposing (..)
import Scylla.Api exposing (..) import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, HistoryResponse, senderName, roomName, roomJoinedUsers) import Scylla.Sync exposing (SyncResponse, HistoryResponse, roomJoinedUsers)
import Scylla.ListUtils exposing (findFirst) import Scylla.ListUtils exposing (findFirst)
import Scylla.Room exposing (OpenRooms) import Scylla.Room exposing (OpenRooms)
import Scylla.Sync.Rooms exposing (JoinedRoom) import Scylla.Sync.Rooms exposing (JoinedRoom)
@ -29,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)
@ -77,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 ] []
@ -121,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

View File

@ -2,11 +2,13 @@ module Scylla.Room exposing (..)
import Scylla.Route exposing (RoomId) import Scylla.Route exposing (RoomId)
import Scylla.Sync exposing (SyncResponse) import Scylla.Sync exposing (SyncResponse)
import Scylla.Login exposing (Username) import Scylla.Login exposing (Username)
import Scylla.UserData exposing (UserData) import Scylla.UserData exposing (UserData, getDisplayName)
import Scylla.Sync exposing (HistoryResponse)
import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent) import Scylla.Sync.Events exposing (MessageEvent, StateEvent, toStateEvent, toMessageEvent)
import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages) import Scylla.Sync.AccountData exposing (AccountData, getDirectMessages, applyAccountData)
import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral) import Scylla.Sync.Rooms exposing (JoinedRoom, UnreadNotificationCounts, Ephemeral)
import Json.Decode as Decode exposing (Decoder, Value, decodeValue) import Scylla.ListUtils exposing (findFirst, uniqueBy)
import Json.Decode as Decode exposing (Decoder, Value, decodeValue, field, string, list)
import Dict exposing (Dict) import Dict exposing (Dict)
type alias RoomState = Dict (String, String) Value type alias RoomState = Dict (String, String) Value
@ -17,6 +19,7 @@ type alias RoomData =
, accountData : AccountData , accountData : AccountData
, ephemeral : Ephemeral , ephemeral : Ephemeral
, unreadNotifications : UnreadNotificationCounts , unreadNotifications : UnreadNotificationCounts
, prevHistoryBatch : Maybe String
, text : String , text : String
} }
@ -35,6 +38,7 @@ emptyRoomData =
{ highlightCount = Just 0 { highlightCount = Just 0
, notificationCount = Just 0 , notificationCount = Just 0
} }
, prevHistoryBatch = Nothing
, text = "" , text = ""
} }
@ -59,16 +63,6 @@ changeRoomState jr rs =
|> changeRoomStateEvents stateDiff |> changeRoomStateEvents stateDiff
|> changeRoomStateEvents timelineDiff |> changeRoomStateEvents timelineDiff
changeAccountData : JoinedRoom -> AccountData -> AccountData
changeAccountData jr ad =
case jr.accountData of
Nothing -> ad
Just newAd ->
case (newAd.events, ad.events) of
(Just es, Nothing) -> newAd
(Just newEs, Just es) -> { events = Just (newEs ++ es) }
_ -> ad
changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent) changeTimeline : JoinedRoom -> List (MessageEvent) -> List (MessageEvent)
changeTimeline jr tl = changeTimeline jr tl =
let let
@ -77,7 +71,7 @@ changeTimeline jr tl =
|> Maybe.map (List.filterMap toMessageEvent) |> Maybe.map (List.filterMap toMessageEvent)
|> Maybe.withDefault [] |> Maybe.withDefault []
in in
newMessages ++ tl tl ++ newMessages
changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral changeEphemeral : JoinedRoom -> Ephemeral -> Ephemeral
changeEphemeral jr e = Maybe.withDefault e jr.ephemeral changeEphemeral jr e = Maybe.withDefault e jr.ephemeral
@ -87,11 +81,12 @@ changeNotifications jr un = Maybe.withDefault un jr.unreadNotifications
changeRoomData : JoinedRoom -> RoomData -> RoomData changeRoomData : JoinedRoom -> RoomData -> RoomData
changeRoomData jr rd = changeRoomData jr rd =
{ rd | accountData = changeAccountData jr rd.accountData { rd | accountData = applyAccountData jr.accountData rd.accountData
, roomState = changeRoomState jr rd.roomState , roomState = changeRoomState jr rd.roomState
, messages = changeTimeline jr rd.messages , messages = changeTimeline jr rd.messages
, ephemeral = changeEphemeral jr rd.ephemeral , ephemeral = changeEphemeral jr rd.ephemeral
, unreadNotifications = changeNotifications jr rd.unreadNotifications , unreadNotifications = changeNotifications jr rd.unreadNotifications
, prevHistoryBatch = Maybe.andThen .prevBatch jr.timeline
} }
updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData updateRoomData : JoinedRoom -> Maybe RoomData -> Maybe RoomData
@ -111,18 +106,63 @@ applySync sr or =
in in
Dict.foldl applyJoinedRoom or joinedRooms 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 : (String, String) -> Decoder a -> RoomData -> Maybe a
getStateData k d rd = Dict.get k rd.roomState getStateData k d rd = Dict.get k rd.roomState
|> Maybe.andThen (Result.toMaybe << decodeValue d) |> Maybe.andThen (Result.toMaybe << decodeValue d)
getRoomName : Maybe AccountData -> Dict Username UserData -> RoomId -> RoomData -> String 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 = getRoomName ad ud rid rd =
let let
customName = getStateData ("m.room.name", "") Decode.string rd customName = getStateData ("m.room.name", "") (field "name" (string)) rd
direct = Maybe.andThen getDirectMessages ad direct = getDirectMessages ad
|> Maybe.andThen (Dict.get rid) |> Maybe.andThen (Dict.get rid)
in in
case (customName, direct) of case (customName, direct) of
(Just cn, _) -> cn (Just cn, _) -> cn
(_, Just d) -> d (_, Just d) -> getDisplayName ud d
_ -> rid _ -> 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 ++ ")"

View File

@ -178,15 +178,6 @@ appendHistoryResponse sr r hr =
{ sr | rooms = newRooms } { sr | rooms = newRooms }
-- Business Logic: Names -- 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 : String -> String
homeserver s = homeserver s =
let let

View File

@ -30,6 +30,16 @@ invertDirectMessages dmr =
Dict.empty Dict.empty
dmr 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 : String -> Decode.Decoder a -> AccountData -> Maybe a
getAccountData key d ad = ad.events getAccountData key d ad = ad.events
|> Maybe.andThen (findFirst ((==) key << .type_)) |> Maybe.andThen (findFirst ((==) key << .type_))

View File

@ -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

View File

@ -3,12 +3,12 @@ import Scylla.Model exposing (..)
import Scylla.Sync exposing (..) import Scylla.Sync exposing (..)
import Scylla.Sync.Events exposing (..) import Scylla.Sync.Events exposing (..)
import Scylla.Sync.Rooms exposing (..) import Scylla.Sync.Rooms exposing (..)
import Scylla.Room exposing (RoomData, emptyOpenRooms, getRoomName) import Scylla.Room exposing (RoomData, emptyOpenRooms, 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 Scylla.ListUtils exposing (groupBy)
@ -48,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
@ -67,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
@ -113,14 +111,14 @@ 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) -> getRoomName m.sync.accountData m.userData rid r) 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 -> RoomData -> Html Msg roomListElementView : Model -> RoomId -> RoomData -> Html Msg
roomListElementView m rid rd = roomListElementView m rid rd =
let let
name = getRoomName m.sync.accountData m.userData rid rd 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
@ -160,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 -> ""
@ -184,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
@ -230,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) =
@ -284,7 +280,7 @@ roomEventContent f re =
roomEventEmoteView : Dict String UserData -> MessageEvent -> 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