module Test.Syd.Def.Golden
  ( module Test.Syd.Def.Golden,
    GoldenTest (..),
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as SB
import qualified Data.ByteString.Builder as SBB
import qualified Data.ByteString.Lazy as LB
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Path
import Path.IO
import Test.Syd.Expectation
import Test.Syd.Run
import Text.Show.Pretty

-- | Test that the given bytestring is the same as what we find in the given golden file.
pureGoldenByteStringFile :: FilePath -> ByteString -> GoldenTest ByteString
pureGoldenByteStringFile :: FilePath -> ByteString -> GoldenTest ByteString
pureGoldenByteStringFile FilePath
fp ByteString
bs = FilePath -> IO ByteString -> GoldenTest ByteString
goldenByteStringFile FilePath
fp (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs)

-- | Test that the produced bytestring is the same as what we find in the given golden file.
goldenByteStringFile :: FilePath -> IO ByteString -> GoldenTest ByteString
goldenByteStringFile :: FilePath -> IO ByteString -> GoldenTest ByteString
goldenByteStringFile FilePath
fp IO ByteString
produceBS =
  GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
    { goldenTestRead :: IO (Maybe ByteString)
goldenTestRead = do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile,
      goldenTestProduce :: IO ByteString
goldenTestProduce = IO ByteString
produceBS,
      goldenTestWrite :: ByteString -> IO ()
goldenTestWrite = \ByteString
actual -> do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> IO ()) -> Path Abs Dir -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
resolvedFile
        FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile) ByteString
actual,
      goldenTestCompare :: ByteString -> ByteString -> Maybe Assertion
goldenTestCompare = \ByteString
actual ByteString
expected ->
        if ByteString
actual ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expected
          then Maybe Assertion
forall a. Maybe a
Nothing
          else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion) -> Assertion -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Assertion -> FilePath -> Assertion
Context (ByteString -> ByteString -> Assertion
bytestringsNotEqualButShouldHaveBeenEqual ByteString
actual ByteString
expected) (FilePath -> FilePath
goldenContext FilePath
fp)
    }

-- | Test that the given lazy bytestring is the same as what we find in the given golden file.
--
-- Note: This converts the lazy bytestring to a strict bytestring first.
pureGoldenLazyByteStringFile :: FilePath -> LB.ByteString -> GoldenTest LB.ByteString
pureGoldenLazyByteStringFile :: FilePath -> ByteString -> GoldenTest ByteString
pureGoldenLazyByteStringFile FilePath
fp ByteString
bs = FilePath -> IO ByteString -> GoldenTest ByteString
goldenLazyByteStringFile FilePath
fp (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs)

-- | Test that the produced bytestring is the same as what we find in the given golden file.
--
-- Note: This converts the lazy bytestring to a strict bytestring first.
goldenLazyByteStringFile :: FilePath -> IO LB.ByteString -> GoldenTest LB.ByteString
goldenLazyByteStringFile :: FilePath -> IO ByteString -> GoldenTest ByteString
goldenLazyByteStringFile FilePath
fp IO ByteString
produceBS =
  GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
    { goldenTestRead :: IO (Maybe ByteString)
goldenTestRead = do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LB.fromStrict (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile,
      goldenTestProduce :: IO ByteString
goldenTestProduce = IO ByteString
produceBS,
      goldenTestWrite :: ByteString -> IO ()
goldenTestWrite = \ByteString
actual -> do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> IO ()) -> Path Abs Dir -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
resolvedFile
        FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile) (ByteString -> ByteString
LB.toStrict ByteString
actual),
      goldenTestCompare :: ByteString -> ByteString -> Maybe Assertion
goldenTestCompare = \ByteString
actual ByteString
expected ->
        let actualBS :: ByteString
actualBS = ByteString -> ByteString
LB.toStrict ByteString
actual
            expectedBS :: ByteString
expectedBS = ByteString -> ByteString
LB.toStrict ByteString
expected
         in if ByteString
actualBS ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expectedBS
              then Maybe Assertion
