diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs index d957ccf..4309ca0 100644 --- a/src/App/DNSManagerDomainsInterface.purs +++ b/src/App/DNSManagerDomainsInterface.purs @@ -11,38 +11,26 @@ module App.DNSManagerDomainsInterface where Authentication is automatic with the token. -} -import Prelude +import Prelude (Unit, Void, bind, discard, map, otherwise, show, void, when, ($), (&&), (<$>), (<<<), (<>), (>>=)) import Bulma as Bulma import Data.String.Utils (endsWith) --- import Data.String.CodeUnits as DSCU import Halogen.HTML.Events as HHE -import Control.Monad.Except (runExcept) import Control.Monad.State (class MonadState) import Data.Array as A --- import Data.Array.Partial as DAP import Data.Tuple (Tuple(..)) -import Data.Bifunctor (lmap) import Data.Const (Const) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), isJust, isNothing, maybe) import Data.String as String -import Effect (Effect) import Effect.Aff.Class (class MonadAff) -import Foreign (Foreign) -import Foreign as F import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP -import Halogen.Query.Event as HQE -import Halogen.Subscription as HS import Web.Event.Event (Event) import Web.Event.Event as Event -import Web.Socket.Event.CloseEvent as WSCE -import Web.Socket.Event.EventTypes as WSET -import Web.Socket.Event.MessageEvent as WSME import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed)) import Web.Socket.WebSocket as WS diff --git a/src/App/Utils.purs b/src/App/Utils.purs index f30d363..ee7ff41 100644 --- a/src/App/Utils.purs +++ b/src/App/Utils.purs @@ -2,46 +2,24 @@ module App.Utils where import Prelude -import Bulma as Bulma - -import Data.String.Utils (endsWith) --- import Data.String.CodeUnits as DSCU -import Halogen.HTML.Events as HHE import Control.Monad.Except (runExcept) import Control.Monad.State (class MonadState) import Data.Array as A --- import Data.Array.Partial as DAP -import Data.Tuple (Tuple(..)) import Data.Bifunctor (lmap) -import Data.Const (Const) import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), isJust, isNothing, maybe) +import Data.Maybe (Maybe(..)) import Data.String as String import Effect (Effect) -import Effect.Aff.Class (class MonadAff) -import Foreign (Foreign) import Foreign as F import Halogen as H -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP import Halogen.Query.Event as HQE import Halogen.Subscription as HS -import Web.Event.Event (Event) -import Web.Event.Event as Event import Web.Socket.Event.CloseEvent as WSCE import Web.Socket.Event.EventTypes as WSET import Web.Socket.Event.MessageEvent as WSME -import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed)) import Web.Socket.WebSocket as WS -import Effect.Class (class MonadEffect) - -import App.IPC as IPC -import App.Messages.DNSManagerDaemon as DNSManager - import Data.ArrayBuffer.Types (ArrayBuffer) -import Web.Socket.BinaryType (BinaryType(ArrayBuffer)) -------------------------------------------------------------------------------- -- WebSocketEvent type @@ -98,7 +76,7 @@ webSocketEmitter socket = do decodeMessageEvent :: WSME.MessageEvent -> Maybe (WebSocketEvent WebSocketMessageType) decodeMessageEvent = \msgEvent -> do let - foreign' :: Foreign + foreign' :: F.Foreign foreign' = WSME.data_ msgEvent case foreignToArrayBuffer foreign' of Left errs -> pure $ WebSocketError $ UnknownError errs @@ -128,7 +106,7 @@ type WebSocketMessageType = ArrayBuffer sendArrayBuffer :: WS.WebSocket -> ArrayBuffer -> Effect Unit sendArrayBuffer = WS.sendArrayBuffer -type MessageRenderingAndWSState rows +type IncompleteState rows = { messages :: Array String , messageHistoryLength :: Int | rows } @@ -141,7 +119,7 @@ type MessageRenderingAndWSState rows -- 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 (MessageRenderingAndWSState r) m => Boolean -> String -> m Unit +appendMessageGeneric :: forall r m. MonadState (IncompleteState r) m => Boolean -> String -> m Unit appendMessageGeneric _ msg = do histSize <- H.gets _.messageHistoryLength H.modify_ \st -> st { messages = appendSingle histSize msg st.messages } @@ -154,28 +132,28 @@ appendMessageGeneric _ msg = do -- Append a new message to the chat history, while not clearing -- the user input field -appendMessage :: forall r m. MonadState (MessageRenderingAndWSState r) m => String -> m Unit +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 (MessageRenderingAndWSState r) m => String -> m Unit +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 (MessageRenderingAndWSState r) m => String -> m Unit +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 (MessageRenderingAndWSState r) m => String -> m Unit +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 (MessageRenderingAndWSState r) m => String -> m Unit +unableToSend :: forall r m. MonadState (IncompleteState r) m => String -> m Unit unableToSend reason = systemMessage ("Unable to send. " <> reason) -foreignToArrayBuffer :: Foreign -> Either String ArrayBuffer +foreignToArrayBuffer :: F.Foreign -> Either String ArrayBuffer foreignToArrayBuffer = lmap renderForeignErrors <<< runExcept