{-# 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
ghcVersion :: String
ghcVersion :: FilePath
ghcVersion = Version -> FilePath
showVersion Version
compilerVersion
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
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 :: 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, ())
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))
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 ()
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
testNestedNamedM
:: FilePath
-> String
-> 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
testNestedM :: FilePath -> TestNested -> TestNested
testNestedM :: FilePath -> TestNested -> TestNested
testNestedM FilePath
folderName = FilePath -> FilePath -> TestNested -> TestNested
testNestedNamedM FilePath
folderName FilePath
folderName
testNestedGhcM :: TestNested -> TestNested
testNestedGhcM :: TestNested -> TestNested
testNestedGhcM = FilePath -> TestNested -> TestNested
testNestedM FilePath
ghcVersion
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
testNestedNamed
:: FilePath
-> String
-> [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
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
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
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
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
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
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
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
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
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
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