forall a. Maybe a
Nothing
              else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion) -> Assertion -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Assertion -> FilePath -> Assertion
Context (ByteString -> ByteString -> Assertion
bytestringsNotEqualButShouldHaveBeenEqual ByteString
actualBS ByteString
expectedBS) (FilePath -> FilePath
goldenContext FilePath
fp)
    }

-- | Test that the given lazy bytestring is the same as what we find in the given golden file.
--
-- Note: This converts the builder to a strict bytestring first.
pureGoldenByteStringBuilderFile :: FilePath -> SBB.Builder -> GoldenTest SBB.Builder
pureGoldenByteStringBuilderFile :: FilePath -> Builder -> GoldenTest Builder
pureGoldenByteStringBuilderFile FilePath
fp Builder
bs = FilePath -> IO Builder -> GoldenTest Builder
goldenByteStringBuilderFile FilePath
fp (Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
bs)

-- | Test that the produced bytestring is the same as what we find in the given golden file.
--
-- Note: This converts the builder to a strict bytestring first.
goldenByteStringBuilderFile :: FilePath -> IO SBB.Builder -> GoldenTest SBB.Builder
goldenByteStringBuilderFile :: FilePath -> IO Builder -> GoldenTest Builder
goldenByteStringBuilderFile FilePath
fp IO Builder
produceBS =
  GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
    { goldenTestRead :: IO (Maybe Builder)
goldenTestRead = do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        IO Builder -> IO (Maybe Builder)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO Builder -> IO (Maybe Builder))
-> IO Builder -> IO (Maybe Builder)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder) -> IO ByteString -> IO Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
SBB.byteString (IO ByteString -> IO Builder) -> IO ByteString -> IO Builder
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile,
      goldenTestProduce :: IO Builder
goldenTestProduce = IO Builder
produceBS,
      goldenTestWrite :: Builder -> IO ()
goldenTestWrite = \Builder
actual -> do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> IO ()) -> Path Abs Dir -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
resolvedFile
        FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile) (ByteString -> ByteString
LB.toStrict (Builder -> ByteString
SBB.toLazyByteString Builder
actual)),
      goldenTestCompare :: Builder -> Builder -> Maybe Assertion
goldenTestCompare = \Builder
actual Builder
expected ->
        let actualBS :: ByteString
actualBS = ByteString -> ByteString
LB.toStrict (Builder -> ByteString
SBB.toLazyByteString Builder
actual)
            expectedBS :: ByteString
expectedBS = ByteString -> ByteString
LB.toStrict (Builder -> ByteString
SBB.toLazyByteString Builder
expected)
         in if ByteString
actualBS ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expectedBS
              then Maybe Assertion
forall a. Maybe a
Nothing
              else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion) -> Assertion -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Assertion -> FilePath -> Assertion
Context (ByteString -> ByteString -> Assertion
bytestringsNotEqualButShouldHaveBeenEqual ByteString
actualBS ByteString
expectedBS) (FilePath -> FilePath
goldenContext FilePath
fp)
    }

-- | Test that the given text is the same as what we find in the given golden file.
pureGoldenTextFile :: FilePath -> Text -> GoldenTest Text
pureGoldenTextFile :: FilePath -> Text -> GoldenTest Text
pureGoldenTextFile FilePath
fp Text
bs = FilePath -> IO Text -> GoldenTest Text
goldenTextFile FilePath
fp (Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
bs)

-- | Test that the produced text is the same as what we find in the given golden file.
goldenTextFile :: FilePath -> IO Text -> GoldenTest Text
goldenTextFile :: FilePath -> IO Text -> GoldenTest Text
goldenTextFile FilePath
fp IO Text
produceBS =
  GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
    { goldenTestRead :: IO (Maybe Text)
goldenTestRead = do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        IO Text -> IO (Maybe Text)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
SB.readFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile),
      goldenTestProduce :: IO Text
goldenTestProduce = IO Text
produceBS,
      goldenTestWrite :: Text -> IO ()
