Slight code simplification.
parent
62347d40b2
commit
cbaeaf8ee2
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue