{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module Test.Tasty.Extras
    ( Layer (..)
    , embed
    , nestWith
    , TestNestedM (..)
    , TestNested
    , runTestNestedM
    , testNestedNamedM
    , testNestedM
    , testNestedGhcM
    , runTestNested
    , testNestedNamed
    , testNested
    , testNestedGhc
    , goldenVsText
    , goldenVsTextM
    , goldenVsDoc
    , goldenVsDocM
    , nestedGoldenVsText
    , nestedGoldenVsTextM
    , nestedGoldenVsDoc
    , nestedGoldenVsDocM
    , makeVersionedFilePath
    ) where

import PlutusPrelude hiding (toList)

import Control.Monad.Free.Church (F (runF), MonadFree, liftF)
import Control.Monad.Reader
import Data.ByteString.Lazy qualified as BSL
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Version
import GHC.Exts
import System.FilePath (joinPath, (</>))
import System.Info
import Test.Tasty
import Test.Tasty.Golden

-- | We use the GHC version number to create directories with names like `9.2`
-- and `9.6` containing golden files whose contents depend on the GHC version.
-- For consistency all such directories should be leaves in the directory
-- hierarchy: for example, it is preferable to have golden files in
-- "semantics/9.2/" instead of "9.2/semantics/".
ghcVersion :: String
ghcVersion :: FilePath
ghcVersion = Version -> FilePath
showVersion Version
compilerVersion

{- Note [OS-independent paths].  Some of the functions here take arguments of the
   form [FilePath].  The intention is that the members of the list should be
   simple directory names containing no OS-dependent separators (eg ["dir",
   "subdir"], but not ["dir/subdir"]).  The components of the path will be
   concatenated with appropriate separators by means of `joinPath`.
-}

-- | Given a lists of FilePaths and a filename, concatenate the members of the
-- list together, append the GHC version number, then append the filename.  We
-- use this to create GHC-version-dependent golden files.
makeVersionedFilePath :: [FilePath] -> FilePath -> FilePath
makeVersionedFilePath :: [FilePath] -> FilePath -> FilePath
makeVersionedFilePath [FilePath]
path FilePath
file = [FilePath] -> FilePath
joinPath [FilePath]
path FilePath -> FilePath -> FilePath
</> FilePath
ghcVersion FilePath -> FilePath -> FilePath
</> FilePath
file

{- | A monad allowing one to emit elements of type @a@. Semantically equivalent to
@Writer (DList a) r@, but:

1. is faster, being based on the Church-encoded free monad
2. implements 'Monoid', so that all the "Data.Foldable" convenience is supported
3. has better ergonomics as it doesn't require the user to wrap @a@ values into 'DList's

This type is also semantically equivalent to @Stream (Of a) Identity r@.

Useful for monadically creating tree-like structures, for example the following

> import Data.Tree
> yield = embed . pure
> main = putStrLn . drawTree . Node "a" . toList $ do
>     yield "b"
>     nestWith (Node "c") $ do
>         yield "d"
>         yield "e"
>     yield "f"

will produce

> -a
> |
> +- b
> |
> +- c
> |  |
> |  +- d
> |  |
> |  `- e
> |
> `- f
-}
newtype Layer a r = Layer
    { forall a r. Layer a r -> F ((,) a) r
unLayer :: F ((,) a) r
    } deriving newtype ((forall a b. (a -> b) -> Layer a a -> Layer a b)
-> (forall a b. a -> Layer a b -> Layer a a) -> Functor (Layer a)
forall a b. a -> Layer a b -> Layer a a
forall a b. (a -> b) -> Layer a a -> Layer a b
forall a a b. a -> Layer a b -> Layer a a
forall a a b. (a -> b) -> Layer a a -> Layer a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> Layer a a -> Layer a b
fmap :: forall a b. (a -> b) -> Layer a a -> Layer a b
$c<$ :: forall a a b. a -> Layer a b -> Layer a a
<$ :: forall a b. a -> Layer a b -> Layer a a
Functor, Functor (Layer a)
Functor (Layer a) =>
(forall a. a -> Layer a a)
-> (forall a b. Layer a (a -> b) -> Layer a a -> Layer a b)
-> (forall a b c.
    (a -> b -> c) -> Layer a a -> Layer a b -> Layer a c)
-> (forall a b. Layer a a -> Layer a b -> Layer a b)
-> (forall a b. Layer a a -> Layer a b -> Layer a a)
-> Applicative (Layer a)
forall a. Functor (Layer a)
forall a. a -> Layer a a
forall a a. a -> Layer a a
forall a b. Layer a a -> Layer a b -> Layer a a
forall a b. Layer a a -> Layer a b -> Layer a b
forall a b. Layer a (a -> b) -> Layer a a -> Layer a b
forall a a b. Layer a a -> Layer a b -> Layer a a
forall a a b. Layer a a -> Layer a b -> Layer a b
forall a a b. Layer a (a -> b) -> Layer a a -> Layer a b
forall a b c. (a -> b -> c) -> Layer a a -> Layer a b -> Layer a c
forall a a b c.
(a -> b -> c) -> Layer a a -> Layer a b -> Layer a c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a a. a -> Layer a a
pure :: forall a. a -> Layer a a
$c<*> :: forall a a b. Layer a (a -> b) -> Layer a a -> Layer a b
<*> :: forall a b. Layer a (a -> b) -> Layer a a -> Layer a b
$cliftA2 :: forall a a b c.
(a -> b -> c) -> Layer a a -> Layer a b -> Layer a c
liftA2 :: forall a b c. (a -> b -> c) -> Layer a a -> Layer a b -> Layer a c
$c*> :: forall a a b. Layer a a -> Layer a b -> Layer a b
*> :: forall a b. Layer a a -> Layer a b -> Layer a b
$c<* :: forall a a b. Layer a a -> Layer a b -> Layer a a
<* :: forall a b. Layer a a -> Layer a b -> Layer a a
Applicative, Applicative (Layer a)
Applicative (Layer a) =>
(forall a b. Layer a a -> (a -> Layer a b) -> Layer a b)
-> (forall a b. Layer a a -> Layer a b -> Layer a b)
-> (forall a. a -> Layer a a)
-> Monad (Layer a)
forall a. Applicative (Layer a)
forall a. a -> Layer a a
forall a a. a -> Layer a a
forall a b. Layer a a -> Layer a b -> Layer a b
forall a b. Layer a a -> (a -> Layer a b) -> Layer a b
forall a a b. Layer a a -> Layer a b -> Layer a b
forall a a b. Layer a a -> (a -> Layer a b) -> Layer a b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a a b. Layer a a -> (a -> Layer a b) -> Layer a b
>>= :: forall a b. Layer a a -> (a -> Layer a b) -> Layer a b
$c>> :: forall a a b. Layer a a -> Layer a b -> Layer a b
>> :: forall a b. Layer a a -> Layer a b -> Layer a b
$creturn :: forall a a. a -> Layer a a
return :: forall a. a -> Layer a a
Monad, MonadFree ((,) a))

instance unit ~ () => Semigroup (Layer a unit) where
    <> :: Layer a unit -> Layer a unit -> Layer a unit
(<>) = Layer a unit -> Layer a unit -> Layer a unit
forall a b. Layer a a -> Layer a b -> Layer a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance unit ~ () => Monoid (Layer a unit) where
    mempty :: Layer a unit
mempty = unit -> Layer a unit
forall a. a -> Layer a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance unit ~ () => IsList (Layer a unit) where
    type Item (Layer a unit) = a
    fromList :: [Item (Layer a unit)] -> Layer a unit
fromList = (a -> Layer a ()) -> [a] -> Layer a ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ a -> Layer a ()
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed
    toList :: Layer a unit -> [Item (Layer a unit)]
toList Layer a unit
layer = F ((,) a) unit -> forall r. (unit -> r) -> ((a, r) -> r) -> r
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (Layer a unit -> F ((,) a) unit
forall a r. Layer a r -> F ((,) a) r
unLayer Layer a unit
layer) unit -> [Item (Layer a unit)]
() -> [a]
forall a. Monoid a => a
mempty (((a, [Item (Layer a unit)]) -> [Item (Layer a unit)])
 -> [Item (Layer a unit)])
-> ((a, [Item (Layer a unit)]) -> [Item (Layer a unit)])
-> [Item (Layer a unit)]
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)

