{-# LANGUAGE RankNTypes, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Test.Tasty.Silver.Advanced
(
goldenTest1,
goldenTestIO,
goldenTestIO1,
goldenTest,
GShow (..),
GDiff (..),
readFileMaybe
)
where
#if !(MIN_VERSION_base(4,8,0))
import Data.Functor ( (<$>) )
#endif
import Test.Tasty.Providers
import Test.Tasty.Silver.Internal
import qualified Data.Text as T
goldenTest
:: TestName
-> (IO a)
-> (IO a)
-> (a -> a -> IO (Maybe String))
-> (a -> IO ())
-> TestTree
goldenTest :: forall a.
TestName
-> IO a
-> IO a
-> (a -> a -> IO (Maybe TestName))
-> (a -> IO ())
-> TestTree
goldenTest TestName
t IO a
golden IO a
test a -> a -> IO (Maybe TestName)
cmp a -> IO ()
upd = TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
goldenTestIO TestName
t (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
golden) IO a
test a -> a -> IO GDiff
runCmp a -> IO GShow
forall {m :: * -> *} {p}. Monad m => p -> m GShow
shw a -> IO ()
upd
where
runCmp :: a -> a -> IO GDiff
runCmp a
a a
b = do
Maybe TestName
cmp' <- a -> a -> IO (Maybe TestName)
cmp a
a a
b
case Maybe TestName
cmp' of
Just TestName
d -> GDiff -> IO GDiff
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GDiff -> IO GDiff) -> GDiff -> IO GDiff
forall a b. (a -> b) -> a -> b
$ Maybe TestName -> Text -> GDiff
ShowDiffed Maybe TestName
forall a. Maybe a
Nothing (TestName -> Text
T.pack TestName
d)
Maybe TestName
Nothing -> GDiff -> IO GDiff
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GDiff
Equal
shw :: p -> m GShow
shw p
_ = GShow -> m GShow
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GShow -> m GShow) -> GShow -> m GShow
forall a b. (a -> b) -> a -> b
$ Text -> GShow
ShowText Text
"Old API does not support showing the actual value. Use the --accept mode or use the new API."
goldenTest1
:: TestName
-> (IO (Maybe a))
-> (IO a)
-> (a -> a -> GDiff)
-> (a -> GShow)
-> (a -> IO ())
-> TestTree
goldenTest1 :: forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> GDiff)
-> (a -> GShow)
-> (a -> IO ())
-> TestTree
goldenTest1 TestName
t IO (Maybe a)
golden IO a
test a -> a -> GDiff
diff a -> GShow
shw a -> IO ()
upd = TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
goldenTestIO TestName
t IO (Maybe a)
golden IO a
test (\a
a a
b -> GDiff -> IO GDiff
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GDiff -> IO GDiff) -> GDiff -> IO GDiff
forall a b. (a -> b) -> a -> b
$ a -> a -> GDiff
diff a
a a
b) (GShow -> IO GShow
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GShow -> IO GShow) -> (a -> GShow) -> a -> IO GShow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GShow
shw) a -> IO ()
upd
goldenTestIO
:: TestName
-> (IO (Maybe a))
-> (IO a)
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
goldenTestIO :: forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (a -> IO ())
-> TestTree
goldenTestIO TestName
t IO (Maybe a)
golden IO a
test a -> a -> IO GDiff
diff a -> IO GShow
shw a -> IO ()
upd = TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> Maybe (a -> IO ())
-> TestTree
forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> Maybe (a -> IO ())
-> TestTree
goldenTestIO1 TestName
t IO (Maybe a)
golden IO a
test a -> a -> IO GDiff
diff a -> IO GShow
shw ((a -> IO ()) -> Maybe (a -> IO ())
forall a. a -> Maybe a
Just a -> IO ()
upd)
goldenTestIO1
:: TestName
-> (IO (Maybe a))
-> (IO a)
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> (Maybe (a -> IO ()))
-> TestTree
goldenTestIO1 :: forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> Maybe (a -> IO ())
-> TestTree
goldenTestIO1 TestName
t IO (Maybe a)
golden IO a
test a -> a -> IO GDiff
diff a -> IO GShow
shw Maybe (a -> IO ())
upd = TestName -> Golden -> TestTree
forall t. IsTest t => TestName -> t -> TestTree
singleTest TestName
t (Golden -> TestTree) -> Golden -> TestTree
forall a b. (a -> b) -> a -> b
$ IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> Maybe (a -> IO ())
-> Golden
forall a.
IO (Maybe a)
-> IO a
-> (a -> a -> IO GDiff)
-> (a -> IO GShow)
-> Maybe (a -> IO ())
-> Golden
Golden IO (Maybe a)
golden IO a
test a -> a -> IO GDiff
diff a -> IO GShow
shw Maybe (a -> IO ())
upd