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