{-# 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)

-- | The file to log whenever a golden file is referenced.
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"

-- | Whether the test should create the golden files if the files do not exist.
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"

-- | Whether the test should recreate the golden files if the files already exist.
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

-- | Diff contents against the golden file.  If CREATE_GOLDEN_FILES environment is
-- set to "1", then should the golden file not exist it would be created.  If
-- RECREATE_GOLDEN_FILES is set to "1", then should the golden file exist it would
-- be recreated. If GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file
-- path will be logged to the specified file.
--
-- Set the environment variable when you intend to generate or re-generate the golden
-- file for example when running the test for the first time or if the golden file
-- genuinely needs to change.
--
-- To re-generate a golden file you must also delete the golden file because golden
-- files are never overwritten.
--
-- TODO: Improve the help output by saying the difference of
-- each input.
diffVsGoldenFile
  :: HasCallStack
  => (MonadIO m, MonadTest m)
  => String   -- ^ Actual content
  -> FilePath -- ^ Reference file
  -> 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

-- | Diff file against the golden file.  If CREATE_GOLDEN_FILES environment is
-- set to "1", then should the gold file not exist it would be created.  If
-- GOLDEN_FILE_LOG_FILE is set to a filename, then the golden file path will be
-- logged to the specified file.
--
-- Set the environment variable when you intend to generate or re-generate the golden
-- file for example when running the test for the first time or if the golden file
-- genuinely needs to change.
--
-- To re-generate a golden file you must also delete the golden file because golden
-- files are never overwritten.
diffFileVsGoldenFile
  :: HasCallStack
  => (MonadIO m, MonadTest m)
  => FilePath -- ^ Actual file
  -> FilePath -- ^ Reference file
  -> 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