{-# 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
    IORef S
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 []
    a
res <- ReaderT (IORef S) IO a -> IORef S -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (IORef S) IO a
act IORef S
ref
    S{Int
[[Idea]]
failures :: S -> Int
total :: S -> Int
ideas :: S -> [[Idea]]
failures :: Int
total :: Int
ideas :: [[Idea]]
..} <- IORef S -> IO S
forall a. IORef a -> IO a
readIORef IORef S
ref
    String -> IO ()
putStrLn String
""
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
failures Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then String
"Tests passed (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
total String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        else String
"Tests failed (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
failures String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
total String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    (Int, a) -> IO (Int, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
failures, a
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
    IORef S
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
    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
$ IORef S -> (S -> S) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef S
ref ((S -> S) -> IO ()) -> (S -> S) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
    IORef S
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
    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
$ IORef S -> (S -> S) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef S
ref ((S -> S) -> IO ()) -> (S -> S) -> IO ()
forall a b. (a -> b) -> a -> b
$ \S
s -> S
s{total=total s+1, failures=failures s+1}