module Test.ImpSpec.Expectations.Lifted (
  -- * Lifted Expectations
  io,

  -- ** Common
  assertBool,
  assertFailure,
  expectationFailure,
  shouldBe,
  shouldSatisfy,
  shouldStartWith,
  shouldEndWith,
  shouldContain,
  shouldMatchList,
  shouldReturn,
  shouldNotBe,
  shouldNotSatisfy,
  shouldNotContain,
  shouldNotReturn,
  shouldThrow,
  IO.Selector,

  -- ** Custom
  assertColorFailure,

  -- *** Either
  shouldBeRight,
  shouldBeLeft,
  expectRight,
  expectRightDeep,
  expectRightDeep_,
  expectLeft,
  expectLeftDeep,
  expectLeftDeep_,

  -- *** Maybe
  shouldBeJust,
  expectJust,
  expectJustDeep,
  expectJustDeep_,
  expectNothing,
) where

import Control.DeepSeq (NFData)
import GHC.Stack (HasCallStack)
import Test.Hspec.Expectations.Lifted (
  expectationFailure,
  shouldBe,
  shouldContain,
  shouldEndWith,
  shouldMatchList,
  shouldNotBe,
  shouldNotContain,
  shouldNotReturn,
  shouldNotSatisfy,
  shouldReturn,
  shouldSatisfy,
  shouldStartWith,
 )
import qualified Test.ImpSpec.Expectations as IO
import UnliftIO (Exception, MonadIO (liftIO), MonadUnliftIO, withRunInIO)

infix 1 `shouldThrow`
        , `shouldBeRight`
        , `shouldBeLeft`

-- | Enforce the type of expectation
--
-- Useful with polymorphic expectations that are defined below.
--
-- ===__Example__
--
-- Because `shouldBeExpr` is polymorphic in `m`, compiler will choke with a unification
-- error. This is due to the fact that hspec's `it` expects a polymorphic `Example`.
--
-- > it "MyTest" $ do
-- >   "foo" `shouldBeExpr` "bar"
--
-- However, this is easily solved by `io`:
--
-- > it "MyTest" $ io $ do
-- >   "foo" `shouldBeExpr` "bar"
io :: IO a -> IO a
io :: forall a. IO a -> IO a
io = IO a -> IO a
forall a. a -> a
id

-- | Just like `expectationFailure`, but does not force the return type to unit. Lifted
-- version of `H.assertFailure`
assertFailure :: (HasCallStack, MonadIO m) => String -> m a
assertFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (String -> IO a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall a. HasCallStack => String -> IO a
IO.assertFailure

assertColorFailure :: (HasCallStack, MonadIO m) => String -> m a
assertColorFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertColorFailure = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (String -> IO a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall a. HasCallStack => String -> IO a
IO.assertColorFailure

-- | Lifted version of `H.assertBool`
assertBool :: (HasCallStack, MonadIO m) => String -> Bool -> m ()
assertBool :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool String
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Bool -> IO ()) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
IO.assertBool String
msg

-- | Lifted version of `shouldThrow`.
shouldThrow :: (HasCallStack, Exception e, MonadUnliftIO m) => m a -> IO.Selector e -> m ()
shouldThrow :: forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadUnliftIO m) =>
m a -> Selector e -> m ()
shouldThrow m a
f Selector e
s = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> Selector e -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
IO.shouldThrow (m a -> IO a
forall a. m a -> IO a
run m a
f) Selector e
s

-- | Return value on the `Right` and fail otherwise. Lifted version of `H.expectRight`.
expectRight :: (HasCallStack, Show a, MonadIO m) => Either a b -> m b
expectRight :: forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight = IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> (Either a b -> IO b) -> Either a b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO b
forall a b. (HasCallStack, Show a) => Either a b -> IO b
IO.expectRight

-- | Same as `expectRight`, but also evaluate the returned value to NF
expectRightDeep :: (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m b
expectRightDeep :: forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m b
expectRightDeep = IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> (Either a b -> IO b) -> Either a b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO b
forall a b. (HasCallStack, Show a, NFData b) => Either a b -> IO b
IO.expectRightDeep

-- | Same as `expectRightDeep`, but discards the result
expectRightDeep_ :: (HasCallStack, Show a, NFData b, MonadIO m) => Either a b -> m ()
expectRightDeep_ :: forall a b (m :: * -> *).
(HasCallStack, Show a, NFData b, MonadIO m) =>
Either a b -> m ()
expectRightDeep_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Either a b -> IO ()) -> Either a b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO ()
forall a b. (HasCallStack, Show a, NFData b) => Either a b -> IO ()
IO.expectRightDeep_

