{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving #-}
module Test.Util(
Test, withTests,
passed, failed, progress,
addIdeas, getIdeas,
BuiltinSummary, BuiltinEx(..), addBuiltin, getBuiltins,
) where
import Idea
import Control.Monad
import Control.Monad.Trans.Reader
import Control.Monad.IO.Class
import Data.IORef
import Data.List.Extra
import Data.Map (Map)
import qualified Data.Map.Strict as Map
type BuiltinSummary = Map (String, Severity, Bool) BuiltinEx
data BuiltinEx = BuiltinEx
{ BuiltinEx -> String
builtinInp :: !String
, BuiltinEx -> String
builtinFrom :: !String
, BuiltinEx -> Maybe String
builtinTo :: !(Maybe String)
}
data S = S
{S -> Int
failures :: !Int
,S -> Int
total :: !Int
,S -> [[Idea]]
ideas :: [[Idea]]
,S -> BuiltinSummary
builtinHints :: BuiltinSummary
}
newtype Test a = Test (ReaderT (IORef S) IO a)
deriving (a -> Test b -> Test a
(a -> b) -> Test a -> Test b
(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
<$ :: a -> Test b -> Test a
$c<$ :: forall a b. a -> Test b -> Test a
fmap :: (a -> b) -> Test a -> Test b
$cfmap :: forall a b. (a -> b) -> Test a -> Test b
Functor, Functor Test
a -> Test a
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
Test a -> Test b -> Test b
Test a -> Test b -> Test a
Test (a -> b) -> Test a -> Test b
(a -> b -> c) -> Test a -> Test b -> Test c
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
<* :: Test a -> Test b -> Test a
$c<* :: forall a b. Test a -> Test b -> Test a
*> :: Test a -> Test b -> Test b
$c*> :: forall a b. Test a -> Test b -> Test b
liftA2 :: (a -> b -> c) -> Test a -> Test b -> Test c
$cliftA2 :: forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
<*> :: Test (a -> b) -> Test a -> Test b
$c<*> :: forall a b. Test (a -> b) -> Test a -> Test b
pure :: a -> Test a
$cpure :: forall a. a -> Test a
$cp1Applicative :: Functor Test
Applicative, Applicative Test
a -> Test a
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
Test a -> (a -> Test b) -> Test b
Test a -> Test b -> Test b
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
return :: a -> Test a
$creturn :: forall a. a -> Test a
>> :: Test a -> Test b -> Test b
$c>> :: forall a b. Test a -> Test b -> Test b
>>= :: Test a -> (a -> Test b) -> Test b
$c>>= :: forall a b. Test a -> (a -> Test b) -> Test b
$cp1Monad :: Applicative Test
Monad, Monad Test
Monad Test => (forall a. IO a -> Test a) -> MonadIO Test
IO a -> Test a
forall a. IO a -> Test a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Test a
$cliftIO :: forall a. IO a -> Test a
$cp1MonadIO :: Monad Test
MonadIO)
withTests :: Test a -> IO (Int, a)
withTests :: Test a -> IO (Int, a)
withTests (Test act :: 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]] -> BuiltinSummary -> S
S 0 0 [] BuiltinSummary
forall k a. Map k a
Map.empty
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{..} <- IORef S -> IO S
forall a. IORef a -> IO a
readIORef IORef S
ref
String -> IO ()
putStrLn ""
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
== 0
then "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]
++ ")"
else "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]
++ " 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]
++ ")"
(Int, a) -> IO (Int, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
failures, a
res)
addIdeas :: [Idea] -> Test ()
addIdeas :: [Idea] -> Test ()
addIdeas xs :: [Idea]
xs = 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 (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
s{ideas :: [[Idea]]
ideas = [Idea]
xs [Idea] -> [[Idea]] -> [[Idea]]
forall a. a -> [a] -> [a]
: S -> [[Idea]]
ideas S
s}
getIdeas :: Test [Idea]
getIdeas :: Test [Idea]
getIdeas = 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 [Idea] -> Test [Idea]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Idea] -> Test [Idea]) -> IO [Idea] -> Test [Idea]
forall a b. (a -> b) -> a -> b
$ [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Idea]] -> [Idea]) -> (S -> [[Idea]]) -> S -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Idea]] -> [[Idea]]
forall a. [a] -> [a]
reverse ([[Idea]] -> [[Idea]]) -> (S -> [[Idea]]) -> S -> [[Idea]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> [[Idea]]
ideas (S -> [Idea]) -> IO S -> IO [Idea]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef S -> IO S
forall a. IORef a -> IO a
readIORef IORef S
ref
addBuiltin :: String -> Idea -> Test ()
addBuiltin :: String -> Idea -> Test ()
addBuiltin inp :: String
inp idea :: Idea
idea@Idea{..} = Bool -> Test () -> Test ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ("Parse error" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ideaHint) (Test () -> Test ()) -> Test () -> Test ()
forall a b. (a -> b) -> a -> b
$ 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 (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 ->
let k :: (String, Severity, Bool)
k = (String
ideaHint, Severity
ideaSeverity, [Refactoring SrcSpan] -> Bool
forall a. [a] -> Bool
notNull [Refactoring SrcSpan]
ideaRefactoring)
v :: BuiltinEx
v = String -> String -> Maybe String -> BuiltinEx
BuiltinEx String
inp String
ideaFrom Maybe String
ideaTo
in S
s{builtinHints :: BuiltinSummary
builtinHints = (BuiltinEx -> BuiltinEx -> BuiltinEx)
-> (String, Severity, Bool)
-> BuiltinEx
-> BuiltinSummary
-> BuiltinSummary
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (((BuiltinEx, BuiltinEx) -> BuiltinEx)
-> BuiltinEx -> BuiltinEx -> BuiltinEx
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (BuiltinEx, BuiltinEx) -> BuiltinEx
forall a b. (a, b) -> b
snd) (String, Severity, Bool)
k BuiltinEx
v (S -> BuiltinSummary
builtinHints S
s)}
getBuiltins :: Test BuiltinSummary
getBuiltins :: Test BuiltinSummary
getBuiltins = 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 BuiltinSummary -> Test BuiltinSummary
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuiltinSummary -> Test BuiltinSummary)
-> IO BuiltinSummary -> Test BuiltinSummary
forall a b. (a -> b) -> a -> b
$ S -> BuiltinSummary
builtinHints (S -> BuiltinSummary) -> IO S -> IO BuiltinSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef S -> IO S
forall a. IORef a -> IO a
readIORef IORef S
ref
progress :: Test ()
progress :: Test ()
progress = IO () -> Test ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Test ()) -> IO () -> Test ()
forall a b. (a -> b) -> a -> b
$ Char -> IO ()
putChar '.'
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 (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
s{total :: Int
total=S -> Int
total S
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+1}
failed :: [String] -> Test ()
failed :: [String] -> Test ()
failed xs :: [String]
xs = do
Bool -> Test () -> Test ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> 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 (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]
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 (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
s{total :: Int
total=S -> Int
total S
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, failures :: Int
failures=S -> Int
failures S
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+1}