-- | Embed the given value into a 'Layer'-like type (either 'Layer' itself or a monad transformer
-- stack with 'Layer' at the bottom).
embed :: MonadFree ((,) a) m => a -> m ()
embed :: forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed a
x = (a, ()) -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (a
x, ())

-- | Collapse the given 'Layer' into a single element by converting it into a list, applying the
-- given function to the result and 'embed'ding it back.
nestWith :: ([a] -> a) -> Layer a () -> Layer a ()
nestWith :: forall a. ([a] -> a) -> Layer a () -> Layer a ()
nestWith [a] -> a
f = a -> Layer a ()
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (a -> Layer a ()) -> (Layer a () -> a) -> Layer a () -> Layer a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
f ([a] -> a) -> (Layer a () -> [a]) -> Layer a () -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layer a () -> [a]
Layer a () -> [Item (Layer a ())]
forall l. IsList l => l -> [Item l]
toList

newtype TestNestedM r = TestNestedM
    { forall r. TestNestedM r -> ReaderT [FilePath] (Layer TestTree) r
unTestNestedM :: ReaderT [FilePath] (Layer TestTree) r
    } deriving newtype
        ((forall a b. (a -> b) -> TestNestedM a -> TestNestedM b)
-> (forall a b. a -> TestNestedM b -> TestNestedM a)
-> Functor TestNestedM
forall a b. a -> TestNestedM b -> TestNestedM a
forall a b. (a -> b) -> TestNestedM a -> TestNestedM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TestNestedM a -> TestNestedM b
fmap :: forall a b. (a -> b) -> TestNestedM a -> TestNestedM b
$c<$ :: forall a b. a -> TestNestedM b -> TestNestedM a
<$ :: forall a b. a -> TestNestedM b -> TestNestedM a
Functor, Functor TestNestedM
Functor TestNestedM =>
(forall a. a -> TestNestedM a)
-> (forall a b.
    TestNestedM (a -> b) -> TestNestedM a -> TestNestedM b)
-> (forall a b c.
    (a -> b -> c) -> TestNestedM a -> TestNestedM b -> TestNestedM c)
-> (forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b)
-> (forall a b. TestNestedM a -> TestNestedM b -> TestNestedM a)
-> Applicative TestNestedM
forall a. a -> TestNestedM a
forall a b. TestNestedM a -> TestNestedM b -> TestNestedM a
forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
forall a b. TestNestedM (a -> b) -> TestNestedM a -> TestNestedM b
forall a b c.
(a -> b -> c) -> TestNestedM a -> TestNestedM b -> TestNestedM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> TestNestedM a
pure :: forall a. a -> TestNestedM a
$c<*> :: forall a b. TestNestedM (a -> b) -> TestNestedM a -> TestNestedM b
<*> :: forall a b. TestNestedM (a -> b) -> TestNestedM a -> TestNestedM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> TestNestedM a -> TestNestedM b -> TestNestedM c
liftA2 :: forall a b c.
(a -> b -> c) -> TestNestedM a -> TestNestedM b -> TestNestedM c
$c*> :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
*> :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
$c<* :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM a
<* :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM a
Applicative, Applicative TestNestedM
Applicative TestNestedM =>
(forall a b.
 TestNestedM a -> (a -> TestNestedM b) -> TestNestedM b)
-> (forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b)
-> (forall a. a -> TestNestedM a)
-> Monad TestNestedM
forall a. a -> TestNestedM a
forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
forall a b. TestNestedM a -> (a -> TestNestedM b) -> TestNestedM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. TestNestedM a -> (a -> TestNestedM b) -> TestNestedM b
>>= :: forall a b. TestNestedM a -> (a -> TestNestedM b) -> TestNestedM b
$c>> :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
>> :: forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
$creturn :: forall a. a -> TestNestedM a
return :: forall a. a -> TestNestedM a
Monad, MonadReader [FilePath], MonadFree ((,) TestTree))

