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 System.IO (
  BufferMode (LineBuffering),
  hSetBuffering,
  hSetEncoding,
  stdout,
  utf8,
 )
import Test.Cardano.Ledger.Binary.TreeDiff (
  ToExpr (..),
  ansiDocToString,
  ansiExpr,
  ansiExprString,
  assertColorFailure,
  diffExpr,
  diffExprCompact,
  diffExprCompactString,
  diffExprString,
  expectExprEqualWithMessage,
  showExpr,
 )
import Test.HUnit.Base (assertBool, assertFailure)
import Test.Hspec as X
import Test.Hspec.QuickCheck as X
import Test.Hspec.Runner
import Test.QuickCheck as X
import UnliftIO.Exception (evaluateDeep)

infix 1 `shouldBeExpr`
        , `shouldBeRight`
        , `shouldBeRightExpr`
        , `shouldBeLeft`
        , `shouldBeLeftExpr`

ledgerHspecConfig :: Config
ledgerHspecConfig :: Config
ledgerHspecConfig =
  Config
defaultConfig
    { configTimes :: Bool
configTimes = Bool
True
    , configColorMode :: ColorMode
configColorMode = ColorMode
ColorAlways
    }

ledgerTestMainWith :: Config -> Spec -> IO ()
ledgerTestMainWith :: Config -> Spec -> IO ()
ledgerTestMainWith Config
conf Spec
spec = do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
utf8
  Config -> Spec -> IO ()
hspecWith Config
conf Spec
spec

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
""

-- | Return value on the `Right` and fail otherwise
expectRight :: (HasCallStack, Show a) => Either a b -> IO b
expectRight :: forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight (Right b
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! b
r
expectRight (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. Show a => a -> String
show a
l

-- | Same as `expectRight`, but also evaluate the returned value to NF
expectRightDeep :: (HasCallStack, Show a, NFData b) => Either a b -> IO b
expectRightDeep :: forall a b. (HasCallStack, Show a, NFData b) => Either a b -> IO b
expectRightDeep = forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight 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 `expectRightDeep`, but discards the result
expectRightDeep_ :: (HasCallStack, Show a, NFData b) => Either a b -> IO ()
expectRightDeep_ :: forall a b. (HasCallStack, Show a, NFData b) => Either a b -> IO ()
expectRightDeep_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasCallStack, Show a, NFData b) => Either a b -> IO b
expectRightDeep

-- | 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 `shouldBe`, except it checks that the value is `Right`
shouldBeRight :: (HasCallStack, Show a, Show b, Eq b) => Either a b -> b -> Expectation
shouldBeRight :: forall a b.
(HasCallStack, Show a, Show b, Eq b) =>
Either a b -> b -> IO ()
shouldBeRight Either a b
e b
x = forall a b. (HasCallStack, Show a) => Either a b -> IO b
expectRight Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` b
x)

-- | 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)

-- | Return value on the `Left` an fail otherwise
expectLeft :: (HasCallStack, Show b) => Either a b -> IO a
expectLeft :: forall b a. (HasCallStack, Show b) => Either a b -> IO a
expectLeft (Left a
l) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a
l
expectLeft (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. Show a => a -> String
show b
r

-- | Same as `expectLeft`, but also evaluate the returned value to NF
expectLeftDeep :: (HasCallStack, NFData a, Show b) => Either a b -> IO a
expectLeftDeep :: forall a b. (HasCallStack, NFData a, Show b) => Either a b -> IO a
expectLeftDeep = forall b a. (HasCallStack, Show b) => Either a b -> IO a
expectLeft 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 `expectLeftDeep`, but discards the result
expectLeftDeep_ :: (HasCallStack, NFData a, Show b) => Either a b -> IO ()
expectLeftDeep_ :: forall a b. (HasCallStack, NFData a, Show b) => Either a b -> IO ()
expectLeftDeep_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasCallStack, NFData a, Show b) => Either a b -> IO a
expectLeftDeep

-- | 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 `shouldBe`, except it checks that the value is `Left`
shouldBeLeft :: (HasCallStack, Show a, Eq a, Show b) => Either a b -> a -> Expectation
shouldBeLeft :: forall a b.
(HasCallStack, Show a, Eq a, Show b) =>
Either a b -> a -> IO ()
shouldBeLeft Either a b
e a
x = forall b a. (HasCallStack, Show b) => Either a b -> IO a
expectLeft Either a b
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
x)

-- | 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 :: [Char] -> 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