maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users): grfn -> aspen

Browse source 
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
Aspen Smith 2024-02-11 22:00:40 -05:00 • committed by clbot
parent 0ba476a426
commit 82ecd61f5c
478 changed files with 75 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

76
users/grfn/xanthous/src/Xanthous/Monad.hs
View file

@ -1,76 +0,0 @@
--------------------------------------------------------------------------------
module Xanthous.Monad
( AppT(..)
, AppM
, runAppT
, continue
, halt
-- * Messages
, say
, say_
, message
, message_
, writeMessage
-- * Autocommands
, cancelAutocommand
-- * Events
, sendEvent
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Control.Monad.Random
import Control.Monad.State
import qualified Brick
import Brick (EventM, Next)
import Brick.BChan (writeBChan)
import Data.Aeson (ToJSON, object)
--------------------------------------------------------------------------------
import Xanthous.Data.App (AppEvent)
import Xanthous.Game.State
import Xanthous.Game.Env
import Xanthous.Messages (Message)
import qualified Xanthous.Messages as Messages
--------------------------------------------------------------------------------
halt :: AppT (EventM n) (Next GameState)
halt = lift . Brick.halt =<< get
continue :: AppT (EventM n) (Next GameState)
continue = lift . Brick.continue =<< get
--------------------------------------------------------------------------------
say :: (MonadRandom m, ToJSON params, MonadState GameState m)
=> [Text] -> params -> m ()
say msgPath = writeMessage <=< Messages.message msgPath
say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m ()
say_ msgPath = say msgPath $ object []
message :: (MonadRandom m, ToJSON params, MonadState GameState m)
=> Message -> params -> m ()
message msg = writeMessage <=< Messages.render msg
message_ :: (MonadRandom m, MonadState GameState m)
=> Message -> m ()
message_ msg = message msg $ object []
writeMessage :: MonadState GameState m => Text -> m ()
writeMessage m = messageHistory %= pushMessage m
-- | Cancel the currently active autocommand, if any
cancelAutocommand :: (MonadState GameState m, MonadIO m) => m ()
cancelAutocommand = do
traverse_ (liftIO . cancel . snd) =<< preuse (autocommand . _ActiveAutocommand)
autocommand .= NoAutocommand
--------------------------------------------------------------------------------
-- | Send an event to the app in an environment where the game env is available
sendEvent :: (MonadReader GameEnv m, MonadIO m) => AppEvent -> m ()
sendEvent evt = do
ec <- view eventChan
liftIO $ writeBChan ec evt