module Test.Tasty.Golden.Manage
(
defaultMain
, acceptingTests
, AcceptTests(..)
, acceptGoldenTests
)
where
import Test.Tasty hiding (defaultMain)
import Test.Tasty.Runners
import Test.Tasty.Options
import Test.Tasty.Golden.Internal
import Data.Typeable
import Data.Tagged
import Data.Proxy
import Data.Maybe
import Control.Monad.Cont
import Control.Monad.State
import Control.Exception
import Control.Concurrent.Async
import Text.Printf
import Options.Applicative
defaultMain :: TestTree -> IO ()
defaultMain = defaultMainWithIngredients [acceptingTests, listingTests, consoleTestReporter]
newtype AcceptTests = AcceptTests Bool
deriving (Eq, Ord, Typeable)
instance IsOption AcceptTests where
defaultValue = AcceptTests False
parseValue = fmap AcceptTests . safeRead
optionName = return "accept"
optionHelp = return "Accept current results of golden tests"
optionCLParser =
fmap AcceptTests $
switch
( long (untag (optionName :: Tagged AcceptTests String))
<> help (untag (optionHelp :: Tagged AcceptTests String))
)
acceptingTests :: Ingredient
acceptingTests = TestManager [Option (Proxy :: Proxy AcceptTests)] $
\opts tree ->
case lookupOption opts of
AcceptTests False -> Nothing
AcceptTests True -> Just $
acceptGoldenTests opts tree
getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)]
getGoldenTests =
foldTestTree
trivialFold { foldSingle = \_ name t -> fmap ((,) name) $ maybeToList $ cast t }
acceptGoldenTest :: Golden -> IO ()
acceptGoldenTest (Golden _ getTested _ update) =
vgRun $ liftIO . update =<< getTested
acceptGoldenTests :: OptionSet -> TestTree -> IO Bool
acceptGoldenTests opts tests = do
let gs = getGoldenTests opts tests
numExns <- flip execStateT (0 :: Int) $ forM_ gs $ \(n,g) -> do
mbExn <- liftIO $ withAsync (acceptGoldenTest g) waitCatch
case mbExn of
Right {} -> liftIO $ printf "Accepted %s\n" n
Left e -> do
liftIO $ printf "Error when trying to accept %s: %s\n" n (show (e :: SomeException))
ne <- get
put $! ne+1
when (numExns > 0) $
printf "NOTE: %d tests threw exceptions!\n" numExns
return (numExns == 0)