-- | A 'TestTree' of tests under some name prefix.
type TestNested = TestNestedM ()

instance unit ~ () => Semigroup (TestNestedM unit) where
    <> :: TestNestedM unit -> TestNestedM unit -> TestNestedM unit
(<>) = TestNestedM unit -> TestNestedM unit -> TestNestedM unit
forall a b. TestNestedM a -> TestNestedM b -> TestNestedM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance unit ~ () => Monoid (TestNestedM unit) where
    mempty :: TestNestedM unit
mempty = unit -> TestNestedM unit
forall a. a -> TestNestedM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Run a 'TestNested' computation to produce a 'TestTree' (without actually executing the tests).
runTestNestedM :: [String] -> TestNested -> TestTree
runTestNestedM :: [FilePath] -> TestNested -> TestTree
runTestNestedM []   TestNested
_    = FilePath -> TestTree
forall a. HasCallStack => FilePath -> a
error FilePath
"Path cannot be empty"
runTestNestedM [FilePath]
path TestNested
test = FilePath -> [TestTree] -> TestTree
testGroup ([FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
last [FilePath]
path) ([TestTree] -> TestTree)
-> (Layer TestTree () -> [TestTree])
-> Layer TestTree ()
-> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layer TestTree () -> [Item (Layer TestTree ())]
Layer TestTree () -> [TestTree]
forall l. IsList l => l -> [Item l]
toList (Layer TestTree () -> TestTree) -> Layer TestTree () -> TestTree
forall a b. (a -> b) -> a -> b
$ ReaderT [FilePath] (Layer TestTree) ()
-> [FilePath] -> Layer TestTree ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (TestNested -> ReaderT [FilePath] (Layer TestTree) ()
forall r. TestNestedM r -> ReaderT [FilePath] (Layer TestTree) r
unTestNestedM TestNested
test) [FilePath]
path

-- | Descend into a folder.
testNestedNamedM
    :: FilePath  -- ^ The name of the folder.
    -> String    -- ^ The name of the test group to render in CLI.
    -> TestNested
    -> TestNested
testNestedNamedM :: FilePath -> FilePath -> TestNested -> TestNested
testNestedNamedM FilePath
folderName FilePath
testName
    = ReaderT [FilePath] (Layer TestTree) () -> TestNested
forall r. ReaderT [FilePath] (Layer TestTree) r -> TestNestedM r
TestNestedM
    (ReaderT [FilePath] (Layer TestTree) () -> TestNested)
-> (TestNested -> ReaderT [FilePath] (Layer TestTree) ())
-> TestNested
-> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> [FilePath])
-> ReaderT [FilePath] (Layer TestTree) ()
-> ReaderT [FilePath] (Layer TestTree) ()
forall a.
([FilePath] -> [FilePath])
-> ReaderT [FilePath] (Layer TestTree) a
-> ReaderT [FilePath] (Layer TestTree) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ([FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
folderName])
    (ReaderT [FilePath] (Layer TestTree) ()
 -> ReaderT [FilePath] (Layer TestTree) ())
