{-# OPTIONS_HADDOCK hide #-}

module Polysemy.Test.Data.Hedgehog where

import Hedgehog (TestT)

import Polysemy (makeSem_)

-- |Convenience effect for embedding Hedgehog assertions.
data Hedgehog :: Effect where
  LiftH :: TestT IO a -> Hedgehog m a
  Assert :: Bool -> Hedgehog m ()
  AssertEqual :: (Eq a, Show a) => a -> a -> Hedgehog m ()
  EvalEither :: Show e => Either e a -> Hedgehog m a
  AssertRight :: (Show e, Eq a, Show a) => a -> Either e a -> Hedgehog m ()

makeSem_ ''Hedgehog

-- |Lift a @'TestT' IO@ into Sem.
-- >>> liftH (Hedgehog.evalEither (Right 0))
liftH ::
  ∀ a r .
  Member Hedgehog r =>
  TestT IO a ->
  Sem r a

-- |Embeds 'Hedgehog.assert'.
assert ::
  ∀ r .
  Member Hedgehog r =>
  Bool ->
  Sem r ()

-- |Embeds 'Hedgehog.(===)'.
assertEqual ::
  ∀ a r .
  Eq a =>
  Show a =>
  Member Hedgehog r =>
  a ->
  a ->
  Sem r ()

-- |Alias for 'assertEqual'.
-- >>> 5 === 6
(===) ::
  Eq a =>
  Show a =>
  Member Hedgehog r =>
  a ->
  a ->
  Sem r ()
=== :: a -> a -> Sem r ()
(===) =
  a -> a -> Sem r ()
forall a (r :: [(* -> *) -> * -> *]).
(Eq a, Show a, Member Hedgehog r) =>
a -> a -> Sem r ()
assertEqual

-- |Embeds 'Hedgehog.evalEither'.
evalEither ::
  ∀ a e r .
  Show e =>
  Member Hedgehog r =>
  Either e a ->
  Sem r a

-- |Given a reference value, unpacks an 'Either' with 'evalEither' and applies 'assertEqual' to the result in the
-- 'Right' case, and produces a test failure in the 'Left' case.
assertRight ::
  ∀ a e r .
  Show e =>
  Eq a =>
  Show a =>
  Member Hedgehog r =>
  a ->
  Either e a ->
  Sem r ()

data ValueIsNothing =
  ValueIsNothing
  deriving Int -> ValueIsNothing -> ShowS
[ValueIsNothing] -> ShowS
ValueIsNothing -> String
(Int -> ValueIsNothing -> ShowS)
-> (ValueIsNothing -> String)
-> ([ValueIsNothing] -> ShowS)
-> Show ValueIsNothing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueIsNothing] -> ShowS
$cshowList :: [ValueIsNothing] -> ShowS
show :: ValueIsNothing -> String
$cshow :: ValueIsNothing -> String
showsPrec :: Int -> ValueIsNothing -> ShowS
$cshowsPrec :: Int -> ValueIsNothing -> ShowS
Show

assertJust ::
  Eq a =>
  Show a =>
  Member Hedgehog r =>
  a ->
  Maybe a ->
  Sem r ()
assertJust :: a -> Maybe a -> Sem r ()
assertJust a
target =
  a -> Either ValueIsNothing a -> Sem r ()
forall a e (r :: [(* -> *) -> * -> *]).
(Show e, Eq a, Show a, Member Hedgehog r) =>
a -> Either e a -> Sem r ()
assertRight a
target (Either ValueIsNothing a -> Sem r ())
-> (Maybe a -> Either ValueIsNothing a) -> Maybe a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueIsNothing -> Maybe a -> Either ValueIsNothing a
forall l r. l -> Maybe r -> Either l r
maybeToRight ValueIsNothing
ValueIsNothing

evalMaybe ::
  Member Hedgehog r =>
  Maybe a ->
  Sem r a
evalMaybe :: Maybe a -> Sem r a
evalMaybe =
  Either ValueIsNothing a -> Sem r a
forall a e (r :: [(* -> *) -> * -> *]).
(Show e, Member Hedgehog r) =>
Either e a -> Sem r a
evalEither (Either ValueIsNothing a -> Sem r a)
-> (Maybe a -> Either ValueIsNothing a) -> Maybe a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueIsNothing -> Maybe a -> Either ValueIsNothing a
forall l r. l -> Maybe r -> Either l r
maybeToRight ValueIsNothing
ValueIsNothing