95 lines
3 KiB
Text
95 lines
3 KiB
Text
module App.Log where
|
|
|
|
{- Simple log component, showing the current events. -}
|
|
|
|
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (-), (<), (<>))
|
|
|
|
import Control.Monad.State (class MonadState)
|
|
import Data.Array as A
|
|
import Data.Maybe (Maybe(..))
|
|
import Effect.Aff.Class (class MonadAff)
|
|
import Halogen as H
|
|
import Halogen.HTML as HH
|
|
|
|
import App.Type.LogMessage
|
|
|
|
data Output = Void
|
|
type Slot = H.Slot Query Output
|
|
|
|
-- type Query :: forall k. k -> Type
|
|
data Query a = Log LogMessage a
|
|
|
|
type Input = Unit
|
|
|
|
type Action = Unit
|
|
|
|
type State =
|
|
{ messages :: Array String
|
|
, messageHistoryLength :: Int
|
|
}
|
|
|
|
component :: forall m. MonadAff m => H.Component Query Input Output m
|
|
component =
|
|
H.mkComponent
|
|
{ initialState
|
|
, render
|
|
, eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery }
|
|
}
|
|
|
|
initialState :: Input -> State
|
|
initialState _ =
|
|
{ messages: []
|
|
, messageHistoryLength: 10
|
|
}
|
|
|
|
render :: forall m. State -> H.ComponentHTML Action () m
|
|
render { messages }
|
|
= HH.div_ [ render_messages ]
|
|
where
|
|
render_messages = HH.ul_ $ map (\msg -> HH.li_ [ HH.text msg ]) messages
|
|
|
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
|
handleQuery = case _ of
|
|
Log message a -> do
|
|
case message of
|
|
SystemLog str -> systemMessage str
|
|
UnableToSend str -> unableToSend str
|
|
ErrorLog str -> errorMessage str
|
|
SuccessLog str -> successMessage str
|
|
pure (Just a)
|
|
|
|
|
|
type IncompleteState rows
|
|
= { messages :: Array String
|
|
, messageHistoryLength :: Int
|
|
| rows }
|
|
|
|
-- 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
|
|
-- Limits the number of recent messages to `maxHist`
|
|
appendSingle :: Int -> String -> Array String -> Array String
|
|
appendSingle maxHist x xs
|
|
| A.length xs < maxHist = xs `A.snoc` x
|
|
| otherwise = (A.takeEnd (maxHist-1) xs) `A.snoc` x
|
|
|
|
-- Append a system message to the chat log.
|
|
systemMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit
|
|
systemMessage msg = appendMessage ("[🤖] System: " <> msg)
|
|
|
|
-- Append an error message to the chat log.
|
|
errorMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit
|
|
errorMessage msg = appendMessage ("[🛑] Error: " <> msg)
|
|
|
|
-- Append a success message to the chat log.
|
|
successMessage :: forall r m. MonadState (IncompleteState r) m => String -> m Unit
|
|
successMessage msg = appendMessage ("[🎉] " <> 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 = appendMessage ("[🛑] Unable to send. " <> reason)
|