Compare commits

...

6 Commits

6 changed files with 103 additions and 22 deletions

View File

@ -6,6 +6,8 @@ import Scylla.Model exposing (..)
import Scylla.Http exposing (..)
import Scylla.Views exposing (viewFull)
import Scylla.Route exposing (Route(..))
import Scylla.UserData exposing (..)
import Scylla.Notification exposing (..)
import Url exposing (Url)
import Url.Parser exposing (parse)
import Url.Builder
@ -57,15 +59,21 @@ update msg model = case msg of
ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
TryUrl urlRequest -> updateTryUrl model urlRequest
OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
ChangeRoute r -> ({ model | route = r }, Cmd.none)
ReceiveLoginResponse r -> updateLoginResponse model r
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
ReceiveSyncResponse r -> updateSyncResponse model r True
ReceiveUserData s r -> (model, Cmd.none)
ReceiveUserData s r -> updateUserData model s r
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
SendRoomText r -> updateSendRoomText model r
SendRoomTextResponse r -> (model, Cmd.none)
updateUserData : Model -> String -> Result Http.Error UserData -> (Model, Cmd Msg)
updateUserData m s r = case r of
Ok ud -> ({ m | userData = Dict.insert s ud m.userData }, Cmd.none)
Err e -> (m, userData m.apiUrl (Maybe.withDefault "" m.token) s)
updateSendRoomText : Model -> String -> (Model, Cmd Msg)
updateSendRoomText m r =
let
@ -84,7 +92,7 @@ updateTryUrl m ur = case ur of
updateLoginResponse : Model -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
updateLoginResponse model r = case r of
Ok lr -> ( { model | token = Just lr.accessToken } , Cmd.batch
Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId } , Cmd.batch
[ firstSync model.apiUrl lr.accessToken
, Nav.pushUrl model.key <| Url.Builder.absolute [] []
] )
@ -96,14 +104,34 @@ updateSyncResponse model r notify =
token = Maybe.withDefault "" model.token
nextBatch = Result.withDefault model.sync.nextBatch
<| Result.map .nextBatch r
cmd = sync nextBatch model.apiUrl token
syncCmd = sync nextBatch model.apiUrl token
newUsers sr = List.filter (\s -> not <| Dict.member s model.userData) <| roomsUsers sr
newUserCommands sr = Cmd.batch
<| List.map (userData model.apiUrl
<| Maybe.withDefault "" model.token)
<| newUsers sr
notification sr = findFirstBy
(\(s, e) -> e.originServerTs)
(\(s, e) -> e.sender /= model.loginUsername)
<| notificationEvents sr
notificationCommand sr = Maybe.withDefault Cmd.none
<| Maybe.map (\(s, e) -> sendNotificationPort
{ name = displayName model e.sender
, text = notificationText e
, room = s
})
<| notification sr
in
case r of
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, cmd)
_ -> (model, cmd)
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
[ syncCmd
, newUserCommands sr
, if notify then notificationCommand sr else Cmd.none
])
_ -> (model, syncCmd)
subscriptions : Model -> Sub Msg
subscriptions m = Sub.none
subscriptions m = onNotificationClickPort OpenRoom
onUrlRequest : Browser.UrlRequest -> Msg
onUrlRequest = TryUrl

View File

@ -1,10 +1,11 @@
module Scylla.Model exposing (..)
import Scylla.Api exposing (..)
import Scylla.Sync exposing (SyncResponse, JoinedRoom)
import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
import Scylla.Login exposing (LoginResponse, Username, Password)
import Scylla.UserData exposing (UserData)
import Scylla.Route exposing (Route)
import Browser.Navigation as Nav
import Url.Builder
import Dict exposing (Dict)
import Browser
import Http
@ -30,6 +31,7 @@ type Msg =
| ChangeLoginPassword Password -- During login screen: the password
| AttemptLogin -- During login screen, login button presed
| TryUrl Browser.UrlRequest -- User attempts to change URL
| OpenRoom String -- We try open a room
| ChangeRoute Route -- URL changes
| ChangeRoomText String String -- Change to a room's input text
| SendRoomText String -- Sends a message typed into a given room's input
@ -39,3 +41,11 @@ type Msg =
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
| ReceiveUserData Username (Result Http.Error UserData)
displayName : Model -> Username -> String
displayName m s = Maybe.withDefault (senderName s) <| Maybe.andThen .displayName <| Dict.get s m.userData
roomUrl : String -> String
roomUrl s = Url.Builder.absolute [ "room", s ] []
loginUrl : String
loginUrl = Url.Builder.absolute [ "login" ] []

View File

@ -8,4 +8,4 @@ type alias Notification =
}
port sendNotificationPort : Notification -> Cmd msg
port onNotificationClickPort : (Json.Decode.Value -> msg) -> Sub msg
port onNotificationClickPort : (String -> msg) -> Sub msg

View File