goldenTestWrite = \Text
actual -> do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> IO ()) -> Path Abs Dir -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
resolvedFile
        FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile) (Text -> ByteString
TE.encodeUtf8 Text
actual),
      goldenTestCompare :: Text -> Text -> Maybe Assertion
goldenTestCompare = \Text
actual Text
expected ->
        if Text
actual Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected
          then Maybe Assertion
forall a. Maybe a
Nothing
          else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion) -> Assertion -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Assertion -> FilePath -> Assertion
Context (Text -> Text -> Assertion
textsNotEqualButShouldHaveBeenEqual Text
actual Text
expected) (FilePath -> FilePath
goldenContext FilePath
fp)
    }

-- | Test that the given string is the same as what we find in the given golden file.
pureGoldenStringFile :: FilePath -> String -> GoldenTest String
pureGoldenStringFile :: FilePath -> FilePath -> GoldenTest FilePath
pureGoldenStringFile FilePath
fp FilePath
bs = FilePath -> IO FilePath -> GoldenTest FilePath
goldenStringFile FilePath
fp (FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
bs)

-- | Test that the produced string is the same as what we find in the given golden file.
goldenStringFile :: FilePath -> IO String -> GoldenTest String
goldenStringFile :: FilePath -> IO FilePath -> GoldenTest FilePath
goldenStringFile FilePath
fp IO FilePath
produceBS =
  GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
    { goldenTestRead :: IO (Maybe FilePath)
goldenTestRead = do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath) -> IO Text -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack (IO Text -> IO FilePath) -> IO Text -> IO FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
SB.readFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile),
      goldenTestProduce :: IO FilePath
goldenTestProduce = IO FilePath
produceBS,
      goldenTestWrite :: FilePath -> IO ()
goldenTestWrite = \FilePath
actual -> do
        Path Abs File
resolvedFile <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
        Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> IO ()) -> Path Abs Dir -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
resolvedFile
        FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
resolvedFile) (Text -> ByteString
TE.encodeUtf8 (FilePath -> Text
T.pack FilePath
actual)),
      goldenTestCompare :: FilePath -> FilePath -> Maybe Assertion
goldenTestCompare = \FilePath
actual FilePath
expected ->
        if FilePath
actual FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
expected
          then Maybe Assertion
forall a. Maybe a
Nothing
          else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion) -> Assertion -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Assertion -> FilePath -> Assertion
Context (FilePath -> FilePath -> Assertion
stringsNotEqualButShouldHaveBeenEqual FilePath
actual FilePath
expected) (FilePath -> FilePath
goldenContext FilePath
fp)
    }

-- | Test that the show instance has not changed for the given value.
goldenShowInstance :: Show a => FilePath -> a -> GoldenTest String
goldenShowInstance :: FilePath -> a -> GoldenTest FilePath
goldenShowInstance FilePath
fp a
a = FilePath -> FilePath -> GoldenTest FilePath
pureGoldenStringFile FilePath
fp (a -> FilePath
forall a. Show a => a -> FilePath
show a
a)

-- | Test that the show instance has not changed for the given value, via `ppShow`.
goldenPrettyShowInstance :: Show a => FilePath -> a -> GoldenTest String
goldenPrettyShowInstance :: FilePath -> a -> GoldenTest FilePath
goldenPrettyShowInstance FilePath
fp a
a = FilePath -> FilePath -> GoldenTest FilePath
pureGoldenStringFile FilePath
fp (a -> FilePath
forall a. Show a => a -> FilePath
ppShow a
a)

-- | The golden test context for adding context to a golden test assertion:
--
-- > goldenTestCompare = \actual expected ->
-- >   if actual == expected
-- >     then Nothing
-- >     else Just $ Context (stringsNotEqualButShouldHaveBeenEqual actual expected) (goldenContext fp)
goldenContext :: FilePath -> String
goldenContext :: FilePath -> FilePath
goldenContext FilePath
fp = FilePath
"The golden results are in: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp