{-# LANGUAGE MultiWayIf #-}
module Hedgehog.Extras.Test.Golden
( diffVsGoldenFile,
diffFileVsGoldenFile,
) where
import Control.Applicative
import Control.Exception (bracket_)
import Control.Monad
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff)
import Data.Algorithm.DiffOutput (ppDiff)
import Data.Bool
import Data.Eq
import Data.Function
import Data.Maybe
import Data.Monoid
import Data.String
import GHC.Stack (HasCallStack, callStack)
import Hedgehog (MonadTest)
import Hedgehog.Extras.Test.Base (failMessage)
import System.FilePath (takeDirectory)
import System.IO (FilePath, IO)
import qualified Control.Concurrent.QSem as IO
import qualified Data.List as List
import qualified GHC.Stack as GHC
import qualified Hedgehog.Extras.Test as H
import qualified Hedgehog.Internal.Property as H
import qualified System.Directory as IO
import qualified System.Environment as IO
import qualified System.IO as IO
import qualified System.IO.Unsafe as IO
sem :: IO.QSem
sem :: QSem
sem = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$ Int -> IO QSem
IO.newQSem Int
1
{-# NOINLINE sem #-}
semBracket :: IO a -> IO a
semBracket :: forall a. IO a -> IO a
semBracket = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (QSem -> IO ()
IO.waitQSem QSem
sem) (QSem -> IO ()
IO.signalQSem QSem
sem)
mGoldenFileLogFile :: Maybe FilePath
mGoldenFileLogFile :: Maybe String
mGoldenFileLogFile = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$
String -> IO (Maybe String)
IO.lookupEnv String
"GOLDEN_FILE_LOG_FILE"
createGoldenFiles :: Bool
createGoldenFiles :: Bool
createGoldenFiles = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Maybe String
value <- String -> IO (Maybe String)
IO.lookupEnv String
"CREATE_GOLDEN_FILES"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe String
value forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"1"
recreateGoldenFiles :: Bool
recreateGoldenFiles :: Bool
recreateGoldenFiles = forall a. IO a -> a
IO.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Maybe String
value <- String -> IO (Maybe String)
IO.lookupEnv String
"RECREATE_GOLDEN_FILES"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe String
value forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"1"
writeGoldenFile :: ()
=> MonadIO m
=> MonadTest m
=> FilePath
-> String
-> m ()
writeGoldenFile :: forall (m :: * -> *).
(MonadIO m, MonadTest m) =>
String -> String -> m ()
writeGoldenFile String
goldenFile String
actualContent = do
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.note_ forall a b. (a -> b) -> a -> b
$ String
"Creating golden file " forall a. Semigroup a => a -> a -> a
<> String
goldenFile
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> m ()
H.createDirectoryIfMissing_ (String -> String
takeDirectory String
goldenFile)
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> String -> m ()
H.writeFile String
goldenFile String
actualContent
reportGoldenFileMissing :: ()
=> MonadIO m
=> MonadTest m
=> FilePath
-> m ()
reportGoldenFileMissing :: forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
reportGoldenFileMissing String
goldenFile = do
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.note_ forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Golden file " forall a. Semigroup a => a -> a -> a
<> String
goldenFile forall a. Semigroup a => a -> a -> a
<> String
" does not exist."
, String
"To create it, run with CREATE_GOLDEN_FILES=1."
, String
"To recreate it, run with RECREATE_GOLDEN_FILES=1."
]
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
H.failure
checkAgainstGoldenFile :: ()
=> MonadIO m
=> MonadTest m
=> FilePath
-> [String]
-> m ()
checkAgainstGoldenFile :: forall (m :: * -> *).
(MonadIO m, MonadTest m) =>
String -> [String] -> m ()
checkAgainstGoldenFile String
goldenFile [String]
actualLines = do
[String]
referenceLines <- String -> [String]
List.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> m String
H.readFile String
goldenFile
let difference :: [Diff [String]]
difference = forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [String]
actualLines [String]
referenceLines
case [Diff [String]]
difference of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[Both{}] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[Diff [String]]
_ -> do
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.note_ forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Golden test failed against golden file: " forall a. Semigroup a => a -> a -> a
<> String
goldenFile
, String
"To recreate golden file, run with RECREATE_GOLDEN_FILES=1."
]
forall (m :: * -> *) a. MonadTest m => CallStack -> String -> m a
failMessage HasCallStack => CallStack
callStack forall a b. (a -> b) -> a -> b
$ [Diff [String]] -> String
ppDiff [Diff [String]]
difference
diffVsGoldenFile
:: HasCallStack
=> (MonadIO m, MonadTest m)
=> String
-> FilePath
-> m ()
diffVsGoldenFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadTest m) =>
String -> String -> m ()
diffVsGoldenFile String
actualContent String
goldenFile = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
mGoldenFileLogFile forall a b. (a -> b) -> a -> b
$ \String
logFile ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
semBracket forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
IO.appendFile String
logFile forall a b. (a -> b) -> a -> b
$ String
goldenFile forall a. Semigroup a => a -> a -> a
<> String
"\n"
Bool
fileExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
IO.doesFileExist String
goldenFile
if
| Bool
recreateGoldenFiles -> forall (m :: * -> *).
(MonadIO m, MonadTest m) =>
String -> String -> m ()
writeGoldenFile String
goldenFile String
actualContent
| Bool
fileExists -> forall (m :: * -> *).
(MonadIO m, MonadTest m) =>
String -> [String] -> m ()
checkAgainstGoldenFile String
goldenFile [String]
actualLines
| Bool
createGoldenFiles -> forall (m :: * -> *).
(MonadIO m, MonadTest m) =>
String -> String -> m ()
writeGoldenFile String
goldenFile String
actualContent
| Bool
otherwise -> forall (m :: * -> *). (MonadIO m, MonadTest m) => String -> m ()
reportGoldenFileMissing String
goldenFile
where
actualLines :: [String]
actualLines = String -> [String]
List.lines String
actualContent
diffFileVsGoldenFile
:: HasCallStack
=> (MonadIO m, MonadTest m)
=> FilePath
-> FilePath
-> m ()
diffFileVsGoldenFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadTest m) =>
String -> String -> m ()
diffFileVsGoldenFile String
actualFile String
referenceFile = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
String
contents <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> m String
H.readFile String
actualFile
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadTest m) =>
String -> String -> m ()
diffVsGoldenFile String
contents String
referenceFile