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 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 $ do
acceptGoldenTests opts tree
return True
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 ()
acceptGoldenTests opts tests = do
let gs = getGoldenTests opts tests
forM_ gs $ \(n,g) -> do
acceptGoldenTest g
printf "Accepted %s\n" n