tasty-golden-2.2.0.2/0000755000000000000000000000000012257063362012461 5ustar0000000000000000tasty-golden-2.2.0.2/LICENSE0000644000000000000000000000204312257063362013465 0ustar0000000000000000Copyright (c) 2012 Roman Cheplyaka Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tasty-golden-2.2.0.2/Setup.hs0000644000000000000000000000005612257063362014116 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-golden-2.2.0.2/tasty-golden.cabal0000644000000000000000000000235312257063362016062 0ustar0000000000000000name: tasty-golden version: 2.2.0.2 synopsis: Golden tests support for tasty description: This package provides support for «golden testing». A golden test is an IO action that writes its result to a file. To pass the test, this output file should be identical to the corresponding «golden» file, which contains the correct result for the test. license: MIT license-file: LICENSE Homepage: https://github.com/feuerbach/tasty-golden Bug-reports: https://github.com/feuerbach/tasty-golden/issues author: Roman Cheplyaka maintainer: Roman Cheplyaka -- copyright: category: Testing build-type: Simple cabal-version: >=1.8 Source-repository head type: git location: git://github.com/feuerbach/tasty-golden.git library exposed-modules: Test.Tasty.Golden Test.Tasty.Golden.Advanced Test.Tasty.Golden.Manage other-modules: Test.Tasty.Golden.Internal build-depends: base ==4.*, tasty >= 0.7, bytestring, process, mtl, optparse-applicative, filepath, temporary >= 1.1, tagged tasty-golden-2.2.0.2/Test/0000755000000000000000000000000012257063362013400 5ustar0000000000000000tasty-golden-2.2.0.2/Test/Tasty/0000755000000000000000000000000012257063362014504 5ustar0000000000000000tasty-golden-2.2.0.2/Test/Tasty/Golden.hs0000644000000000000000000001033612257063362016253 0ustar0000000000000000{- | This module provides a simplified interface. If you want more, see "Test.Tasty.Golden.Advanced". -} module Test.Tasty.Golden ( goldenVsFile , goldenVsString , goldenVsFileDiff , goldenVsStringDiff ) where import Test.Tasty.Providers import Test.Tasty.Golden.Advanced import Text.Printf import qualified Data.ByteString.Lazy as LB import System.IO import System.IO.Temp import System.Process import System.Exit import System.FilePath import Control.Exception import Control.Monad -- trick to avoid an explicit dependency on transformers import Control.Monad.Error (liftIO) -- | Compare a given file contents against the golden file contents goldenVsFile :: TestName -- ^ test name -> FilePath -- ^ path to the «golden» file (the file that contains correct output) -> FilePath -- ^ path to the output file -> IO () -- ^ action that creates the output file -> TestTree -- ^ the test verifies that the output file contents is the same as the golden file contents goldenVsFile name ref new act = goldenTest name (vgReadFile ref) (liftIO act >> vgReadFile new) cmp upd where cmp = simpleCmp $ printf "Files '%s' and '%s' differ" ref new upd = LB.writeFile ref -- | Compare a given string against the golden file contents goldenVsString :: TestName -- ^ test name -> FilePath -- ^ path to the «golden» file (the file that contains correct output) -> IO LB.ByteString -- ^ action that returns a string -> TestTree -- ^ the test verifies that the returned string is the same as the golden file contents goldenVsString name ref act = goldenTest name (vgReadFile ref) (liftIO act) cmp upd where cmp x y = simpleCmp msg x y where msg = printf "Test output was different from '%s'. It was: %s" ref (show y) upd = LB.writeFile ref simpleCmp :: Eq a => String -> a -> a -> IO (Maybe String) simpleCmp e x y = return $ if x == y then Nothing else Just e -- | Same as 'goldenVsFile', but invokes an external diff command. goldenVsFileDiff :: TestName -- ^ test name -> (FilePath -> FilePath -> [String]) -- ^ function that constructs the command line to invoke the diff -- command. -- -- E.g. -- -- >\ref new -> ["diff", "-u", ref, new] -> FilePath -- ^ path to the golden file -> FilePath -- ^ path to the output file -> IO () -- ^ action that produces the output file -> TestTree goldenVsFileDiff name cmdf ref new act = goldenTest name (return ()) (liftIO act) cmp upd where cmd = cmdf ref new cmp _ _ | null cmd = error "goldenVsFileDiff: empty command line" cmp _ _ = do (_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe } -- strictly read the whole output, so that the process can terminate out <- hGetContents sout evaluate $ length out r <- waitForProcess pid return $ case r of ExitSuccess -> Nothing _ -> Just out upd _ = LB.readFile new >>= LB.writeFile ref -- | Same as 'goldenVsString', but invokes an external diff command. goldenVsStringDiff :: TestName -- ^ test name -> (FilePath -> FilePath -> [String]) -- ^ function that constructs the command line to invoke the diff -- command. -- -- E.g. -- -- >\ref new -> ["diff", "-u", ref, new] -> FilePath -- ^ path to the golden file -> IO LB.ByteString -- ^ action that returns a string -> TestTree goldenVsStringDiff name cmdf ref act = goldenTest name (vgReadFile ref) (liftIO act) cmp upd where template = takeFileName ref <.> "actual" cmp _ actBS = withSystemTempFile template $ \tmpFile tmpHandle -> do -- Write act output to temporary ("new") file LB.hPut tmpHandle actBS >> hFlush tmpHandle let cmd = cmdf ref tmpFile when (null cmd) $ error "goldenVsFileDiff: empty command line" (_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe } -- strictly read the whole output, so that the process can terminate out <- hGetContents sout _ <- evaluate $ length out r <- waitForProcess pid return $ case r of ExitSuccess -> Nothing _ -> Just (printf "Test output was different from '%s'. Output of %s:\n%s" ref (show cmd) out) upd = LB.writeFile ref tasty-golden-2.2.0.2/Test/Tasty/Golden/0000755000000000000000000000000012257063362015714 5ustar0000000000000000tasty-golden-2.2.0.2/Test/Tasty/Golden/Internal.hs0000644000000000000000000000332012257063362020022 0ustar0000000000000000{-# LANGUAGE RankNTypes, ExistentialQuantification, DeriveDataTypeable, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} module Test.Tasty.Golden.Internal where import Data.Typeable (Typeable) import Control.Applicative import Control.Monad.Cont import Test.Tasty.Providers import Data.ByteString.Lazy as LB import Control.Exception import System.IO import Data.Maybe -- | See 'goldenTest' for explanation of the fields data Golden = forall a . Golden (forall r . ValueGetter r a) (forall r . ValueGetter r a) (a -> a -> IO (Maybe String)) (a -> IO ()) deriving Typeable -- | An action that yields a value (either golden or tested). -- -- CPS allows closing the file handle when using lazy IO to read data. newtype ValueGetter r a = ValueGetter { runValueGetter :: ContT r IO a } deriving (Functor, Applicative, Monad, MonadCont, MonadIO) -- | Lazily read a file. The file handle will be closed after the -- 'ValueGetter' action is run. vgReadFile :: FilePath -> ValueGetter r ByteString vgReadFile path = (liftIO . LB.hGetContents =<<) $ ValueGetter $ ContT $ \k -> bracket (openBinaryFile path ReadMode) hClose k -- | Ensures that the result is fully evaluated (so that lazy file handles -- can be closed) vgRun :: ValueGetter r r -> IO r vgRun (ValueGetter a) = runContT a evaluate instance IsTest Golden where run opts golden _ = runGolden golden testOptions = return [] runGolden :: Golden -> IO Result runGolden (Golden getGolden getTested cmp _) = do result <- vgRun $ do new <- getTested ref <- getGolden liftIO $ cmp ref new return $ case result of Just reason -> Result False reason Nothing -> Result True "" tasty-golden-2.2.0.2/Test/Tasty/Golden/Manage.hs0000644000000000000000000000452712257063362017450 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-} -- | Golden test management module Test.Tasty.Golden.Manage ( -- * Command line helpers defaultMain -- * The ingredient , acceptingTests , AcceptTests(..) -- * Programmatic API , acceptGoldenTests ) where import Test.Tasty hiding (defaultMain) import Test.Tasty.Runners import Test.Tasty.Options import Test.Tasty.Golden.Internal import Data.Maybe import Data.Typeable import Data.Tagged import Data.Proxy import Control.Monad.Cont import Text.Printf import Options.Applicative import System.Exit -- | Like @defaultMain@ from the main tasty package, but also includes the -- golden test management capabilities. defaultMain :: TestTree -> IO () defaultMain = defaultMainWithIngredients [acceptingTests, listingTests, consoleTestReporter] -- | This option, when set to 'True', specifies that we should run in the -- «accept tests» mode 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 -- | Get the list of all golden tests in a given test tree getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)] getGoldenTests = foldTestTree trivialFold { foldSingle = \_ name t -> fmap ((,) name) $ maybeToList $ cast t } -- | «Accept» a golden test, i.e. reset the golden value to the currently -- produced value acceptGoldenTest :: Golden -> IO () acceptGoldenTest (Golden _ getTested _ update) = vgRun $ liftIO . update =<< getTested -- | Accept all golden tests in the test tree 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 tasty-golden-2.2.0.2/Test/Tasty/Golden/Advanced.hs0000644000000000000000000000167112257063362017762 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module Test.Tasty.Golden.Advanced ( -- * The main function goldenTest, -- * ValueGetter monad ValueGetter(..), vgReadFile ) where import Test.Tasty.Providers import Test.Tasty.Golden.Internal -- | A very general testing function. goldenTest :: TestName -- ^ test name -> (forall r . ValueGetter r a) -- ^ get the golden correct value -> (forall r . ValueGetter r a) -- ^ get the tested value -> (a -> a -> IO (Maybe String)) -- ^ comparison function. -- -- If two values are the same, it should return 'Nothing'. If they are -- different, it should return an error that will be printed to the user. -- First argument is the golden value. -- -- The function may use 'IO', for example, to launch an external @diff@ -- command. -> (a -> IO ()) -- ^ update the golden file -> TestTree goldenTest t golden test cmp upd = singleTest t $ Golden golden test cmp upd