diff options
Diffstat (limited to 'src/Xanthous/Monad.hs')
-rw-r--r-- | src/Xanthous/Monad.hs | 39 |
1 files changed, 7 insertions, 32 deletions
diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs index acf7775ede41..4e3e58607ce8 100644 --- a/src/Xanthous/Monad.hs +++ b/src/Xanthous/Monad.hs @@ -17,24 +17,6 @@ import Data.Aeson import Xanthous.Game import Xanthous.Messages (message) -newtype AppT m a - = AppT { unAppT :: StateT GameState m a } - deriving ( Functor - , Applicative - , Monad - , MonadState GameState - ) - via (StateT GameState m) - -instance MonadTrans AppT where - lift = AppT . lift - -instance (Monad m) => MonadRandom (AppT m) where - getRandomR rng = randomGen %%= randomR rng - getRandom = randomGen %%= random - getRandomRs rng = uses randomGen $ randomRs rng - getRandoms = uses randomGen randoms - runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState) runAppT appt initialState = flip runStateT initialState . unAppT $ appt @@ -44,19 +26,12 @@ halt = lift . Brick.halt =<< get continue :: AppT (EventM n) (Next GameState) continue = lift . Brick.continue =<< get --- say :: [Text] -> AppT m () --- say :: [Text] -> params -> AppT m () - -class SayR a where - say :: [Text] -> a - -instance Monad m => SayR (AppT m ()) where - say msgPath = say msgPath $ object [] -instance (Monad m, ToJSON params) => SayR (params -> AppT m ()) where - say msgPath params = do - msg <- message msgPath params - messageHistory %= pushMessage msg +say :: (MonadRandom m, ToJSON params, MonadState GameState m) + => [Text] -> params -> m () +say msgPath params = do + msg <- message msgPath params + messageHistory %= pushMessage msg -say_ :: Monad m => [Text] -> AppT m () -say_ = say +say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m () +say_ msgPath = say msgPath $ object [] |