module HaskellWorks.Polysemy.Hedgehog.Assert
  ( Hedgehog,
    leftFail,
    leftFailM,
    requireHead,
    catchFail,
    evalIO,
    failure,
    failMessage,

    (===),

  ) where


import qualified GHC.Stack                                      as GHC
import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import           HaskellWorks.Polysemy.Prelude
import           Polysemy
import           Polysemy.Error

(===) :: ()
  => Member Hedgehog r
  => Eq a
  => Show a
  => HasCallStack
  => a
  -> a
  -> Sem r ()
=== :: forall (r :: EffectRow) a.
(Member Hedgehog r, Eq a, Show a, HasCallStack) =>
a -> a -> Sem r ()
(===) a
a a
b = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ a -> a -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Eq a, Show a) =>
a -> a -> Sem r ()
assertEquals a
a a
b

-- | Fail when the result is Left.
leftFail :: forall e r a. ()
  => Member Hedgehog r
  => Show e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFail :: forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Either e a -> Sem r a
leftFail Either e a
r = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ case Either e a
r of
  Right a
a -> a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  Left e
e  -> CallStack -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String
"Expected Right: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> e -> String
forall a. Show a => a -> String
show e
e)

failure :: ()
  => Member Hedgehog r
  => HasCallStack
  => Sem r a
failure :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a
failure =
  (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Maybe Diff -> String -> Sem r a
failWith Maybe Diff
forall a. Maybe a
Nothing String
""

failMessage :: ()
  => Member Hedgehog r
  => HasCallStack
  => GHC.CallStack
  -> String
  -> Sem r a
failMessage :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
cs =
  (HasCallStack => String -> Sem r a) -> String -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => String -> Sem r a) -> String -> Sem r a)
-> (HasCallStack => String -> Sem r a) -> String -> Sem r a
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r a
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
cs Maybe Diff
forall a. Maybe a
Nothing

leftFailM :: forall e r a. ()
  => Member Hedgehog r
  => Show e
  => HasCallStack
  => Sem r (Either e a)
  -> Sem r a
leftFailM :: forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM Sem r (Either e a)
f =
  (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem r (Either e a)
f Sem r (Either e a) -> (Either e a -> Sem r a) -> Sem r a
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> Sem r a
forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Either e a -> Sem r a
leftFail

catchFail :: forall e r a.()
  => Member Hedgehog r
  => HasCallStack
  => Show e
  => Sem (Error e ': r) a
  -> Sem r a
catchFail :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show e) =>
Sem (Error e : r) a -> Sem r a
catchFail Sem (Error e : r) a
f =
  (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem (Error e : r) a
f Sem (Error e : r) a
-> (Sem (Error e : r) a -> Sem r (Either e a))
-> Sem r (Either e a)
forall a b. a -> (a -> b) -> b
& Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError Sem r (Either e a) -> (Sem r (Either e a) -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& Sem r (Either e a) -> Sem r a
forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM

requireHead :: ()
  => Member Hedgehog r
  => HasCallStack
  => [a]
  -> Sem r a
requireHead :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
[a] -> Sem r a
requireHead = (HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a)
-> (HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a
forall a b. (a -> b) -> a -> b
$
  \case
    []    -> CallStack -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Cannot take head of empty list"
    (a
x:[a]
_) -> a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x