Slight code simplification.

This commit is contained in:
Philippe Pittoli 2023-07-03 13:38:21 +02:00
parent 62347d40b2
commit cbaeaf8ee2
4 changed files with 14 additions and 28 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)