Compare commits
	
		
			6 Commits
		
	
	
		
			3471f6cb74
			...
			c7149aa5c9
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| c7149aa5c9 | |||
| 6e721d685b | |||
| 011630a185 | |||
| f2a8acc59c | |||
| 1b0ad433b9 | |||
| 7241d112b0 | 
							
								
								
									
										33
									
								
								src/Main.elm
									
									
									
									
									
								
							
							
						
						
									
										33
									
								
								src/Main.elm
									
									
									
									
									
								
							| @ -60,9 +60,15 @@ init _ url key = | ||||
| 
 | ||||
| view : Model -> Browser.Document Msg | ||||
| view m = | ||||
|     { title = "Scylla" | ||||
|     , body = viewFull m | ||||
|     } | ||||
|     let | ||||
|         notificationString = totalNotificationCountString m.sync | ||||
|         titleString = case notificationString of | ||||
|             Nothing -> "Scylla" | ||||
|             Just s -> s ++ " Scylla" | ||||
|     in  | ||||
|         { title = titleString | ||||
|         , body = viewFull m | ||||
|         } | ||||
| 
 | ||||
| update : Msg -> Model -> (Model, Cmd Msg) | ||||
| update msg model = case msg of | ||||
| @ -81,14 +87,14 @@ update msg model = case msg of | ||||
|     ReceiveUserData s r -> updateUserData model s r | ||||
|     ChangeRoomText r t -> updateChangeRoomText model r t | ||||
|     SendRoomText r -> updateSendRoomText model r | ||||
|     SendRoomTextResponse t r -> ({ model | sending = Dict.remove t model.sending }, Cmd.none) | ||||
|     SendRoomTextResponse t r -> updateSendRoomTextResponse model t r | ||||
|     ReceiveCompletedReadMarker r -> (model, Cmd.none) | ||||
|     ReceiveCompletedTypingIndicator r -> (model, Cmd.none) | ||||
|     ReceiveStoreData d -> updateStoreData model d | ||||
|     TypingTick _ -> updateTypingTick model | ||||
|     History r -> updateHistory model r | ||||
|     ReceiveHistoryResponse r hr -> updateHistoryResponse model r hr | ||||
|     SendImages rid -> (model, Select.files [ "image/png" ] <| ImagesSelected rid) | ||||
|     SendImages rid -> (model, Select.files [ "image/jpeg", "image/png", "image/gif" ] <| ImagesSelected rid) | ||||
|     SendFiles rid -> (model, Select.files [ "application/*" ] <| FilesSelected rid) | ||||
|     ImagesSelected rid f fs -> updateUploadSelected model rid f fs (ImageUploadComplete rid) | ||||
|     FilesSelected rid f fs -> updateUploadSelected model rid f fs (FileUploadComplete rid) | ||||
| @ -103,6 +109,17 @@ update msg model = case msg of | ||||
| requestScrollCmd : Cmd Msg | ||||
| requestScrollCmd = Task.attempt ViewportAfterMessage (Browser.Dom.getViewportOf "messages-wrapper") | ||||
| 
 | ||||
| updateSendRoomTextResponse : Model -> Int -> Result Http.Error String -> (Model, Cmd Msg) | ||||
| updateSendRoomTextResponse m t r = | ||||
|     let | ||||
|         updateFunction newId msg = case msg of | ||||
|             Just (rid, { body, id }) -> Just (rid, { body = body, id = Just newId }) | ||||
|             Nothing -> Nothing | ||||
|     in | ||||
|         case r of | ||||
|             Ok s -> ({ m | sending = Dict.update t (updateFunction s) m.sending }, Cmd.none) | ||||
|             Err e -> ({ m | sending = Dict.remove t m.sending }, Cmd.none)  | ||||
| 
 | ||||
| updateDismissError : Model -> Int -> (Model, Cmd Msg) | ||||
| updateDismissError m i = ({ m | errors = (List.take i m.errors) ++ (List.drop (i+1) m.errors)}, Cmd.none) | ||||
| 
 | ||||