-> (TestNested -> ReaderT [FilePath] (Layer TestTree) ())
-> TestNested
-> ReaderT [FilePath] (Layer TestTree) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Layer TestTree () -> Layer TestTree ())
-> ReaderT [FilePath] (Layer TestTree) ()
-> ReaderT [FilePath] (Layer TestTree) ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (([TestTree] -> TestTree) -> Layer TestTree () -> Layer TestTree ()
forall a. ([a] -> a) -> Layer a () -> Layer a ()
nestWith (([TestTree] -> TestTree)
 -> Layer TestTree () -> Layer TestTree ())
-> ([TestTree] -> TestTree)
-> Layer TestTree ()
-> Layer TestTree ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [TestTree] -> TestTree
testGroup FilePath
testName)
    (ReaderT [FilePath] (Layer TestTree) ()
 -> ReaderT [FilePath] (Layer TestTree) ())
-> (TestNested -> ReaderT [FilePath] (Layer TestTree) ())
-> TestNested
-> ReaderT [FilePath] (Layer TestTree) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestNested -> ReaderT [FilePath] (Layer TestTree) ()
forall r. TestNestedM r -> ReaderT [FilePath] (Layer TestTree) r
unTestNestedM

-- | Descend into a folder for a 'TestNested' computation.
testNestedM :: FilePath -> TestNested -> TestNested
testNestedM :: FilePath -> TestNested -> TestNested
testNestedM FilePath
folderName = FilePath -> FilePath -> TestNested -> TestNested
testNestedNamedM FilePath
folderName FilePath
folderName

