module Problem1b where import Control.Monad.Trans class Monad m => GameMonad m where extraLife :: m () getLives :: m Int checkPoint :: m a -> m a die :: m a newtype GameT m a = GameT { unGameT :: Int -> m (Result a) } type Result a = Either Int (a, Int) instance Monad m => Monad (GameT m) where return x = GameT $ \n -> return $ Right (x, n) m >>= f = GameT $ \n -> do r <- unGameT m n case r of Left n -> return $ Left n Right (x, n) -> unGameT (f x) n instance MonadTrans GameT where lift m = GameT $ \n -> do x <- m return $ Right (x, n) instance MonadIO m => MonadIO (GameT m) where liftIO = lift . liftIO instance Monad m => GameMonad (GameT m) where extraLife = GameT $ \n -> return $ Right ((), n + 1) getLives = GameT $ \n -> return $ Right (n, n) die = GameT $ \n -> return $ Left (n - 1) checkPoint m = GameT $ \n -> do r <- unGameT m n case r of Left n | n > 0 -> unGameT (checkPoint m) n | otherwise -> return $ Left 0 Right (x, n) -> return $ Right (x, n) runGameT :: Monad m => GameT m a -> Int -> m (Maybe (a, Int)) runGameT m n = do r <- unGameT m n case r of Left _ -> return Nothing Right r -> return $ Just r