{-# LANGUAGE RankNTypes, OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Test.Tasty.Silver.Advanced
  ( -- * Constructing golden tests
    goldenTest1,

    goldenTestIO,
    goldenTestIO1,
    goldenTest,

    GShow (..),
    GDiff (..),

    -- * Reading files
    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

-- | A very general testing function. Use 'goldenTest1' instead if you can.
goldenTest
  :: TestName -- ^ test name
  -> (IO a) -- ^ get the golden correct value
  -> (IO a) -- ^ get the tested value
  -> (a -> a -> IO (Maybe String))
    -- ^ comparison function.
    --
    -- If two values are the same, it should return 'Nothing'. If they are
    -- different, it should return an error that will be printed to the user.
    -- First argument is the golden value.
    --
    -- The function may use 'IO', for example, to launch an external @diff@
    -- command.
  -> (a -> IO ()) -- ^ update the golden file
  -> 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  -- the diff should behave in a pure way, so let's just use unsafePerformIO
        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 (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 (m :: * -> *) a. Monad m => a -> m a
return GDiff
Equal
        shw :: p -> m GShow
shw p
_ = GShow -> m GShow
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."


-- | A very general testing function.
goldenTest1
  :: TestName -- ^ test name
  -> (IO (Maybe a)) -- ^ get the golden correct value
  -> (IO a) -- ^ get the tested value
  -> (a -> a -> GDiff)
    -- ^ comparison function.
    --
    -- If two values are the same, it should return 'Equal'. If they are
    -- different, it should return a diff representation.
    -- First argument is golden value.
  -> (a -> GShow) -- ^ Show the golden/actual value.
  -> (a -> IO ()) -- ^ update the golden file
  -> 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 (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 (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

-- | A very general testing function.
-- The IO version of show/diff are useful when using external diff or show mechanisms. If IO is not required,
-- the `goldenTest1` function should be used instead.
goldenTestIO
  :: TestName -- ^ test name
  -> (IO (Maybe a)) -- ^ get the golden correct value
  -> (IO a) -- ^ get the tested value
  -> (a -> a -> IO GDiff)
    -- ^ comparison function.
    --
    -- If two values are the same, it should return 'Equal'. If they are
    -- different, it should return a diff representation.
    -- First argument is golden value.
  -> (a -> IO GShow) -- ^ Show the golden/actual value.
  -> (a -> IO ()) -- ^ update the golden file
  -> 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)

-- | A very general testing function.
-- Experimental function, may change in later versions!
-- The IO version of show/diff are useful when using external diff or show mechanisms. If IO is not required,
-- the `goldenTest1` function should be used instead.
goldenTestIO1
  :: TestName -- ^ test name
  -> (IO (Maybe a)) -- ^ get the golden correct value
  -> (IO a) -- ^ get the tested value
  -> (a -> a -> IO GDiff)
    -- ^ comparison function.
    --
    -- If two values are the same, it should return 'Equal'. If they are
    -- different, it should return a diff representation.
    -- First argument is golden value.
  -> (a -> IO GShow) -- ^ Show the golden/actual value.
  -> (Maybe (a -> IO ())) -- ^ update the golden file
  -> 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