-- | Like 'testNestedM' but adds a subdirectory corresponding to the GHC version being used.
testNestedGhcM :: TestNested -> TestNested
testNestedGhcM :: TestNested -> TestNested
testNestedGhcM = FilePath -> TestNested -> TestNested
testNestedM FilePath
ghcVersion

-- | Run a list of 'TestNested' computation to produce a 'TestTree' (without actually executing the
-- tests).
runTestNested :: [String] -> [TestNested] -> TestTree
runTestNested :: [FilePath] -> [TestNested] -> TestTree
runTestNested [FilePath]
path = [FilePath] -> TestNested -> TestTree
runTestNestedM [FilePath]
path (TestNested -> TestTree)
-> ([TestNested] -> TestNested) -> [TestNested] -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestNested] -> TestNested
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Descend into a folder for a list of tests.
testNestedNamed
    :: FilePath  -- ^ The name of the folder.
    -> String    -- ^ The name of the test group to render in CLI.
    -> [TestNested]
    -> TestNested
testNestedNamed :: FilePath -> FilePath -> [TestNested] -> TestNested
testNestedNamed FilePath
folderName FilePath
testName = FilePath -> FilePath -> TestNested -> TestNested
testNestedNamedM FilePath
folderName FilePath
testName (TestNested -> TestNested)
-> ([TestNested] -> TestNested) -> [TestNested] -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestNested] -> TestNested
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Descend into a folder for a list of 'TestNested' computations.
testNested :: FilePath -> [TestNested] -> TestNested
testNested :: FilePath -> [TestNested] -> TestNested
testNested FilePath
folderName = FilePath -> TestNested -> TestNested
testNestedM FilePath
folderName (TestNested -> TestNested)
-> ([TestNested] -> TestNested) -> [TestNested] -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestNested] -> TestNested
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Like 'testNested' but adds a subdirectory corresponding to the GHC version being used.
testNestedGhc :: [TestNested] -> TestNested
testNestedGhc :: [TestNested] -> TestNested
testNestedGhc = TestNested -> TestNested
testNestedGhcM (TestNested -> TestNested)
-> ([TestNested] -> TestNested) -> [TestNested] -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestNested] -> TestNested
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Check the contents of a file against a 'Text'.
goldenVsText :: TestName -> FilePath -> Text -> TestTree
goldenVsText :: FilePath -> FilePath -> Text -> TestTree
goldenVsText FilePath
name FilePath
ref = FilePath -> FilePath -> IO Text -> TestTree
goldenVsTextM FilePath
name FilePath
ref (IO Text -> TestTree) -> (Text -> IO Text) -> Text -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Check the contents of a file against a 'Text'.
goldenVsTextM :: TestName -> FilePath -> IO Text -> TestTree
goldenVsTextM :: FilePath -> FilePath -> IO Text -> TestTree
goldenVsTextM FilePath
name FilePath
ref IO Text
val =
    FilePath
-> (FilePath -> FilePath -> [FilePath])
-> FilePath
-> IO ByteString
-> TestTree
goldenVsStringDiff FilePath
name (\FilePath
expected FilePath
actual -> [FilePath
"diff", FilePath
"-u", FilePath
expected, FilePath
actual]) FilePath
ref (IO ByteString -> TestTree) -> IO ByteString -> TestTree
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> IO Text -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
val