-- | Same as `shouldBe`, except it checks that the value is `Right`
shouldBeRight :: (HasCallStack, Show a, Show b, Eq b, MonadIO m) => Either a b -> b -> m ()
shouldBeRight :: forall a b (m :: * -> *).
(HasCallStack, Show a, Show b, Eq b, MonadIO m) =>
Either a b -> b -> m ()
shouldBeRight Either a b
e = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> b -> IO ()
forall a b.
(HasCallStack, Show a, Show b, Eq b) =>
Either a b -> b -> IO ()
IO.shouldBeRight Either a b
e

-- | Return value on the `Left` and fail otherwise
expectLeft :: (HasCallStack, Show b, MonadIO m) => Either a b -> m a
expectLeft :: forall b (m :: * -> *) a.
(HasCallStack, Show b, MonadIO m) =>
Either a b -> m a
expectLeft = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Either a b -> IO a) -> Either a b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO a
forall b a. (HasCallStack, Show b) => Either a b -> IO a
IO.expectLeft

-- | Same as `expectLeftDeep`, but discards the result
expectLeftDeep_ :: (HasCallStack, NFData a, Show b, MonadIO m) => Either a b -> m ()
expectLeftDeep_ :: forall a b (m :: * -> *).
(HasCallStack, NFData a, Show b, MonadIO m) =>
Either a b -> m ()
expectLeftDeep_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Either a b -> IO ()) -> Either a b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO ()
forall a b. (HasCallStack, NFData a, Show b) => Either a b -> IO ()
IO.expectLeftDeep_

-- | Same as `expectLeft`, but also evaluate the returned value to NF
expectLeftDeep :: (HasCallStack, NFData a, Show b, MonadIO m) => Either a b -> m a
expectLeftDeep :: forall a b (m :: * -> *).
(HasCallStack, NFData a, Show b, MonadIO m) =>
Either a b -> m a
expectLeftDeep = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Either a b -> IO a) -> Either a b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> IO a
forall a b. (HasCallStack, NFData a, Show b) => Either a b -> IO a
IO.expectLeftDeep

-- | Same as `shouldBe`, except it checks that the value is `Left`
shouldBeLeft :: (HasCallStack, Show a, Eq a, Show b, MonadIO m) => Either a b -> a -> m ()
shouldBeLeft :: forall a b (m :: * -> *).
(HasCallStack, Show a, Eq a, Show b, MonadIO m) =>
Either a b -> a -> m ()
shouldBeLeft Either a b
e a
x = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Either a b
e Either a b -> a -> IO ()
forall a b.
(HasCallStack, Show a, Eq a, Show b) =>
Either a b -> a -> IO ()
`IO.shouldBeLeft` a
x

-- | Same as `shouldBe`, except it checks that the value is `Just`
shouldBeJust :: (HasCallStack, Show a, Eq a, MonadIO m) => Maybe a -> a -> m ()
shouldBeJust :: forall a (m :: * -> *).
(HasCallStack, Show a, Eq a, MonadIO m) =>
Maybe a -> a -> m ()
shouldBeJust Maybe a
e a
x = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe a
e Maybe a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => Maybe a -> a -> IO ()
`IO.shouldBeJust` a
x

expectJust :: (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Maybe a -> IO a) -> Maybe a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> IO a
forall a. HasCallStack => Maybe a -> IO a
IO.expectJust

expectJustDeep :: (HasCallStack, NFData a, MonadIO m) => Maybe a -> m a
expectJustDeep :: forall a (m :: * -> *).
(HasCallStack, NFData a, MonadIO m) =>
Maybe a -> m a
expectJustDeep = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Maybe a -> IO a) -> Maybe a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> IO a
forall a. (HasCallStack, NFData a) => Maybe a -> IO a
IO.expectJustDeep

expectJustDeep_ :: (HasCallStack, NFData a, MonadIO m) => Maybe a -> m ()
expectJustDeep_ :: forall a (m :: * -> *).
(HasCallStack, NFData a, MonadIO m) =>
Maybe a -> m ()
expectJustDeep_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Maybe a -> IO ()) -> Maybe a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> IO ()
forall a. (HasCallStack, NFData a) => Maybe a -> IO ()
IO.expectJustDeep_

expectNothing :: (HasCallStack, Show a, MonadIO m) => Maybe a -> m ()
expectNothing :: forall a (m :: * -> *).
(HasCallStack, Show a, MonadIO m) =>
Maybe a -> m ()
expectNothing = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Maybe a -> IO ()) -> Maybe a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> IO ()
forall a. (HasCallStack, Show a) => Maybe a -> IO ()
IO.expectNothing