@ -269,6 +269,26 @@ uniqueByRecursive f l s = case l of
uniqueBy : (a -> comparable) -> List a -> List a
uniqueBy f l = uniqueByRecursive f l Set.empty
findFirst : (a -> Bool) -> List a -> Maybe a
findFirst cond l = case l of
x::xs -> if cond x then Just x else findFirst cond xs
[] -> Nothing
findLast : (a -> Bool) -> List a -> Maybe a
findLast cond l = findFirst cond <| List.reverse l
findFirstBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findFirstBy sortFunction cond l = findFirst cond <| List.sortBy sortFunction l
findLastBy : (a -> comparable) -> (a -> Bool) -> List a -> Maybe a
findLastBy sortFunction cond l = findLast cond <| List.sortBy sortFunction l
findFirstEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findFirstEvent = findFirstBy .originServerTs
findLastEvent : ({ a | originServerTs : Int } -> Bool) -> List { a | originServerTs : Int } -> Maybe { a | originServerTs : Int }
findLastEvent = findLastBy .originServerTs
-- Business Logic: Merging
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
mergeMaybe f l r = case (l, r) of
@ -309,11 +329,15 @@ 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 t2.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
@ -364,19 +388,23 @@ roomName : JoinedRoom -> Maybe String
roomName jr =
let
state = jr.state
nameEvent = List.head << List.sortBy (\e -> -e.originServerTs) << List.filter (\e -> e.type_ == "m.room.name")
nameEvent = findLastEvent (((==) "m.room.name") << .type_)
name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
in
Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
-- Business Logic: Event Extraction
notificationEvent : SyncResponse -> Maybe (String, RoomEvent)
notificationEvent s =
notificationText : RoomEvent -> String
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
_ -> ""
notificationEvents : SyncResponse -> List (String, RoomEvent)
notificationEvents s =
let
applyPair k = List.map (\v -> (k, v))
in
List.head
<| List.sortBy (\(k, v) -> v.originServerTs)
List.sortBy (\(k, v) -> v.originServerTs)
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
<| joinedRoomsEvents s
@ -387,6 +415,13 @@ joinedRoomsEvents s =
<| Maybe.andThen .join s.rooms
-- Business Logic: User Extraction
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
roomsUsers : SyncResponse -> List Username
roomsUsers s =
let
@ -399,4 +434,4 @@ roomsUsers s =
joinedUsers = usersFor .join
leftUsers = usersFor .leave
in
leftUsers ++ joinedUsers
uniqueBy (\u -> u) <| leftUsers ++ joinedUsers

View File

@ -3,6 +3,7 @@ import Scylla.Model exposing (..)
import Scylla.Sync exposing (..)
import Scylla.Route exposing (..)
import Scylla.Fnv as Fnv
import Scylla.Login exposing (Username)
import Svg
import Svg.Attributes
import Url.Builder
@ -68,7 +69,7 @@ roomListElementView s jr =
let
name = Maybe.withDefault "<No Name>" <| roomName jr
in
a [ href <| Url.Builder.absolute [ "room", s ] [] ] [ text name ]
a [ href <| roomUrl s ] [ text name ]
loginView : Model -> Html Msg
loginView m = div [ class "login-wrapper" ]
@ -85,6 +86,13 @@ joinedRoomView m roomId jr =
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
renderedEvents = List.filterMap (eventView m) events
eventWrapper = eventWrapperView m renderedEvents
typing = List.map (displayName m) <| roomTypingUsers jr
typingText = String.join ", " typing
typingSuffix = case List.length typing of
0 -> ""
1 -> " is typing..."
_ -> " are typing..."
typingWrapper = div [ class "typing-wrapper" ] [ text <| typingText ++ typingSuffix ]
messageInput = div [ class "message-wrapper" ]
[ input
[ type_ "text"
@ -97,6 +105,7 @@ joinedRoomView m roomId jr =
div [ class "room-wrapper" ]
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
, eventWrapper
, typingWrapper
, messageInput
]
@ -119,16 +128,16 @@ eventView m re =
"m.room.message" -> Just messageView
_ -> Nothing
createRow mhtml = tr []
[ td [] [ eventSenderView re.sender ]
[ td [] [ eventSenderView m re.sender ]
, td [] [ mhtml ]
]
in
Maybe.map createRow
<| Maybe.andThen (\f -> f m re) viewFunction
eventSenderView : String -> Html Msg
eventSenderView s =
span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| senderName s ]
eventSenderView : Model -> Username -> Html Msg
eventSenderView m s =
span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
messageView : Model -> RoomEvent -> Maybe (Html Msg)
messageView m re =

View File

@ -9,9 +9,8 @@ function setupNotificationPorts(app) {
}
var n = new Notification(data.name, options)
n.onclick = function() {
app.ports.onNotificationClickPort.send({
"room" : data.room
});
app.ports.onNotificationClickPort.send(data.room);
n.close();
}
})
}