-- | Check the contents of a file against a 'Doc'.
goldenVsDoc :: TestName -> FilePath -> Doc ann -> TestTree
goldenVsDoc :: forall ann. FilePath -> FilePath -> Doc ann -> TestTree
goldenVsDoc FilePath
name FilePath
ref = FilePath -> FilePath -> IO (Doc ann) -> TestTree
forall ann. FilePath -> FilePath -> IO (Doc ann) -> TestTree
goldenVsDocM FilePath
name FilePath
ref (IO (Doc ann) -> TestTree)
-> (Doc ann -> IO (Doc ann)) -> Doc ann -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> IO (Doc ann)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Check the contents of a file against a 'Doc'.
goldenVsDocM :: TestName -> FilePath -> IO (Doc ann) -> TestTree
goldenVsDocM :: forall ann. FilePath -> FilePath -> IO (Doc ann) -> TestTree
goldenVsDocM FilePath
name FilePath
ref IO (Doc ann)
val = FilePath -> FilePath -> IO Text -> TestTree
goldenVsTextM FilePath
name FilePath
ref (IO Text -> TestTree) -> IO Text -> TestTree
forall a b. (a -> b) -> a -> b
$ Doc ann -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Doc ann -> Text) -> IO (Doc ann) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Doc ann)
val

-- | Check the contents of a file under a name prefix against a 'Text'.
nestedGoldenVsText :: TestName -> FilePath -> Text -> TestNested
nestedGoldenVsText :: FilePath -> FilePath -> Text -> TestNested
nestedGoldenVsText FilePath
name FilePath
ext = FilePath -> FilePath -> IO Text -> TestNested
nestedGoldenVsTextM FilePath
name FilePath
ext (IO Text -> TestNested) -> (Text -> IO Text) -> Text -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Check the contents of a file under a name prefix against a 'Text'.
nestedGoldenVsTextM :: TestName -> FilePath -> IO Text -> TestNested
nestedGoldenVsTextM :: FilePath -> FilePath -> IO Text -> TestNested
nestedGoldenVsTextM FilePath
name FilePath
ext IO Text
text = do
    [FilePath]
path <- TestNestedM [FilePath]
forall r (m :: * -> *). MonadReader r m => m r
ask
    TestTree -> TestNested
forall a (m :: * -> *). MonadFree ((,) a) m => a -> m ()
embed (TestTree -> TestNested) -> TestTree -> TestNested
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO Text -> TestTree
goldenVsTextM FilePath
name ((FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(</>) (FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ext FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".golden") [FilePath]
path) IO Text
text

-- | Check the contents of a file under a name prefix against a 'Text'.
nestedGoldenVsDoc :: TestName -> FilePath -> Doc ann -> TestNested
nestedGoldenVsDoc :: forall ann. FilePath -> FilePath -> Doc ann -> TestNested
nestedGoldenVsDoc FilePath
name FilePath
ext = FilePath -> FilePath -> IO (Doc ann) -> TestNested
forall ann. FilePath -> FilePath -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM FilePath
name FilePath
ext (IO (Doc ann) -> TestNested)
-> (Doc ann -> IO (Doc ann)) -> Doc ann -> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> IO (Doc ann)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Check the contents of a file under a name prefix against a 'Text'.
nestedGoldenVsDocM :: TestName -> FilePath -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM :: forall ann. FilePath -> FilePath -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM FilePath
name FilePath
ext IO (Doc ann)
val = FilePath -> FilePath -> IO Text -> TestNested
nestedGoldenVsTextM FilePath
name FilePath
ext (IO Text -> TestNested) -> IO Text -> TestNested
forall a b. (a -> b) -> a -> b
$ Doc ann -> Text
forall ann. Doc ann -> Text
forall str ann. Render str => Doc ann -> str
render (Doc ann -> Text) -> IO (Doc ann) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Doc ann)
val