module Hedgehog.Extras.Test.Golden
( diffVsGoldenFile,
diffFileVsGoldenFile,
) where
import Control.Applicative
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)
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.Unsafe as IO
createFiles :: Bool
createFiles :: Bool
createFiles = 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"
diffVsGoldenFile
:: HasCallStack
=> (MonadIO m, MonadTest m)
=> String
-> FilePath
-> m ()
diffVsGoldenFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadTest m) =>
String -> String -> m ()
diffVsGoldenFile String
actualContent String
referenceFile = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
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
referenceFile
if Bool
fileExists
then 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
referenceFile
let difference :: [Diff [String]]
difference = forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff [String]
actualLines [String]
referenceLines
case [Diff [String]]
difference of
[Both{}] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[Diff [String]]
_ -> 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
else if Bool
createFiles
then 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
referenceFile
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> m ()
H.createDirectoryIfMissing_ (String -> String
takeDirectory String
referenceFile)
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
String -> String -> m ()
H.writeFile String
referenceFile String
actualContent
else do
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
H.note_ forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ String
"Golden file " forall a. Semigroup a => a -> a -> a
<> String
referenceFile
, String
" does not exist. To create, run with CREATE_GOLDEN_FILES=1"
]
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
H.failure
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