| @ -115,7 +132,7 @@ updateMarkdown m { roomId, text, markdown } = | ||||
|         sendMessageCmd = sendMarkdownMessage m.apiUrl (Maybe.withDefault "" m.token) (m.transactionId + 1) roomId text markdown | ||||
|         newModel = | ||||
|             { m | transactionId = m.transactionId + 1 | ||||
|             , sending = Dict.insert (m.transactionId + 1) (roomId, TextMessage text) m.sending | ||||
|             , sending = Dict.insert (m.transactionId + 1) (roomId, { body = TextMessage text, id = Nothing }) m.sending | ||||
|             } | ||||
|     in | ||||
|         (newModel, Cmd.batch [ storeValueCmd, sendMessageCmd, requestScrollCmd ]) | ||||
| @ -322,9 +339,11 @@ updateSyncResponse model r notify = | ||||
|         setReadReceiptCmd sr = case (room, List.head <| List.reverse <| roomMessages sr) of | ||||
|             (Just rid, Just re) -> setReadMarkers model.apiUrl token rid re.eventId <| Just re.eventId | ||||
|             _ -> Cmd.none | ||||
|         receivedEvents sr = List.map Just <| allTimelineEventIds sr | ||||
|         sending sr = Dict.filter (\_ (rid, { body, id }) -> not <| List.member id <| receivedEvents sr) model.sending | ||||
|     in | ||||
|         case r of | ||||
|             Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr }, Cmd.batch | ||||
|             Ok sr -> ({ model | sync = mergeSyncResponse model.sync sr, sending = sending (mergeSyncResponse model.sync sr) }, Cmd.batch | ||||
|                 [ syncCmd | ||||
|                 , newUserCmd sr | ||||
|                 , notificationCmd sr | ||||
|  | ||||
| @ -7,6 +7,7 @@ import Scylla.Login exposing (loginResponseDecoder, Username, Password) | ||||
| import Scylla.UserData exposing (userDataDecoder, UserData) | ||||
| import Url.Builder | ||||
| import Json.Encode exposing (object, string, int, bool, list) | ||||
| import Json.Decode as Decode exposing (field) | ||||
| import Http exposing (request, emptyBody, jsonBody, fileBody, expectJson, expectWhatever) | ||||
| import File exposing (File, name, mime) | ||||
| import Url.Builder as Builder | ||||
| @ -75,7 +76,7 @@ getHistory apiUrl token room prevBatch = request | ||||
|     , tracker = Nothing | ||||
|     } | ||||
| 
 | ||||
| sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error () -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg | ||||
| sendMessage : ApiUrl -> ApiToken -> Int -> RoomId -> (Result Http.Error String -> Msg) -> List (String, Json.Encode.Value) -> Cmd Msg | ||||
| sendMessage apiUrl token transactionId room msg contents = request | ||||
|     { method = "PUT" | ||||
|     , headers = authenticatedHeaders token | ||||
| @ -84,7 +85,7 @@ sendMessage apiUrl token transactionId room msg contents = request | ||||
|         ++ "/send/" ++ "m.room.message" | ||||
|         ++ "/" ++ (String.fromInt transactionId) | ||||
|     , body = jsonBody <| object contents | ||||
|     , expect = expectWhatever msg | ||||
|     , expect = expectJson msg (field "event_id" Decode.string) | ||||
|     , timeout = Nothing | ||||
|     , tracker = Nothing | ||||
|     } | ||||
|  | ||||
| @ -2,7 +2,12 @@ module Scylla.Messages exposing (..) | ||||
| import Scylla.Sync exposing (RoomEvent) | ||||
| import Scylla.Login exposing (Username) | ||||
| 
 | ||||
| type SendingMessage = TextMessage String | ||||
| type SendingMessageBody = TextMessage String | ||||
| 
 | ||||
| type alias SendingMessage = | ||||
|     { body : SendingMessageBody | ||||
|     , id : Maybe String | ||||
|     } | ||||
| 
 | ||||
| type Message = | ||||
|     Sending SendingMessage | ||||
|  | ||||
| @ -44,7 +44,7 @@ type Msg = | ||||
|     | 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 | ||||
|     | SendRoomTextResponse Int (Result Http.Error ()) -- A send message response finished | ||||
|     | SendRoomTextResponse Int (Result Http.Error String) -- A send message response finished | ||||
|     | ViewportAfterMessage (Result Browser.Dom.Error Viewport) -- A message has been received, try scroll (maybe) | ||||
|     | ViewportChangeComplete (Result Browser.Dom.Error ()) -- We're done changing the viewport. | ||||
|     | ReceiveFirstSyncResponse (Result Http.Error SyncResponse) -- HTTP, Sync has finished | ||||
| @ -63,8 +63,8 @@ type Msg = | ||||
|     | FilesSelected RoomId File (List File) | ||||
|     | ImageUploadComplete RoomId File (Result Http.Error String) | ||||
|     | FileUploadComplete RoomId File (Result Http.Error String) | ||||
|     | SendImageResponse (Result Http.Error ()) | ||||
|     | SendFileResponse (Result Http.Error ()) | ||||
|     | SendImageResponse (Result Http.Error String) | ||||
|     | SendFileResponse (Result Http.Error String) | ||||
|     | ReceiveMarkdown MarkdownResponse | ||||
|     | DismissError Int | ||||
|     | AttemptReconnect | ||||
|  | ||||
| @ -476,6 +476,9 @@ allRoomDictTimelineEvents dict = List.concatMap (Maybe.withDefault [] << .events | ||||
|     <| List.filterMap .timeline | ||||
|     <| Dict.values dict | ||||
| 
 | ||||
| allTimelineEventIds : SyncResponse -> List String | ||||
| allTimelineEventIds s = List.map .eventId <| allTimelineEvents s | ||||
| 
 | ||||
| allTimelineEvents : SyncResponse -> List RoomEvent | ||||
| allTimelineEvents s = | ||||
|     let | ||||
| @ -493,6 +496,32 @@ joinedRoomsTimelineEvents s = | ||||
|     <| Maybe.map (Dict.map (\k v -> Maybe.withDefault [] <| Maybe.andThen .events v.timeline)) | ||||
|     <| 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 = | ||||
|  | ||||
| @ -213,8 +213,8 @@ messageView m msg = case msg of | ||||
|     Received re -> roomEventView m re | ||||
| 
 | ||||
| sendingMessageView : Model -> SendingMessage -> Html Msg | ||||
| sendingMessageView m msg = case msg of | ||||
|     TextMessage t -> text t | ||||
| sendingMessageView m msg = case msg.body of | ||||
|     TextMessage t -> span [ class "sending"] [ text t ] | ||||
| 
 | ||||
| roomEventView : Model -> RoomEvent -> Maybe (Html Msg) | ||||
| roomEventView m re = | ||||
|  | ||||
| @ -249,6 +249,10 @@ table.messages-table { | ||||
|         max-height: 400px; | ||||
|     } | ||||
| 
 | ||||
|     .sending { | ||||
|         color: grey; | ||||
|     } | ||||
| 
 | ||||
|     video { | ||||
|         max-width: 90%; | ||||
|         max-height: 400px; | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user