module Test.Cardano.Ledger.Common (
  module X,
  ledgerTestMain,
  ledgerTestMainWith,
  ledgerHspecConfig,
  NFData,

  -- * Expr
  ToExpr (..),
  showExpr,
  ansiExpr,
  ansiExprString,
  diffExpr,
  diffExprString,
  diffExprCompact,
  diffExprCompactString,
  ansiDocToString,

  -- * Expectations
  assertBool,
  assertFailure,
  assertColorFailure,

  -- ** Non-standard expectations
  shouldBeExpr,
  shouldBeRight,
  shouldBeLeft,
  shouldBeRightExpr,
  shouldBeLeftExpr,
  expectRight,
  expectRightDeep,
  expectRightDeep_,
  expectRightExpr,
  expectRightDeepExpr,
  expectLeft,
  expectLeftExpr,
  expectLeftDeep,
  expectLeftDeep_,
  expectLeftDeepExpr,

  -- * Miscellanous helpers
  tracedDiscard,
)
where

import Control.DeepSeq (NFData)
import Control.Monad as X (forM_, replicateM, replicateM_, unless, void, when, (>=>))
import qualified Debug.Trace as Debug
import Test.Cardano.Ledger.Binary.TreeDiff (
  ToExpr (..),
  ansiExpr,
  ansiExprString,
  diffExpr,
  diffExprCompact,
  diffExprCompactString,
  diffExprString,
  expectExprEqualWithMessage,
  showExpr,
 )
import Test.Hspec as X
import Test.Hspec.QuickCheck as X
import Test.Hspec.Runner
import Test.ImpSpec (ansiDocToString, impSpecConfig, impSpecMainWithConfig)
import Test.ImpSpec.Expectations
import Test.QuickCheck as X
import UnliftIO.Exception (evaluateDeep)

infix 1 `shouldBeExpr`
        , `shouldBeRightExpr`
        , `shouldBeLeftExpr`

ledgerHspecConfig :: Config
ledgerHspecConfig :: Config
ledgerHspecConfig = Config
impSpecConfig

ledgerTestMainWith :: Config -> Spec -> IO ()
ledgerTestMainWith :: Config -> Spec -> IO ()
ledgerTestMainWith = Config -> Spec -> IO ()
impSpecMainWithConfig

ledgerTestMain :: Spec -> IO ()
ledgerTestMain :: Spec -> IO ()
ledgerTestMain = Config -> Spec -> IO ()
ledgerTestMainWith Config
ledgerHspecConfig

shouldBeExpr :: (HasCallStack, ToExpr a, Eq a) => a -> a -> IO ()
shouldBeExpr :: forall a. (HasCallStack, ToExpr a, Eq a) => a -> a -> IO ()
shouldBeExpr = forall a.
(ToExpr a, Eq a, HasCallStack) =>
String -> a -> a -> IO ()
expectExprEqualWithMessage String
""

-- | Same as `expectRight`, but use `ToExpr` instead of `Show`
expectRightExpr :: (HasCallStack, ToExpr a) => Either a b -> IO b
expectRightExpr :: forall a b. (HasCallStack, ToExpr a) => Either a b -> IO b
expectRightExpr (Right b
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! b
r
expectRightExpr (Left a
l) = forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Right, got Left:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
l

-- | Same as `expectRightDeep`,  but use `ToExpr` instead of `Show`
expectRightDeepExpr :: (HasCallStack, ToExpr a, NFData b) => Either a b -> IO b
expectRightDeepExpr :: forall a b.
(HasCallStack, ToExpr a, NFData b) =>
Either a b -> IO b
expectRightDeepExpr = forall a b. (HasCallStack, ToExpr a) => Either a b -> IO b
expectRightExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep

-- | Same as `shouldBeExpr`, except it checks that the value is `Right`
shouldBeRightExpr :: (HasCallStack, ToExpr a, Eq b, ToExpr b) => Either a b -> b -> Expectation
shouldBeRightExpr :: forall a b.
(HasCallStack, ToExpr a, Eq b, ToExpr b) =>
Either a b -> b -> IO ()
shouldBeRightExpr Either a b
e b
x = forall a b. (HasCallStack, ToExpr a) => Either a b -> IO b
expectRightExpr Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, ToExpr a, Eq a) => a -> a -> IO ()
`shouldBeExpr` b
x)

-- | Same as `expectLeft`, but use `ToExpr` instead of `Show`
expectLeftExpr :: (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr :: forall b a. (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr (Left a
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a
l
expectLeftExpr (Right b
r) = forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"Expected Left, got Right:\n" forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr b
r

-- | Same as `expectLeftDeep`,  but use `ToExpr` instead of `Show`
expectLeftDeepExpr :: (HasCallStack, ToExpr b, NFData a) => Either a b -> IO a
expectLeftDeepExpr :: forall b a.
(HasCallStack, ToExpr b, NFData a) =>
Either a b -> IO a
expectLeftDeepExpr = forall b a. (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep

-- | Same as `shouldBeExpr`, except it checks that the value is `Left`
shouldBeLeftExpr :: (HasCallStack, ToExpr a, ToExpr b, Eq a) => Either a b -> a -> Expectation
shouldBeLeftExpr :: forall a b.
(HasCallStack, ToExpr a, ToExpr b, Eq a) =>
Either a b -> a -> IO ()
shouldBeLeftExpr Either a b
e a
x = forall b a. (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, ToExpr a, Eq a) => a -> a -> IO ()
`shouldBeExpr` a
x)

-- | Same as `Test.QuickCheck.discard` but outputs a debug trace message
tracedDiscard :: String -> a
tracedDiscard :: forall a. String -> a
tracedDiscard String
message = (if Bool
False then forall a. String -> a -> a
Debug.trace forall a b. (a -> b) -> a -> b
$ String
"\nDiscarded trace: " forall a. [a] -> [a] -> [a]
++ String
message else forall a. a -> a
id) forall a. a
discard