module Test.Tasty.Golden.Manage
(
defaultMain
, defaultMainWithRunner
, goldenManagerParser
, acceptGoldenTests
)
where
import Test.Tasty hiding (defaultMainWithRunner, defaultMain)
import Test.Tasty.Runners hiding (defaultMainWithRunner)
import Test.Tasty.Options
import Test.Tasty.Golden.Internal
import Data.Maybe
import Data.Typeable
import Control.Monad.Cont
import Text.Printf
import Options.Applicative
import System.Exit
goldenManagerParser :: Parser (OptionSet -> TestTree -> IO ())
goldenManagerParser =
flag'
acceptGoldenTests
( long "accept"
<> help "Accept current results of golden tests"
)
defaultMainWithRunner :: Runner -> TestTree -> IO ()
defaultMainWithRunner runner testTree = do
let
runTests opts =
execRunner runner opts testTree >>= \ok ->
if ok then exitSuccess else exitFailure
optsParser = treeOptionParser testTree
mgmntParser :: Parser (OptionSet -> IO ())
mgmntParser =
(\mgr opts -> mgr opts testTree) <$> goldenManagerParser
parser =
(mgmntParser <|> pure runTests) <*> optsParser
join $ execParser $
info (helper <*> parser)
( fullDesc <>
header "Mmm... tasty test suite (with golden test management capabilities)"
)
defaultMain :: TestTree -> IO ()
defaultMain = defaultMainWithRunner runUI
getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)]
getGoldenTests =
foldTestTree
(\_ name t -> fmap ((,) name) $ maybeToList $ cast t)
(const id)
acceptGoldenTest :: Golden -> IO ()
acceptGoldenTest (Golden _ getTested _ update) =
vgRun $ liftIO . update =<< getTested
acceptGoldenTests :: OptionSet -> TestTree -> IO ()
acceptGoldenTests opts tests = do
let gs = getGoldenTests opts tests
forM_ gs $ \(n,g) -> do
acceptGoldenTest g
printf "Accepted %s\n" n