diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 4303e9a..3b1f664 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -257,7 +257,7 @@ handleAction = case _ of , email: Just (Email.Email email) , password: pass } sendArrayBuffer webSocket ab - appendMessageReset "[😇] Trying to add a user" + appendMessage "[😇] Trying to add a user" HandleWebSocket wsEvent -> case wsEvent of diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index 5809934..2b9be78 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -278,7 +278,7 @@ handleAction = case _ of , email: Just (Email.Email email) , password: pass } sendArrayBuffer webSocket ab - appendMessageReset "[😇] Trying to register" + appendMessage "[😇] Trying to register" AuthenticationAttempt ev -> do H.liftEffect $ Event.preventDefault ev @@ -313,7 +313,7 @@ handleAction = case _ of H.liftEffect $ do ab <- AuthD.serialize (AuthD.MkLogin { login: login, password: pass }) sendArrayBuffer webSocket ab - appendMessageReset $ "[😇] Trying to connect with login: " <> login + appendMessage $ "[😇] Trying to connect with login: " <> login HandleWebSocket wsEvent -> case wsEvent of diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs index fe40fc5..c102651 100644 --- a/src/App/DNSManagerDomainsInterface.purs +++ b/src/App/DNSManagerDomainsInterface.purs @@ -296,7 +296,7 @@ handleAction = case _ of H.liftEffect $ do ab <- DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain } sendArrayBuffer webSocket ab - appendMessageReset $ "[😇] Removing domain: " <> domain + appendMessage $ "[😇] Removing domain: " <> domain NewDomainAttempt ev -> do H.liftEffect $ Event.preventDefault ev @@ -329,7 +329,7 @@ handleAction = case _ of H.liftEffect $ do ab <- DNSManager.serialize $ DNSManager.MkNewDomain { domain: new_domain } sendArrayBuffer webSocket ab - appendMessageReset "[😇] Trying to add a new domain" + appendMessage "[😇] Trying to add a new domain" HandleWebSocket wsEvent -> case wsEvent of diff --git a/src/App/Utils.purs b/src/App/Utils.purs index ee7ff41..11b215c 100644 --- a/src/App/Utils.purs +++ b/src/App/Utils.purs @@ -80,7 +80,9 @@ decodeMessageEvent = \msgEvent -> do foreign' = WSME.data_ msgEvent case foreignToArrayBuffer foreign' of Left errs -> pure $ WebSocketError $ UnknownError errs - Right arrayBuffer -> pure $ WebSocketMessage { message: arrayBuffer, origin: WSME.origin msgEvent, lastEventId: WSME.lastEventId msgEvent } + Right arrayBuffer -> pure $ WebSocketMessage { message: arrayBuffer + , origin: WSME.origin msgEvent + , lastEventId: WSME.lastEventId msgEvent } --------------------------- -- Errors @@ -114,13 +116,12 @@ type IncompleteState rows -------------------------------------------------------------------------------- -- Helpers for updating the array of messages sent/received -------------------------------------------------------------------------------- --- Append a new message to the chat history, with a boolean that allows you to --- clear the text input field or not. The number of displayed `messages` in the --- chat history (including system) is controlled by the `messageHistoryLength` --- field in the component `State`. --- TODO: first arg (clearField) isn't used anymore. -appendMessageGeneric :: forall r m. MonadState (IncompleteState r) m => Boolean -> String -> m Unit -appendMessageGeneric _ msg = do + +-- Append a new message to the chat history. +-- The number of displayed `messages` in the chat history (including system) +-- is controlled by the `messageHistoryLength` field in the component `State`. +appendMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit +appendMessage msg = do histSize <- H.gets _.messageHistoryLength H.modify_ \st -> st { messages = appendSingle histSize msg st.messages } where @@ -130,25 +131,10 @@ appendMessageGeneric _ msg = do | A.length xs < maxHist = xs `A.snoc` x | otherwise = (A.takeEnd (maxHist-1) xs) `A.snoc` x --- Append a new message to the chat history, while not clearing --- the user input field -appendMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit -appendMessage = appendMessageGeneric false - --- Append a new message to the chat history and also clear --- the user input field -appendMessageReset :: forall r m. MonadState (IncompleteState r) m => String -> m Unit -appendMessageReset = appendMessageGeneric true - -- Append a system message to the chat log. systemMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit systemMessage msg = appendMessage ("[🤖] System: " <> msg) --- As above, but also clears the user input field. e.g. in --- the case of a "/disconnect" command -systemMessageReset :: forall r m. MonadState (IncompleteState r) m => String -> m Unit -systemMessageReset msg = appendMessageReset ("[🤖] System: " <> msg) - -- A system message to use when a message cannot be sent. unableToSend :: forall r m. MonadState (IncompleteState r) m => String -> m Unit unableToSend reason = systemMessage ("Unable to send. " <> reason)