    {-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving #-}

    module Test.Util(
        Test, withTests,
        passed, failed, progress,
        ) where

    import Idea
    import Control.Monad
    import Control.Monad.Trans.Reader
    import Control.Monad.IO.Class
    import Data.IORef

    data S = S
        {S -> Int
    failures :: !Int
        ,S -> Int
    total :: !Int
        ,S -> [[Idea]]
    ideas :: [[Idea]]
        }

    newtype Test a = Test (ReaderT (IORef S) IO a)
        deriving ((forall a b. (a -> b) -> Test a -> Test b)
    -> (forall a b. a -> Test b -> Test a) -> Functor Test
    forall a b. a -> Test b -> Test a
    forall a b. (a -> b) -> Test a -> Test b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Test a -> Test b
    fmap :: forall a b. (a -> b) -> Test a -> Test b
    $c<$ :: forall a b. a -> Test b -> Test a
    <$ :: forall a b. a -> Test b -> Test a
    Functor, Functor Test
    Functor Test =>
    (forall a. a -> Test a)
    -> (forall a b. Test (a -> b) -> Test a -> Test b)
    -> (forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c)
    -> (forall a b. Test a -> Test b -> Test b)
    -> (forall a b. Test a -> Test b -> Test a)
    -> Applicative Test
    forall a. a -> Test a
    forall a b. Test a -> Test b -> Test a
    forall a b. Test a -> Test b -> Test b
    forall a b. Test (a -> b) -> Test a -> Test b
    forall a b c. (a -> b -> c) -> Test a -> Test b -> Test 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 a. a -> Test a
    pure :: forall a. a -> Test a
    $c<*> :: forall a b. Test (a -> b) -> Test a -> Test b
    <*> :: forall a b. Test (a -> b) -> Test a -> Test b
    $cliftA2 :: forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
    liftA2 :: forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
    $c*> :: forall a b. Test a -> Test b -> Test b
    *> :: forall a b. Test a -> Test b -> Test b
    $c<* :: forall a b. Test a -> Test b -> Test a
    <* :: forall a b. Test a -> Test b -> Test a
    Applicative, Applicative Test
    Applicative Test =>
    (forall a b. Test a -> (a -> Test b) -> Test b)
    -> (forall a b. Test a -> Test b -> Test b)
    -> (forall a. a -> Test a)
    -> Monad Test
    forall a. a -> Test a
    forall a b. Test a -> Test b -> Test b
    forall a b. Test a -> (a -> Test b) -> Test 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 a b. Test a -> (a -> Test b) -> Test b
    >>= :: forall a b. Test a -> (a -> Test b) -> Test b
    $c>> :: forall a b. Test a -> Test b -> Test b
    >> :: forall a b. Test a -> Test b -> Test b
    $creturn :: forall a. a -> Test a
    return :: forall a. a -> Test a
    Monad, Monad Test
    Monad Test => (forall a. IO a -> Test a) -> MonadIO Test
    forall a. IO a -> Test a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> Test a
    liftIO :: forall a. IO a -> Test a
    MonadIO)

    -- | Returns the number of failing tests.
    withTests :: Test a -> IO (Int, a)
    withTests :: forall a. Test a -> IO (Int, a)
    withTests (Test ReaderT (IORef S) IO a
    act) = do
        ref <- S -> IO (IORef S)
    forall a. a -> IO (IORef a)
    newIORef (S -> IO (IORef S)) -> S -> IO (IORef S)
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> [[Idea]] -> S
    S Int
    0 Int
    0 []
        res <- runReaderT act ref
        S{..} <- readIORef ref
        putStrLn ""
        putStrLn $ if failures == 0
            then "Tests passed (" ++ show total ++ ")"
            else "Tests failed (" ++ show failures ++ " of " ++ show total ++ ")"
        pure (failures, res)

    progress :: Test ()
    progress :: Test ()
    progress = IO () -> Test ()
    forall a. IO a -> Test a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Test ()) -> IO () -> Test ()
    forall a b. (a -> b) -> a -> b
    $ Char -> IO ()
    putChar Char
    '.'

    passed :: Test ()
    passed :: Test ()
    passed = do
        ref <- ReaderT (IORef S) IO (IORef S) -> Test (IORef S)
    forall a. ReaderT (IORef S) IO a -> Test a
    Test ReaderT (IORef S) IO (IORef S)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        liftIO $ modifyIORef' ref $ \S
    s -> S
    s{total=total s+1}

    failed :: [String] -> Test ()
    failed :: [String] -> Test ()
    failed [String]
    xs = do
        Bool -> Test () -> Test ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    xs) (Test () -> Test ()) -> Test () -> Test ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Test ()
    forall a. IO a -> Test a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Test ()) -> IO () -> Test ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    xs
        ref <- ReaderT (IORef S) IO (IORef S) -> Test (IORef S)
    forall a. ReaderT (IORef S) IO a -> Test a
    Test ReaderT (IORef S) IO (IORef S)
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        liftIO $ modifyIORef' ref $ \S
    s -> S
    s{total=total s+1, failures=failures s+1}