Compare commits
No commits in common. "56878533f464686110ebca4eaffbf0b023ca8cef" and "996da079e2cd3b1ae7ef404d2e0687b1bcbb2552" have entirely different histories.
56878533f4
...
996da079e2
40
src/Main.elm
40
src/Main.elm
|
@ -6,8 +6,6 @@ import Scylla.Model exposing (..)
|
||||||
import Scylla.Http exposing (..)
|
import Scylla.Http exposing (..)
|
||||||
import Scylla.Views exposing (viewFull)
|
import Scylla.Views exposing (viewFull)
|
||||||
import Scylla.Route exposing (Route(..))
|
import Scylla.Route exposing (Route(..))
|
||||||
import Scylla.UserData exposing (..)
|
|
||||||
import Scylla.Notification 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
|
||||||
|
@ -59,21 +57,15 @@ update msg model = case msg of
|
||||||
ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
|
ChangeLoginPassword p -> ({ model | loginPassword = p }, Cmd.none)
|
||||||
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
|
AttemptLogin -> (model, Scylla.Http.login model.apiUrl model.loginUsername model.loginPassword) -- TODO
|
||||||
TryUrl urlRequest -> updateTryUrl model urlRequest
|
TryUrl urlRequest -> updateTryUrl model urlRequest
|
||||||
OpenRoom s -> (model, Nav.pushUrl model.key <| roomUrl s)
|
|
||||||
ChangeRoute r -> ({ model | route = r }, Cmd.none)
|
ChangeRoute r -> ({ model | route = r }, Cmd.none)
|
||||||
ReceiveLoginResponse r -> updateLoginResponse model r
|
ReceiveLoginResponse r -> updateLoginResponse model r
|
||||||
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
|
ReceiveFirstSyncResponse r -> updateSyncResponse model r False
|
||||||
ReceiveSyncResponse r -> updateSyncResponse model r True
|
ReceiveSyncResponse r -> updateSyncResponse model r True
|
||||||
ReceiveUserData s r -> updateUserData model s r
|
ReceiveUserData s r -> (model, Cmd.none)
|
||||||
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
|
ChangeRoomText r t -> ({ model | roomText = Dict.insert r t model.roomText}, Cmd.none)
|
||||||
SendRoomText r -> updateSendRoomText model r
|
SendRoomText r -> updateSendRoomText model r
|
||||||
SendRoomTextResponse r -> (model, Cmd.none)
|
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 : Model -> String -> (Model, Cmd Msg)
|
||||||
updateSendRoomText m r =
|
updateSendRoomText m r =
|
||||||
let
|
let
|
||||||
|
@ -92,7 +84,7 @@ updateTryUrl m ur = case ur of
|
||||||
|
|
||||||
updateLoginResponse : Model -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
|
updateLoginResponse : Model -> Result Http.Error LoginResponse -> (Model, Cmd Msg)
|
||||||
updateLoginResponse model r = case r of
|
updateLoginResponse model r = case r of
|
||||||
Ok lr -> ( { model | token = Just lr.accessToken, loginUsername = lr.userId } , Cmd.batch
|
Ok lr -> ( { model | token = Just lr.accessToken } , Cmd.batch
|
||||||
[ firstSync model.apiUrl lr.accessToken
|
[ firstSync model.apiUrl lr.accessToken
|
||||||
, Nav.pushUrl model.key <| Url.Builder.absolute [] []
|
, Nav.pushUrl model.key <| Url.Builder.absolute [] []
|
||||||
] )
|
] )
|
||||||
|
@ -104,34 +96,14 @@ updateSyncResponse model r notify =
|
||||||
token = Maybe.withDefault "" model.token
|
token = Maybe.withDefault "" model.token
|
||||||
nextBatch = Result.withDefault model.sync.nextBatch
|
nextBatch = Result.withDefault model.sync.nextBatch
|
||||||
<| Result.map .nextBatch r
|
<| Result.map .nextBatch r
|
||||||
syncCmd = sync nextBatch model.apiUrl token
|
cmd = 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
|
in
|
||||||
case r of
|
case r of
|
||||||
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch
|
Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, cmd)
|
||||||
[ syncCmd
|
_ -> (model, cmd)
|
||||||
, newUserCommands sr
|
|
||||||
, if notify then notificationCommand sr else Cmd.none
|
|
||||||
])
|
|
||||||
_ -> (model, syncCmd)
|
|
||||||
|
|
||||||
subscriptions : Model -> Sub Msg
|
subscriptions : Model -> Sub Msg
|
||||||
subscriptions m = onNotificationClickPort OpenRoom
|
subscriptions m = Sub.none
|
||||||
|
|
||||||
onUrlRequest : Browser.UrlRequest -> Msg
|
onUrlRequest : Browser.UrlRequest -> Msg
|
||||||
onUrlRequest = TryUrl
|
onUrlRequest = TryUrl
|
||||||
|
|
|
@ -1,11 +1,10 @@
|
||||||
module Scylla.Model exposing (..)
|
module Scylla.Model exposing (..)
|
||||||
import Scylla.Api exposing (..)
|
import Scylla.Api exposing (..)
|
||||||
import Scylla.Sync exposing (SyncResponse, JoinedRoom, senderName)
|
import Scylla.Sync exposing (SyncResponse, JoinedRoom)
|
||||||
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)
|
import Scylla.Route exposing (Route)
|
||||||
import Browser.Navigation as Nav
|
import Browser.Navigation as Nav
|
||||||
import Url.Builder
|
|
||||||
import Dict exposing (Dict)
|
import Dict exposing (Dict)
|
||||||
import Browser
|
import Browser
|
||||||
import Http
|
import Http
|
||||||
|
@ -31,7 +30,6 @@ type Msg =
|
||||||
| ChangeLoginPassword Password -- During login screen: the password
|
| ChangeLoginPassword Password -- During login screen: the password
|
||||||
| AttemptLogin -- During login screen, login button presed
|
| AttemptLogin -- During login screen, login button presed
|
||||||
| TryUrl Browser.UrlRequest -- User attempts to change URL
|
| TryUrl Browser.UrlRequest -- User attempts to change URL
|
||||||
| OpenRoom String -- We try open a room
|
|
||||||
| ChangeRoute Route -- URL changes
|
| ChangeRoute Route -- URL changes
|
||||||
| ChangeRoomText String String -- Change to a room's input text
|
| ChangeRoomText String String -- Change to a room's input text
|
||||||
| SendRoomText String -- Sends a message typed into a given room's input
|
| SendRoomText String -- Sends a message typed into a given room's input
|
||||||
|
@ -41,11 +39,3 @@ type Msg =
|
||||||
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
|
| ReceiveLoginResponse (Result Http.Error LoginResponse) -- HTTP, Login has finished
|
||||||
| ReceiveUserData Username (Result Http.Error UserData)
|
| 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" ] []
|
|
||||||
|
|
|
@ -8,4 +8,4 @@ type alias Notification =
|
||||||
}
|
}
|
||||||
|
|
||||||
port sendNotificationPort : Notification -> Cmd msg
|
port sendNotificationPort : Notification -> Cmd msg
|
||||||
port onNotificationClickPort : (String -> msg) -> Sub msg
|
port onNotificationClickPort : (Json.Decode.Value -> msg) -> Sub msg
|
||||||
|
|
|
@ -269,26 +269,6 @@ uniqueByRecursive f l s = case l of
|
||||||
uniqueBy : (a -> comparable) -> List a -> List a
|
uniqueBy : (a -> comparable) -> List a -> List a
|
||||||
uniqueBy f l = uniqueByRecursive f l Set.empty
|
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
|
-- Business Logic: Merging
|
||||||
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
mergeMaybe : (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
|
||||||
mergeMaybe f l r = case (l, r) of
|
mergeMaybe f l r = case (l, r) of
|
||||||
|
@ -329,15 +309,11 @@ mergeState s1 s2 = State <| mergeMaybe mergeStateEvents s1.events s2.events
|
||||||
mergeTimeline : Timeline -> Timeline -> Timeline
|
mergeTimeline : Timeline -> Timeline -> Timeline
|
||||||
mergeTimeline t1 t2 = Timeline (mergeMaybe mergeRoomEvents t1.events t2.events) Nothing t2.prevBatch
|
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 : JoinedRoom -> JoinedRoom -> JoinedRoom
|
||||||
mergeJoinedRoom r1 r2 =
|
mergeJoinedRoom r1 r2 =
|
||||||
{ r2 | state = mergeMaybe mergeState r1.state r2.state
|
{ r2 | state = mergeMaybe mergeState r1.state r2.state
|
||||||
, timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
|
, timeline = mergeMaybe mergeTimeline r1.timeline r2.timeline
|
||||||
, accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
|
, accountData = mergeMaybe mergeAccountData r1.accountData r2.accountData
|
||||||
, ephemeral = mergeMaybe mergeEphemeral r1.ephemeral r2.ephemeral
|
|
||||||
}
|
}
|
||||||
|
|
||||||
mergeInviteState : InviteState -> InviteState -> InviteState
|
mergeInviteState : InviteState -> InviteState -> InviteState
|
||||||
|
@ -388,23 +364,19 @@ roomName : JoinedRoom -> Maybe String
|
||||||
roomName jr =
|
roomName jr =
|
||||||
let
|
let
|
||||||
state = jr.state
|
state = jr.state
|
||||||
nameEvent = findLastEvent (((==) "m.room.name") << .type_)
|
nameEvent = List.head << List.sortBy (\e -> -e.originServerTs) << List.filter (\e -> e.type_ == "m.room.name")
|
||||||
name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
|
name e = Result.toMaybe <| Decode.decodeValue (field "name" string) e.content
|
||||||
in
|
in
|
||||||
Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
|
Maybe.andThen name <| Maybe.andThen nameEvent <| Maybe.andThen .events <| state
|
||||||
|
|
||||||
-- Business Logic: Event Extraction
|
-- Business Logic: Event Extraction
|
||||||
notificationText : RoomEvent -> String
|
notificationEvent : SyncResponse -> Maybe (String, RoomEvent)
|
||||||
notificationText re = case (Decode.decodeValue (field "msgtype" string) re.content) of
|
notificationEvent s =
|
||||||
Ok "m.text" -> Result.withDefault "" <| (Decode.decodeValue (field "body" string) re.content)
|
|
||||||
_ -> ""
|
|
||||||
|
|
||||||
notificationEvents : SyncResponse -> List (String, RoomEvent)
|
|
||||||
notificationEvents 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.head
|
||||||
|
<| List.sortBy (\(k, v) -> v.originServerTs)
|
||||||
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
<| Dict.foldl (\k v a -> a ++ applyPair k v) []
|
||||||
<| joinedRoomsEvents s
|
<| joinedRoomsEvents s
|
||||||
|
|
||||||
|
@ -415,13 +387,6 @@ joinedRoomsEvents s =
|
||||||
<| Maybe.andThen .join s.rooms
|
<| Maybe.andThen .join s.rooms
|
||||||
|
|
||||||
-- Business Logic: User Extraction
|
-- 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 : SyncResponse -> List Username
|
||||||
roomsUsers s =
|
roomsUsers s =
|
||||||
let
|
let
|
||||||
|
@ -434,4 +399,4 @@ roomsUsers s =
|
||||||
joinedUsers = usersFor .join
|
joinedUsers = usersFor .join
|
||||||
leftUsers = usersFor .leave
|
leftUsers = usersFor .leave
|
||||||
in
|
in
|
||||||
uniqueBy (\u -> u) <| leftUsers ++ joinedUsers
|
leftUsers ++ joinedUsers
|
||||||
|
|
|
@ -3,7 +3,6 @@ import Scylla.Model exposing (..)
|
||||||
import Scylla.Sync exposing (..)
|
import Scylla.Sync exposing (..)
|
||||||
import Scylla.Route exposing (..)
|
import Scylla.Route exposing (..)
|
||||||
import Scylla.Fnv as Fnv
|
import Scylla.Fnv as Fnv
|
||||||
import Scylla.Login exposing (Username)
|
|
||||||
import Svg
|
import Svg
|
||||||
import Svg.Attributes
|
import Svg.Attributes
|
||||||
import Url.Builder
|
import Url.Builder
|
||||||
|
@ -69,7 +68,7 @@ roomListElementView s jr =
|
||||||
let
|
let
|
||||||
name = Maybe.withDefault "<No Name>" <| roomName jr
|
name = Maybe.withDefault "<No Name>" <| roomName jr
|
||||||
in
|
in
|
||||||
a [ href <| roomUrl s ] [ text name ]
|
a [ href <| Url.Builder.absolute [ "room", s ] [] ] [ text name ]
|
||||||
|
|
||||||
loginView : Model -> Html Msg
|
loginView : Model -> Html Msg
|
||||||
loginView m = div [ class "login-wrapper" ]
|
loginView m = div [ class "login-wrapper" ]
|
||||||
|
@ -86,13 +85,6 @@ joinedRoomView m roomId jr =
|
||||||
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
events = Maybe.withDefault [] <| Maybe.andThen .events jr.timeline
|
||||||
renderedEvents = List.filterMap (eventView m) events
|
renderedEvents = List.filterMap (eventView m) events
|
||||||
eventWrapper = eventWrapperView m renderedEvents
|
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" ]
|
messageInput = div [ class "message-wrapper" ]
|
||||||
[ input
|
[ input
|
||||||
[ type_ "text"
|
[ type_ "text"
|
||||||
|
@ -105,7 +97,6 @@ joinedRoomView m roomId jr =
|
||||||
div [ class "room-wrapper" ]
|
div [ class "room-wrapper" ]
|
||||||
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
|
[ h2 [] [ text <| Maybe.withDefault "<No Name>" <| roomName jr ]
|
||||||
, eventWrapper
|
, eventWrapper
|
||||||
, typingWrapper
|
|
||||||
, messageInput
|
, messageInput
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -128,16 +119,16 @@ eventView m re =
|
||||||
"m.room.message" -> Just messageView
|
"m.room.message" -> Just messageView
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
createRow mhtml = tr []
|
createRow mhtml = tr []
|
||||||
[ td [] [ eventSenderView m re.sender ]
|
[ td [] [ eventSenderView re.sender ]
|
||||||
, td [] [ mhtml ]
|
, td [] [ mhtml ]
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
Maybe.map createRow
|
Maybe.map createRow
|
||||||
<| Maybe.andThen (\f -> f m re) viewFunction
|
<| Maybe.andThen (\f -> f m re) viewFunction
|
||||||
|
|
||||||
eventSenderView : Model -> Username -> Html Msg
|
eventSenderView : String -> Html Msg
|
||||||
eventSenderView m s =
|
eventSenderView s =
|
||||||
span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| displayName m s ]
|
span [ style "background-color" <| stringColor s, class "sender-wrapper" ] [ text <| senderName s ]
|
||||||
|
|
||||||
messageView : Model -> RoomEvent -> Maybe (Html Msg)
|
messageView : Model -> RoomEvent -> Maybe (Html Msg)
|
||||||
messageView m re =
|
messageView m re =
|
||||||
|
|
|
@ -9,8 +9,9 @@ function setupNotificationPorts(app) {
|
||||||
}
|
}
|
||||||
var n = new Notification(data.name, options)
|
var n = new Notification(data.name, options)
|
||||||
n.onclick = function() {
|
n.onclick = function() {
|
||||||
app.ports.onNotificationClickPort.send(data.room);
|
app.ports.onNotificationClickPort.send({
|
||||||
n.close();
|
"room" : data.room
|
||||||
|
});
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user