module TinyApp.Interactive.Test ( TestCase, InteractiveM, (~>), runTestsFor, expectRenderEq, expectRenderIs, expectStateEq, expectStateIs, expectContinue, expectExit, pressKey, pressKeys, pressKey', inputString, sendEvent, ) where import Control.Monad.Reader qualified as MTL import Data.IORef import GHC.Stack qualified as Stack import System.Exit (exitFailure, exitSuccess) import System.IO.Error (ioeGetErrorString, tryIOError) import TinyApp.Interactive data AppState s = AppState { forall s. AppState s -> s state :: s, forall s. AppState s -> ContinueExit continue :: ContinueExit, forall s. AppState s -> String output :: String } data Env s = Env { forall s. Env s -> Sandbox s app :: Sandbox s, forall s. Env s -> IORef (AppState s) appState :: IORef (AppState s) } newtype InteractiveM s a = InteractiveM (MTL.ReaderT (Env s) IO a) deriving ((forall a b. (a -> b) -> InteractiveM s a -> InteractiveM s b) -> (forall a b. a -> InteractiveM s b -> InteractiveM s a) -> Functor (InteractiveM s) forall a b. a -> InteractiveM s b -> InteractiveM s a forall a b. (a -> b) -> InteractiveM s a -> InteractiveM s b forall s a b. a -> InteractiveM s b -> InteractiveM s a forall s a b. (a -> b) -> InteractiveM s a -> InteractiveM s b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall s a b. (a -> b) -> InteractiveM s a -> InteractiveM s b fmap :: forall a b. (a -> b) -> InteractiveM s a -> InteractiveM s b $c<$ :: forall s a b. a -> InteractiveM s b -> InteractiveM s a <$ :: forall a b. a -> InteractiveM s b -> InteractiveM s a Functor, Functor (InteractiveM s) Functor (InteractiveM s) -> (forall a. a -> InteractiveM s a) -> (forall a b. InteractiveM s (a -> b) -> InteractiveM s a -> InteractiveM s b) -> (forall a b c. (a -> b -> c) -> InteractiveM s a -> InteractiveM s b -> InteractiveM s c) -> (forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b) -> (forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s a) -> Applicative (InteractiveM s) forall s. Functor (InteractiveM s) forall a. a -> InteractiveM s a forall s a. a -> InteractiveM s a forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s a forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b forall a b. InteractiveM s (a -> b) -> InteractiveM s a -> InteractiveM s b forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s a forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b forall s a b. InteractiveM s (a -> b) -> InteractiveM s a -> InteractiveM s b forall a b c. (a -> b -> c) -> InteractiveM s a -> InteractiveM s b -> InteractiveM s c forall s a b c. (a -> b -> c) -> InteractiveM s a -> InteractiveM s b -> InteractiveM s c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f $cpure :: forall s a. a -> InteractiveM s a pure :: forall a. a -> InteractiveM s a $c<*> :: forall s a b. InteractiveM s (a -> b) -> InteractiveM s a -> InteractiveM s b <*> :: forall a b. InteractiveM s (a -> b) -> InteractiveM s a -> InteractiveM s b $cliftA2 :: forall s a b c. (a -> b -> c) -> InteractiveM s a -> InteractiveM s b -> InteractiveM s c liftA2 :: forall a b c. (a -> b -> c) -> InteractiveM s a -> InteractiveM s b -> InteractiveM s c $c*> :: forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b *> :: forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b $c<* :: forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s a <* :: forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s a Applicative, Applicative (InteractiveM s) Applicative (InteractiveM s) -> (forall a b. InteractiveM s a -> (a -> InteractiveM s b) -> InteractiveM s b) -> (forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b) -> (forall a. a -> InteractiveM s a) -> Monad (InteractiveM s) forall s. Applicative (InteractiveM s) forall a. a -> InteractiveM s a forall s a. a -> InteractiveM s a forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b forall a b. InteractiveM s a -> (a -> InteractiveM s b) -> InteractiveM s b forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b forall s a b. InteractiveM s a -> (a -> InteractiveM s b) -> InteractiveM s b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m $c>>= :: forall s a b. InteractiveM s a -> (a -> InteractiveM s b) -> InteractiveM s b >>= :: forall a b. InteractiveM s a -> (a -> InteractiveM s b) -> InteractiveM s b $c>> :: forall s a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b >> :: forall a b. InteractiveM s a -> InteractiveM s b -> InteractiveM s b $creturn :: forall s a. a -> InteractiveM s a return :: forall a. a -> InteractiveM s a Monad, Monad (InteractiveM s) Monad (InteractiveM s) -> (forall a. IO a -> InteractiveM s a) -> MonadIO (InteractiveM s) forall s. Monad (InteractiveM s) forall a. IO a -> InteractiveM s a forall s a. IO a -> InteractiveM s a forall (m :: * -> *). Monad m -> (forall a. IO a -> m a) -> MonadIO m $cliftIO :: forall s a. IO a -> InteractiveM s a liftIO :: forall a. IO a -> InteractiveM s a MTL.MonadIO, Monad (InteractiveM s) Monad (InteractiveM s) -> (forall a. String -> InteractiveM s a) -> MonadFail (InteractiveM s) forall s. Monad (InteractiveM s) forall a. String -> InteractiveM s a forall s a. String -> InteractiveM s a forall (m :: * -> *). Monad m -> (forall a. String -> m a) -> MonadFail m $cfail :: forall s a. String -> InteractiveM s a fail :: forall a. String -> InteractiveM s a MTL.MonadFail) data TestCase s = TestCase { forall s. TestCase s -> String description :: String, forall s. TestCase s -> InteractiveM s () t :: InteractiveM s () } infix 0 ~> (~>) :: String -> InteractiveM s () -> TestCase s ~> :: forall s. String -> InteractiveM s () -> TestCase s (~>) String description InteractiveM s () test = TestCase {description :: String description = String description, t :: InteractiveM s () t = InteractiveM s () test} runTestsFor :: Sandbox s -> [TestCase s] -> IO () runTestsFor :: forall s. Sandbox s -> [TestCase s] -> IO () runTestsFor Sandbox s app [TestCase s] tests = do [Bool] res <- [TestCase s] -> (TestCase s -> IO Bool) -> IO [Bool] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) MTL.forM [TestCase s] tests ( \TestCase {String description :: forall s. TestCase s -> String description :: String description, InteractiveM s () t :: forall s. TestCase s -> InteractiveM s () t :: InteractiveM s () t} -> do Either IOError () res <- IO () -> IO (Either IOError ()) forall a. IO a -> IO (Either IOError a) tryIOError (Sandbox s -> InteractiveM s () -> IO () forall s a. Sandbox s -> InteractiveM s a -> IO a runInteractiveTest Sandbox s app InteractiveM s () t) case Either IOError () res of Left IOError err -> do String -> IO () putStrLn (String "🛑 " String -> String -> String forall a. Semigroup a => a -> a -> a <> String description String -> String -> String forall a. Semigroup a => a -> a -> a <> String ": " String -> String -> String forall a. Semigroup a => a -> a -> a <> IOError -> String ioeGetErrorString IOError err) Bool -> IO Bool forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Bool False Right () _ -> do String -> IO () putStrLn (String "✅ " String -> String -> String forall a. Semigroup a => a -> a -> a <> String description) Bool -> IO Bool forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Bool True ) if [Bool] -> Bool forall (t :: * -> *). Foldable t => t Bool -> Bool and [Bool] res then IO () forall a. IO a exitSuccess else IO () forall a. IO a exitFailure expectRenderEq :: (Stack.HasCallStack) => String -> InteractiveM s () expectRenderEq :: forall s. HasCallStack => String -> InteractiveM s () expectRenderEq String value = do AppState {String output :: forall s. AppState s -> String output :: String output} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> String -> String -> InteractiveM s () forall a s. (Show a, Eq a) => CallStack -> a -> a -> InteractiveM s () _expectEq CallStack HasCallStack => CallStack Stack.callStack String output String value expectRenderIs :: (Stack.HasCallStack, Show s, Eq s) => (String -> Bool) -> InteractiveM s () expectRenderIs :: forall s. (HasCallStack, Show s, Eq s) => (String -> Bool) -> InteractiveM s () expectRenderIs String -> Bool f = do AppState {String output :: forall s. AppState s -> String output :: String output} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> String -> String -> (String -> Bool) -> InteractiveM s () forall a s. CallStack -> String -> a -> (a -> Bool) -> InteractiveM s () _expectIs CallStack HasCallStack => CallStack Stack.callStack String "render" String output String -> Bool f expectStateEq :: (Stack.HasCallStack, Show s, Eq s) => s -> InteractiveM s () expectStateEq :: forall s. (HasCallStack, Show s, Eq s) => s -> InteractiveM s () expectStateEq s value = do AppState {s state :: forall s. AppState s -> s state :: s state} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> s -> s -> InteractiveM s () forall a s. (Show a, Eq a) => CallStack -> a -> a -> InteractiveM s () _expectEq CallStack HasCallStack => CallStack Stack.callStack s state s value expectStateIs :: (Stack.HasCallStack, Show s, Eq s) => (s -> Bool) -> InteractiveM s () expectStateIs :: forall s. (HasCallStack, Show s, Eq s) => (s -> Bool) -> InteractiveM s () expectStateIs s -> Bool f = do AppState {s state :: forall s. AppState s -> s state :: s state} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> String -> s -> (s -> Bool) -> InteractiveM s () forall a s. CallStack -> String -> a -> (a -> Bool) -> InteractiveM s () _expectIs CallStack HasCallStack => CallStack Stack.callStack String "state" s state s -> Bool f expectContinue :: (Stack.HasCallStack) => InteractiveM s () expectContinue :: forall s. HasCallStack => InteractiveM s () expectContinue = CallStack -> InteractiveM s () forall s. CallStack -> InteractiveM s () _expectContinue CallStack HasCallStack => CallStack Stack.callStack _expectContinue :: Stack.CallStack -> InteractiveM s () _expectContinue :: forall s. CallStack -> InteractiveM s () _expectContinue CallStack callstack = do AppState {ContinueExit continue :: forall s. AppState s -> ContinueExit continue :: ContinueExit continue} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> ContinueExit -> ContinueExit -> InteractiveM s () forall a s. (Show a, Eq a) => CallStack -> a -> a -> InteractiveM s () _expectEq CallStack callstack ContinueExit continue ContinueExit Continue expectExit :: (Stack.HasCallStack) => InteractiveM s () expectExit :: forall s. HasCallStack => InteractiveM s () expectExit = do AppState {ContinueExit continue :: forall s. AppState s -> ContinueExit continue :: ContinueExit continue} <- InteractiveM s (AppState s) forall s. InteractiveM s (AppState s) readAppState CallStack -> ContinueExit -> ContinueExit -> InteractiveM s () forall a s. (Show a, Eq a) => CallStack -> a -> a -> InteractiveM s () _expectEq CallStack HasCallStack => CallStack Stack.callStack ContinueExit continue ContinueExit Exit inputString :: String -> InteractiveM s () inputString :: forall s. String -> InteractiveM s () inputString String str = [Key] -> InteractiveM s () forall s. HasCallStack => [Key] -> InteractiveM s () pressKeys ((Char -> Key) -> String -> [Key] forall a b. (a -> b) -> [a] -> [b] map Char -> Key KChar String str) pressKey :: (Stack.HasCallStack) => Key -> InteractiveM s () pressKey :: forall s. HasCallStack => Key -> InteractiveM s () pressKey Key key = (HasCallStack => InteractiveM s ()) -> InteractiveM s () forall a. HasCallStack => (HasCallStack => a) -> a Stack.withFrozenCallStack ((HasCallStack => InteractiveM s ()) -> InteractiveM s ()) -> (HasCallStack => InteractiveM s ()) -> InteractiveM s () forall a b. (a -> b) -> a -> b $ Key -> [Modifier] -> InteractiveM s () forall s. HasCallStack => Key -> [Modifier] -> InteractiveM s () pressKey' Key key [] pressKeys :: (Stack.HasCallStack) => [Key] -> InteractiveM s () pressKeys :: forall s. HasCallStack => [Key] -> InteractiveM s () pressKeys [Key] keys = (HasCallStack => InteractiveM s ()) -> InteractiveM s () forall a. HasCallStack => (HasCallStack => a) -> a Stack.withFrozenCallStack ((HasCallStack => InteractiveM s ()) -> InteractiveM s ()) -> (HasCallStack => InteractiveM s ()) -> InteractiveM s () forall a b. (a -> b) -> a -> b $ [Key] -> (Key -> InteractiveM s ()) -> InteractiveM s () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () MTL.forM_ [Key] keys Key -> InteractiveM s () forall s. HasCallStack => Key -> InteractiveM s () pressKey pressKey' :: (Stack.HasCallStack) => Key -> [Modifier] -> InteractiveM s () pressKey' :: forall s. HasCallStack => Key -> [Modifier] -> InteractiveM s () pressKey' Key key [Modifier] modifiers = CallStack -> Event -> InteractiveM s () forall s. CallStack -> Event -> InteractiveM s () _sendEvent CallStack HasCallStack => CallStack Stack.callStack (Key -> [Modifier] -> Event Key Key key [Modifier] modifiers) sendEvent :: (Stack.HasCallStack) => Event -> InteractiveM s () sendEvent :: forall s. HasCallStack => Event -> InteractiveM s () sendEvent = CallStack -> Event -> InteractiveM s () forall s. CallStack -> Event -> InteractiveM s () _sendEvent CallStack HasCallStack => CallStack Stack.callStack _sendEvent :: Stack.CallStack -> Event -> InteractiveM s () _sendEvent :: forall s. CallStack -> Event -> InteractiveM s () _sendEvent CallStack callstack Event event = do CallStack -> InteractiveM s () forall s. CallStack -> InteractiveM s () _expectContinue CallStack callstack Sandbox s app' <- InteractiveM s (Sandbox s) forall s. InteractiveM s (Sandbox s) getApp ReaderT (Env s) IO () -> InteractiveM s () forall s a. ReaderT (Env s) IO a -> InteractiveM s a InteractiveM (ReaderT (Env s) IO () -> InteractiveM s ()) -> ReaderT (Env s) IO () -> InteractiveM s () forall a b. (a -> b) -> a -> b $ do IORef (AppState s) appState' <- (Env s -> IORef (AppState s)) -> ReaderT (Env s) IO (IORef (AppState s)) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a MTL.asks Env s -> IORef (AppState s) forall s. Env s -> IORef (AppState s) appState IO () -> ReaderT (Env s) IO () forall a. IO a -> ReaderT (Env s) IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a MTL.liftIO (IO () -> ReaderT (Env s) IO ()) -> IO () -> ReaderT (Env s) IO () forall a b. (a -> b) -> a -> b $ IORef (AppState s) -> (AppState s -> AppState s) -> IO () forall a. IORef a -> (a -> a) -> IO () modifyIORef IORef (AppState s) appState' (Sandbox s -> Event -> AppState s -> AppState s forall s. Sandbox s -> Event -> AppState s -> AppState s updateAppState Sandbox s app' Event event) updateAppState :: Sandbox s -> Event -> AppState s -> AppState s updateAppState :: forall s. Sandbox s -> Event -> AppState s -> AppState s updateAppState Sandbox s app Event event AppState {s state :: forall s. AppState s -> s state :: s state} = let (s state', ContinueExit continue') = Sandbox s app.update Event event s state output' :: String output' = Sandbox s app.render s state' in AppState { state :: s state = s state', continue :: ContinueExit continue = ContinueExit continue', output :: String output = String output' } getApp :: InteractiveM s (Sandbox s) getApp :: forall s. InteractiveM s (Sandbox s) getApp = ReaderT (Env s) IO (Sandbox s) -> InteractiveM s (Sandbox s) forall s a. ReaderT (Env s) IO a -> InteractiveM s a InteractiveM (ReaderT (Env s) IO (Sandbox s) -> InteractiveM s (Sandbox s)) -> ReaderT (Env s) IO (Sandbox s) -> InteractiveM s (Sandbox s) forall a b. (a -> b) -> a -> b $ (Env s -> Sandbox s) -> ReaderT (Env s) IO (Sandbox s) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a MTL.asks Env s -> Sandbox s forall s. Env s -> Sandbox s app readAppState :: InteractiveM s (AppState s) readAppState :: forall s. InteractiveM s (AppState s) readAppState = ReaderT (Env s) IO (AppState s) -> InteractiveM s (AppState s) forall s a. ReaderT (Env s) IO a -> InteractiveM s a InteractiveM (ReaderT (Env s) IO (AppState s) -> InteractiveM s (AppState s)) -> ReaderT (Env s) IO (AppState s) -> InteractiveM s (AppState s) forall a b. (a -> b) -> a -> b $ do IORef (AppState s) appState' <- (Env s -> IORef (AppState s)) -> ReaderT (Env s) IO (IORef (AppState s)) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a MTL.asks Env s -> IORef (AppState s) forall s. Env s -> IORef (AppState s) appState IO (AppState s) -> ReaderT (Env s) IO (AppState s) forall a. IO a -> ReaderT (Env s) IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a MTL.liftIO (IO (AppState s) -> ReaderT (Env s) IO (AppState s)) -> IO (AppState s) -> ReaderT (Env s) IO (AppState s) forall a b. (a -> b) -> a -> b $ IORef (AppState s) -> IO (AppState s) forall a. IORef a -> IO a readIORef IORef (AppState s) appState' _expectEq :: (Show a, Eq a) => Stack.CallStack -> a -> a -> InteractiveM s () _expectEq :: forall a s. (Show a, Eq a) => CallStack -> a -> a -> InteractiveM s () _expectEq CallStack callstack a actual a expected = if a actual a -> a -> Bool forall a. Eq a => a -> a -> Bool == a expected then () -> InteractiveM s () forall a. a -> InteractiveM s a forall (f :: * -> *) a. Applicative f => a -> f a pure () else String -> InteractiveM s () forall a. String -> InteractiveM s a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> InteractiveM s ()) -> String -> InteractiveM s () forall a b. (a -> b) -> a -> b $ String "Expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> a -> String forall a. Show a => a -> String show a expected String -> String -> String forall a. Semigroup a => a -> a -> a <> String " but got " String -> String -> String forall a. Semigroup a => a -> a -> a <> a -> String forall a. Show a => a -> String show a actual String -> String -> String forall a. Semigroup a => a -> a -> a <> String ".\n" String -> String -> String forall a. Semigroup a => a -> a -> a <> CallStack -> String Stack.prettyCallStack CallStack callstack _expectIs :: Stack.CallStack -> String -> a -> (a -> Bool) -> InteractiveM s () _expectIs :: forall a s. CallStack -> String -> a -> (a -> Bool) -> InteractiveM s () _expectIs CallStack callstack String label a actual a -> Bool f = if a -> Bool f a actual then () -> InteractiveM s () forall a. a -> InteractiveM s a forall (f :: * -> *) a. Applicative f => a -> f a pure () else String -> InteractiveM s () forall a. String -> InteractiveM s a forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> InteractiveM s ()) -> String -> InteractiveM s () forall a b. (a -> b) -> a -> b $ String "Expected " String -> String -> String forall a. Semigroup a => a -> a -> a <> String label String -> String -> String forall a. Semigroup a => a -> a -> a <> String " to satisfy predicate.\n" String -> String -> String forall a. Semigroup a => a -> a -> a <> CallStack -> String Stack.prettyCallStack CallStack callstack runInteractiveTest :: Sandbox s -> InteractiveM s a -> IO a runInteractiveTest :: forall s a. Sandbox s -> InteractiveM s a -> IO a runInteractiveTest Sandbox s app (InteractiveM ReaderT (Env s) IO a m) = do let state :: s state = Sandbox s app.initialize IORef (AppState s) appState <- AppState s -> IO (IORef (AppState s)) forall a. a -> IO (IORef a) newIORef AppState { state :: s state = s state, continue :: ContinueExit continue = ContinueExit Continue, output :: String output = Sandbox s app.render s state } ReaderT (Env s) IO a -> Env s -> IO a forall r (m :: * -> *) a. ReaderT r m a -> r -> m a MTL.runReaderT ReaderT (Env s) IO a m Env {app :: Sandbox s app = Sandbox s app, appState :: IORef (AppState s) appState = IORef (AppState s) appState}