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