diff options
Diffstat (limited to 'src/Xanthous/Monad.hs')
-rw-r--r-- | src/Xanthous/Monad.hs | 37 |
1 files changed, 27 insertions, 10 deletions
diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index 3e567ee8fa5e..c11cb0e2d4df 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -1,22 +1,28 @@ +-------------------------------------------------------------------------------- module Xanthous.Monad ( AppT(..) , AppM , runAppT , continue , halt + -- * Messages , say , say_ + , message + , message_ ) where - -import Xanthous.Prelude -import Control.Monad.Random -import Control.Monad.State +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Control.Monad.Random +import Control.Monad.State import qualified Brick -import Brick (EventM, Next) -import Data.Aeson - -import Xanthous.Game.State -import Xanthous.Messages (message) +import Brick (EventM, Next) +import Data.Aeson +-------------------------------------------------------------------------------- +import Xanthous.Game.State +import Xanthous.Messages (Message) +import qualified Xanthous.Messages as Messages +-------------------------------------------------------------------------------- runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) runAppT appt initialState = flip runStateT initialState . unAppT $ appt @@ -27,12 +33,23 @@ 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 params = do - msg <- message msgPath params + msg <- Messages.message msgPath params messageHistory %= pushMessage msg 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 params = do + m <- Messages.render msg params + messageHistory %= pushMessage m + +message_ :: (MonadRandom m, MonadState GameState m) + => Message -> m () +message_ msg = message msg $ object [] |