{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoFieldSelectors #-}

module Skeletest.Internal.Predicate (
  Predicate (..),
  PredicateResult (..),
  PredicateFuncResult (..),
  ShowFailCtx (..),
  runPredicate,
  renderPredicate,

  -- * General
  anything,
  anythingDeep,
  anyThunk,

  -- * Ord
  eq,
  gt,
  gte,
  lt,
  lte,

  -- * Data types
  just,
  nothing,
  left,
  right,
  list,
  IsPredTuple (..),
  tup,
  con,
  conMatches,

  -- * Numeric
  approx,
  tol,
  Tolerance (..),

  -- * Combinators
  (<<<),
  (>>>),
  not,
  (&&),
  (||),
  and,
  or,

  -- * Containers
  any,
  all,
  elem,

  -- * Subsequences
  HasSubsequences (..),
  hasPrefix,
  hasInfix,
  hasSuffix,
  empty,

  -- * IO
  returns,
  throws,

  -- * Utilities
  render,
) where

import Control.DeepSeq (NFData)
import Control.Monad.IO.Class (MonadIO)
import Data.Foldable (toList)
import Data.Foldable1 qualified as Foldable1
import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity (..))
import Data.Kind (Type)
import Data.List qualified as List
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (isJust, isNothing, listToMaybe)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LazyText
import Debug.RecoverRTTI (anythingToString)
import GHC.Generics ((:*:) (..))
import Skeletest.Internal.Error (invariantViolation)
import Skeletest.Internal.Utils.HList (HList (..))
import Skeletest.Internal.Utils.HList qualified as HList
import Skeletest.Internal.Utils.Text (indent, parens)
import UnliftIO (MonadUnliftIO)
import UnliftIO.Exception (Exception, displayException, evaluate, evaluateDeep, try)
import Prelude hiding (abs, all, and, any, elem, not, or, (&&), (||))
import Prelude qualified

data Predicate m a = Predicate
  { forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateFunc :: a -> m PredicateFuncResult
  , forall (m :: * -> *) a. Predicate m a -> Text
predicateDisp :: Text
  -- ^ The rendered representation of the predicate
  , forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: Text
  -- ^ The rendered representation of the negation of the predicate
  }

data PredicateResult
  = PredicateSuccess
  | PredicateFail Text

runPredicate :: (Monad m) => Predicate m a -> a -> m PredicateResult
runPredicate :: forall (m :: * -> *) a.
Monad m =>
Predicate m a -> a -> m PredicateResult
runPredicate Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} a
val = do
  PredicateFuncResult{Bool
Text
ShowFailCtx
predicateSuccess :: Bool
predicateExplain :: Text
predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx :: PredicateFuncResult -> ShowFailCtx
predicateExplain :: PredicateFuncResult -> Text
predicateSuccess :: PredicateFuncResult -> Bool
..} <- a -> m PredicateFuncResult
predicateFunc a
val
  PredicateResult -> m PredicateResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PredicateResult -> m PredicateResult)
-> PredicateResult -> m PredicateResult
forall a b. (a -> b) -> a -> b
$
    if Bool
predicateSuccess
      then PredicateResult
PredicateSuccess
      else
        let failCtx :: FailCtx
failCtx =
              FailCtx
                { failCtxExpected :: Text
failCtxExpected = Text
predicateDisp
                , failCtxActual :: Text
failCtxActual = a -> Text
forall a. a -> Text
render a
val
                }
         in Text -> PredicateResult
PredicateFail (Text -> PredicateResult)
-> (Text -> Text) -> Text -> PredicateResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailCtx -> ShowFailCtx -> Text -> Text
withFailCtx FailCtx
failCtx ShowFailCtx
predicateShowFailCtx (Text -> PredicateResult) -> Text -> PredicateResult
forall a b. (a -> b) -> a -> b
$ Text
predicateExplain

renderPredicate :: Predicate m a -> Text
renderPredicate :: forall (m :: * -> *) a. Predicate m a -> Text
renderPredicate = (.predicateDisp)

data PredicateFuncResult = PredicateFuncResult
  { PredicateFuncResult -> Bool
predicateSuccess :: Bool
  , PredicateFuncResult -> Text
predicateExplain :: Text
  -- ^ The explanation of the result.
  --
  -- If predicateSuccess is true, this is the message to show if the
  -- success is unexpected. If predicatesSuccess is false, this is
  -- the message to show on the failure.
  , PredicateFuncResult -> ShowFailCtx
predicateShowFailCtx :: ShowFailCtx
  -- ^ See 'ShowFailCtx'.
  }

-- | Should a predicate show the context of the failure?
--
-- When failing `P.left (P.eq 1)`, the failure should show just the specific
-- thing that failed, e.g. `1 ≠ 2`, but we should show the general context
-- as well, e.g. `Expected: Left (= 1), Got: Left 2`. Primitive predicates
-- should generally start as NoFailCtx, then higher-order predicates should
-- upgrade it to ShowFailCtx. Predicates that explicitly want to hide the
-- context should set HideFailCtx.
data ShowFailCtx
  = NoFailCtx
  | ShowFailCtx
  | HideFailCtx
  deriving (ShowFailCtx -> ShowFailCtx -> Bool
(ShowFailCtx -> ShowFailCtx -> Bool)
-> (ShowFailCtx -> ShowFailCtx -> Bool) -> Eq ShowFailCtx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowFailCtx -> ShowFailCtx -> Bool
== :: ShowFailCtx -> ShowFailCtx -> Bool
$c/= :: ShowFailCtx -> ShowFailCtx -> Bool
/= :: ShowFailCtx -> ShowFailCtx -> Bool
Eq, Eq ShowFailCtx
Eq ShowFailCtx =>
(ShowFailCtx -> ShowFailCtx -> Ordering)
-> (ShowFailCtx -> ShowFailCtx -> Bool)
-> (ShowFailCtx -> ShowFailCtx -> Bool)
-> (ShowFailCtx -> ShowFailCtx -> Bool)
-> (ShowFailCtx -> ShowFailCtx -> Bool)
-> (ShowFailCtx -> ShowFailCtx -> ShowFailCtx)
-> (ShowFailCtx -> ShowFailCtx -> ShowFailCtx)
-> Ord ShowFailCtx
ShowFailCtx -> ShowFailCtx -> Bool
ShowFailCtx -> ShowFailCtx -> Ordering
ShowFailCtx -> ShowFailCtx -> ShowFailCtx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShowFailCtx -> ShowFailCtx -> Ordering
compare :: ShowFailCtx -> ShowFailCtx -> Ordering
$c< :: ShowFailCtx -> ShowFailCtx -> Bool
< :: ShowFailCtx -> ShowFailCtx -> Bool
$c<= :: ShowFailCtx -> ShowFailCtx -> Bool
<= :: ShowFailCtx -> ShowFailCtx -> Bool
$c> :: ShowFailCtx -> ShowFailCtx -> Bool
> :: ShowFailCtx -> ShowFailCtx -> Bool
$c>= :: ShowFailCtx -> ShowFailCtx -> Bool
>= :: ShowFailCtx -> ShowFailCtx -> Bool
$cmax :: ShowFailCtx -> ShowFailCtx -> ShowFailCtx
max :: ShowFailCtx -> ShowFailCtx -> ShowFailCtx
$cmin :: ShowFailCtx -> ShowFailCtx -> ShowFailCtx
min :: ShowFailCtx -> ShowFailCtx -> ShowFailCtx
Ord)

shouldShowFailCtx :: ShowFailCtx -> Bool
shouldShowFailCtx :: ShowFailCtx -> Bool
shouldShowFailCtx = \case
  ShowFailCtx
NoFailCtx -> Bool
False
  ShowFailCtx
ShowFailCtx -> Bool
True
  ShowFailCtx
HideFailCtx -> Bool
False

data FailCtx = FailCtx
  { FailCtx -> Text
failCtxExpected :: Text
  , FailCtx -> Text
failCtxActual :: Text
  }

renderFailCtx :: FailCtx -> Text
renderFailCtx :: FailCtx -> Text
renderFailCtx FailCtx{Text
failCtxExpected :: FailCtx -> Text
failCtxActual :: FailCtx -> Text
failCtxExpected :: Text
failCtxActual :: Text
..} =
  Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"Expected:"
    , Text -> Text
indent Text
failCtxExpected
    , Text
""
    , Text
"Got:"
    , Text -> Text
indent Text
failCtxActual
    ]

withFailCtx :: FailCtx -> ShowFailCtx -> Text -> Text
withFailCtx :: FailCtx -> ShowFailCtx -> Text -> Text
withFailCtx FailCtx
failCtx ShowFailCtx
ctx Text
s =
  if ShowFailCtx -> Bool
shouldShowFailCtx ShowFailCtx
ctx
    then Text -> [Text] -> Text
Text.intercalate Text
"\n" [Text
s, Text
"", FailCtx -> Text
renderFailCtx FailCtx
failCtx]
    else Text
s

noCtx :: ShowFailCtx
noCtx :: ShowFailCtx
noCtx = ShowFailCtx
NoFailCtx

showMergedCtxs :: [PredicateFuncResult] -> ShowFailCtx
showMergedCtxs :: [PredicateFuncResult] -> ShowFailCtx
showMergedCtxs = ShowFailCtx -> ShowFailCtx -> ShowFailCtx
forall a. Ord a => a -> a -> a
max ShowFailCtx
ShowFailCtx (ShowFailCtx -> ShowFailCtx)
-> ([PredicateFuncResult] -> ShowFailCtx)
-> [PredicateFuncResult]
-> ShowFailCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowFailCtx
-> (NonEmpty ShowFailCtx -> ShowFailCtx)
-> Maybe (NonEmpty ShowFailCtx)
-> ShowFailCtx
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowFailCtx
NoFailCtx NonEmpty ShowFailCtx -> ShowFailCtx
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
Foldable1.maximum (Maybe (NonEmpty ShowFailCtx) -> ShowFailCtx)
-> ([PredicateFuncResult] -> Maybe (NonEmpty ShowFailCtx))
-> [PredicateFuncResult]
-> ShowFailCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShowFailCtx] -> Maybe (NonEmpty ShowFailCtx)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([ShowFailCtx] -> Maybe (NonEmpty ShowFailCtx))
-> ([PredicateFuncResult] -> [ShowFailCtx])
-> [PredicateFuncResult]
-> Maybe (NonEmpty ShowFailCtx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PredicateFuncResult -> ShowFailCtx)
-> [PredicateFuncResult] -> [ShowFailCtx]
forall a b. (a -> b) -> [a] -> [b]
map (.predicateShowFailCtx)

showCtx :: PredicateFuncResult -> PredicateFuncResult
showCtx :: PredicateFuncResult -> PredicateFuncResult
showCtx PredicateFuncResult
result = PredicateFuncResult
result{predicateShowFailCtx = max ShowFailCtx result.predicateShowFailCtx}

{----- General -----}

-- | A predicate that matches any value after evaluating to WHNF.
anything :: forall a m. (MonadIO m) => Predicate m a
anything :: forall a (m :: * -> *). MonadIO m => Predicate m a
anything =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
a -> do
        a
_ <- a -> m a
forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate a
a
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
True
            , predicateExplain :: Text
predicateExplain = Text
"anything"
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
"anything"
    , predicateDispNeg :: Text
predicateDispNeg = Text
"not anything"
    }

-- | A predicate that matches any value after evaluating it deeply.
--
-- @since 0.4.0
anythingDeep :: forall a m. (MonadIO m, NFData a) => Predicate m a
anythingDeep :: forall a (m :: * -> *). (MonadIO m, NFData a) => Predicate m a
anythingDeep =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
a -> do
        a
_ <- a -> m a
forall (m :: * -> *) a. (MonadIO m, NFData a) => a -> m a
evaluateDeep a
a
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
True
            , predicateExplain :: Text
predicateExplain = Text
"anything"
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
"anything"
    , predicateDispNeg :: Text
predicateDispNeg = Text
"not anything"
    }

-- | A predicate that matches any value without evaluating to WHNF.
--
-- @since 0.4.0
anyThunk :: forall a m. (Monad m) => Predicate m a
anyThunk :: forall a (m :: * -> *). Monad m => Predicate m a
anyThunk =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
_ ->
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
True
            , predicateExplain :: Text
predicateExplain = Text
"any thunk"
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
"any thunk"
    , predicateDispNeg :: Text
predicateDispNeg = Text
"not any thunk"
    }

{----- Ord -----}

-- | A predicate checking if the input is equal to the given value
--
-- >>> 1 `shouldSatisfy` P.eq 1
eq :: (Eq a, Monad m) => a -> Predicate m a
eq :: forall a (m :: * -> *). (Eq a, Monad m) => a -> Predicate m a
eq = Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
"=" Text
"≠" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected -> a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected

-- | A predicate checking if the input is greater than the given value
--
-- >>> 1 `shouldSatisfy` P.gt 0
gt :: (Ord a, Monad m) => a -> Predicate m a
gt :: forall a (m :: * -> *). (Ord a, Monad m) => a -> Predicate m a
gt = Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
">" Text
"≯" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected -> a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
expected

-- | A predicate checking if the input is greater than or equal to the given value
--
-- >>> 1 `shouldSatisfy` P.gte 0
gte :: (Ord a, Monad m) => a -> Predicate m a
gte :: forall a (m :: * -> *). (Ord a, Monad m) => a -> Predicate m a
gte = Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
"≥" Text
"≱" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected -> a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
expected Bool -> Bool -> Bool
Prelude.|| a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected

-- | A predicate checking if the input is less than the given value
--
-- >>> 1 `shouldSatisfy` P.lt 10
lt :: (Ord a, Monad m) => a -> Predicate m a
lt :: forall a (m :: * -> *). (Ord a, Monad m) => a -> Predicate m a
lt = Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
"<" Text
"≮" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected -> a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
expected

-- | A predicate checking if the input is less than or equal to the given value
--
-- >>> 1 `shouldSatisfy` P.lte 10
lte :: (Ord a, Monad m) => a -> Predicate m a
lte :: forall a (m :: * -> *). (Ord a, Monad m) => a -> Predicate m a
lte = Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
"≤" Text
"≰" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected -> a
actual a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
expected Bool -> Bool -> Bool
Prelude.|| a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected

{----- Data types -----}

-- | A predicate checking if the input is Just, wrapping a value matching the given predicate.
--
-- >>> Just 1 `shouldSatisfy` P.just (P.gt 0)
just :: (Monad m) => Predicate m a -> Predicate m (Maybe a)
just :: forall (m :: * -> *) a.
Monad m =>
Predicate m a -> Predicate m (Maybe a)
just Predicate m a
p = String
-> Maybe (HList (Const String) '[a])
-> (Maybe a -> Maybe (HList Identity '[a]))
-> HList (Predicate m) '[a]
-> Predicate m (Maybe a)
forall (m :: * -> *) (fields :: [*]) a.
Monad m =>
String
-> Maybe (HList (Const String) fields)
-> (a -> Maybe (HList Identity fields))
-> HList (Predicate m) fields
-> Predicate m a
conMatches String
"Just" Maybe (HList (Const String) '[a])
forall {a}. Maybe a
fieldNames Maybe a -> Maybe (HList Identity '[a])
forall {x}. Maybe x -> Maybe (HList Identity '[x])
toFields HList (Predicate m) '[a]
preds
 where
  fieldNames :: Maybe a
fieldNames = Maybe a
forall {a}. Maybe a
Nothing
  toFields :: Maybe x -> Maybe (HList Identity '[x])
toFields = \case
    Just x
x -> HList Identity '[x] -> Maybe (HList Identity '[x])
forall a. a -> Maybe a
Just (HList Identity '[x] -> Maybe (HList Identity '[x]))
-> (HList Identity '[] -> HList Identity '[x])
-> HList Identity '[]
-> Maybe (HList Identity '[x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> HList Identity '[] -> HList Identity '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (x -> Identity x
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) (HList Identity '[] -> Maybe (HList Identity '[x]))
-> HList Identity '[] -> Maybe (HList Identity '[x])
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
    Maybe x
_ -> Maybe (HList Identity '[x])
forall {a}. Maybe a
Nothing
  preds :: HList (Predicate m) '[a]
preds = Predicate m a
-> HList (Predicate m) '[] -> HList (Predicate m) '[a]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
p HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil

-- | A predicate checking if the input is Nothing
--
-- >>> Nothing `shouldSatisfy` P.nothing
nothing :: (Monad m) => Predicate m (Maybe a)
nothing :: forall (m :: * -> *) a. Monad m => Predicate m (Maybe a)
nothing = String
-> Maybe (HList (Const String) '[])
-> (Maybe a -> Maybe (HList Identity '[]))
-> HList (Predicate m) '[]
-> Predicate m (Maybe a)
forall (m :: * -> *) (fields :: [*]) a.
Monad m =>
String
-> Maybe (HList (Const String) fields)
-> (a -> Maybe (HList Identity fields))
-> HList (Predicate m) fields
-> Predicate m a
conMatches String
"Nothing" Maybe (HList (Const String) '[])
forall {a}. Maybe a
fieldNames Maybe a -> Maybe (HList Identity '[])
forall {k} {a} {f :: k -> *}. Maybe a -> Maybe (HList f '[])
toFields HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
preds
 where
  fieldNames :: Maybe a
fieldNames = Maybe a
forall {a}. Maybe a
Nothing
  toFields :: Maybe a -> Maybe (HList f '[])
toFields = \case
    Maybe a
Nothing -> HList f '[] -> Maybe (HList f '[])
forall a. a -> Maybe a
Just HList f '[]
forall {k} (f :: k -> *). HList f '[]
HNil
    Maybe a
_ -> Maybe (HList f '[])
forall {a}. Maybe a
Nothing
  preds :: HList f '[]
preds = HList f '[]
forall {k} (f :: k -> *). HList f '[]
HNil

-- | A predicate checking if the input is Left, wrapping a value matching the given predicate.
--
-- >>> Left 1 `shouldSatisfy` P.left (P.gt 0)
left :: (Monad m) => Predicate m a -> Predicate m (Either a b)
left :: forall (m :: * -> *) a b.
Monad m =>
Predicate m a -> Predicate m (Either a b)
left Predicate m a
p = String
-> Maybe (HList (Const String) '[a])
-> (Either a b -> Maybe (HList Identity '[a]))
-> HList (Predicate m) '[a]
-> Predicate m (Either a b)
forall (m :: * -> *) (fields :: [*]) a.
Monad m =>
String
-> Maybe (HList (Const String) fields)
-> (a -> Maybe (HList Identity fields))
-> HList (Predicate m) fields
-> Predicate m a
conMatches String
"Left" Maybe (HList (Const String) '[a])
forall {a}. Maybe a
fieldNames Either a b -> Maybe (HList Identity '[a])
forall {x} {b}. Either x b -> Maybe (HList Identity '[x])
toFields HList (Predicate m) '[a]
preds
 where
  fieldNames :: Maybe a
fieldNames = Maybe a
forall {a}. Maybe a
Nothing
  toFields :: Either x b -> Maybe (HList Identity '[x])
toFields = \case
    Left x
x -> HList Identity '[x] -> Maybe (HList Identity '[x])
forall a. a -> Maybe a
Just (HList Identity '[x] -> Maybe (HList Identity '[x]))
-> (HList Identity '[] -> HList Identity '[x])
-> HList Identity '[]
-> Maybe (HList Identity '[x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> HList Identity '[] -> HList Identity '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (x -> Identity x
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) (HList Identity '[] -> Maybe (HList Identity '[x]))
-> HList Identity '[] -> Maybe (HList Identity '[x])
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
    Either x b
_ -> Maybe (HList Identity '[x])
forall {a}. Maybe a
Nothing
  preds :: HList (Predicate m) '[a]
preds = Predicate m a
-> HList (Predicate m) '[] -> HList (Predicate m) '[a]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
p HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil

-- | A predicate checking if the input is Right, wrapping a value matching the given predicate.
--
-- >>> Right 1 `shouldSatisfy` P.right (P.gt 0)
right :: (Monad m) => Predicate m b -> Predicate m (Either a b)
right :: forall (m :: * -> *) b a.
Monad m =>
Predicate m b -> Predicate m (Either a b)
right Predicate m b
p = String
-> Maybe (HList (Const String) '[b])
-> (Either a b -> Maybe (HList Identity '[b]))
-> HList (Predicate m) '[b]
-> Predicate m (Either a b)
forall (m :: * -> *) (fields :: [*]) a.
Monad m =>
String
-> Maybe (HList (Const String) fields)
-> (a -> Maybe (HList Identity fields))
-> HList (Predicate m) fields
-> Predicate m a
conMatches String
"Right" Maybe (HList (Const String) '[b])
forall {a}. Maybe a
fieldNames Either a b -> Maybe (HList Identity '[b])
forall {a} {x}. Either a x -> Maybe (HList Identity '[x])
toFields HList (Predicate m) '[b]
preds
 where
  fieldNames :: Maybe a
fieldNames = Maybe a
forall {a}. Maybe a
Nothing
  toFields :: Either a x -> Maybe (HList Identity '[x])
toFields = \case
    Right x
x -> HList Identity '[x] -> Maybe (HList Identity '[x])
forall a. a -> Maybe a
Just (HList Identity '[x] -> Maybe (HList Identity '[x]))
-> (HList Identity '[] -> HList Identity '[x])
-> HList Identity '[]
-> Maybe (HList Identity '[x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> HList Identity '[] -> HList Identity '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (x -> Identity x
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x) (HList Identity '[] -> Maybe (HList Identity '[x]))
-> HList Identity '[] -> Maybe (HList Identity '[x])
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
    Either a x
_ -> Maybe (HList Identity '[x])
forall {a}. Maybe a
Nothing
  preds :: HList (Predicate m) '[b]
preds = Predicate m b
-> HList (Predicate m) '[] -> HList (Predicate m) '[b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
p HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil

-- | A predicate checking if the input is a list matching exactly the given predicates.
--
-- >>> [1, 2, 3] `shouldSatisfy` P.list [P.eq 1, P.eq 2, P.eq 3]
-- >>> [1, 2, 3] `shouldNotSatisfy` P.list [P.eq 1, P.eq 2]
-- >>> [1, 2, 3] `shouldNotSatisfy` P.list [P.eq 1, P.eq 2, P.eq 3, P.eq 4]
--
-- @since 0.2.1
list :: (Monad m) => [Predicate m a] -> Predicate m [a]
list :: forall (m :: * -> *) a.
Monad m =>
[Predicate m a] -> Predicate m [a]
list [Predicate m a]
predList =
  Predicate
    { predicateFunc :: [a] -> m PredicateFuncResult
predicateFunc = \[a]
actual ->
        if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Predicate m a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Predicate m a]
predList
          then ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll [Text] -> Text
listify ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m PredicateFuncResult] -> m [PredicateFuncResult]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((Predicate m a -> a -> m PredicateFuncResult)
-> [Predicate m a] -> [a] -> [m PredicateFuncResult]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (.predicateFunc) [Predicate m a]
predList [a]
actual)
          else
            PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              PredicateFuncResult
                { predicateSuccess :: Bool
predicateSuccess = Bool
False
                , predicateExplain :: Text
predicateExplain = Text
"Got different number of elements"
                , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
ShowFailCtx
                }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  listify :: [Text] -> Text
listify [Text]
vals = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
vals Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  disp :: Text
disp = [Text] -> Text
listify ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Predicate m a -> Text) -> [Predicate m a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (.predicateDisp) [Predicate m a]
predList
  dispNeg :: Text
dispNeg = Text
"not " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp

class IsTuple a where
  type TupleArgs a :: [Type]
  toHList :: a -> HList Identity (TupleArgs a)
instance IsTuple (a, b) where
  type TupleArgs (a, b) = '[a, b]
  toHList :: (a, b) -> HList Identity (TupleArgs (a, b))
toHList (a
a, b
b) = Identity a -> HList Identity '[b] -> HList Identity '[a, b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (HList Identity '[b] -> HList Identity (TupleArgs (a, b)))
-> (HList Identity '[] -> HList Identity '[b])
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b -> HList Identity '[] -> HList Identity '[b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b) (HList Identity '[] -> HList Identity (TupleArgs (a, b)))
-> HList Identity '[] -> HList Identity (TupleArgs (a, b))
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsTuple (a, b, c) where
  type TupleArgs (a, b, c) = '[a, b, c]
  toHList :: (a, b, c) -> HList Identity (TupleArgs (a, b, c))
toHList (a
a, b
b, c
c) = Identity a -> HList Identity '[b, c] -> HList Identity '[a, b, c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (HList Identity '[b, c] -> HList Identity (TupleArgs (a, b, c)))
-> (HList Identity '[] -> HList Identity '[b, c])
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b -> HList Identity '[c] -> HList Identity '[b, c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b) (HList Identity '[c] -> HList Identity '[b, c])
-> (HList Identity '[] -> HList Identity '[c])
-> HList Identity '[]
-> HList Identity '[b, c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity c -> HList Identity '[] -> HList Identity '[c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (c -> Identity c
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) (HList Identity '[] -> HList Identity (TupleArgs (a, b, c)))
-> HList Identity '[] -> HList Identity (TupleArgs (a, b, c))
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsTuple (a, b, c, d) where
  type TupleArgs (a, b, c, d) = '[a, b, c, d]
  toHList :: (a, b, c, d) -> HList Identity (TupleArgs (a, b, c, d))
toHList (a
a, b
b, c
c, d
d) = Identity a
-> HList Identity '[b, c, d] -> HList Identity '[a, b, c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (HList Identity '[b, c, d]
 -> HList Identity (TupleArgs (a, b, c, d)))
-> (HList Identity '[] -> HList Identity '[b, c, d])
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b, c, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b -> HList Identity '[c, d] -> HList Identity '[b, c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b) (HList Identity '[c, d] -> HList Identity '[b, c, d])
-> (HList Identity '[] -> HList Identity '[c, d])
-> HList Identity '[]
-> HList Identity '[b, c, d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity c -> HList Identity '[d] -> HList Identity '[c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (c -> Identity c
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) (HList Identity '[d] -> HList Identity '[c, d])
-> (HList Identity '[] -> HList Identity '[d])
-> HList Identity '[]
-> HList Identity '[c, d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity d -> HList Identity '[] -> HList Identity '[d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (d -> Identity d
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure d
d) (HList Identity '[] -> HList Identity (TupleArgs (a, b, c, d)))
-> HList Identity '[] -> HList Identity (TupleArgs (a, b, c, d))
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsTuple (a, b, c, d, e) where
  type TupleArgs (a, b, c, d, e) = '[a, b, c, d, e]
  toHList :: (a, b, c, d, e) -> HList Identity (TupleArgs (a, b, c, d, e))
toHList (a
a, b
b, c
c, d
d, e
e) = Identity a
-> HList Identity '[b, c, d, e] -> HList Identity '[a, b, c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (HList Identity '[b, c, d, e]
 -> HList Identity (TupleArgs (a, b, c, d, e)))
-> (HList Identity '[] -> HList Identity '[b, c, d, e])
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b, c, d, e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b
-> HList Identity '[c, d, e] -> HList Identity '[b, c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b) (HList Identity '[c, d, e] -> HList Identity '[b, c, d, e])
-> (HList Identity '[] -> HList Identity '[c, d, e])
-> HList Identity '[]
-> HList Identity '[b, c, d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity c -> HList Identity '[d, e] -> HList Identity '[c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (c -> Identity c
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) (HList Identity '[d, e] -> HList Identity '[c, d, e])
-> (HList Identity '[] -> HList Identity '[d, e])
-> HList Identity '[]
-> HList Identity '[c, d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity d -> HList Identity '[e] -> HList Identity '[d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (d -> Identity d
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure d
d) (HList Identity '[e] -> HList Identity '[d, e])
-> (HList Identity '[] -> HList Identity '[e])
-> HList Identity '[]
-> HList Identity '[d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity e -> HList Identity '[] -> HList Identity '[e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (e -> Identity e
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e) (HList Identity '[] -> HList Identity (TupleArgs (a, b, c, d, e)))
-> HList Identity '[] -> HList Identity (TupleArgs (a, b, c, d, e))
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsTuple (a, b, c, d, e, f) where
  type TupleArgs (a, b, c, d, e, f) = '[a, b, c, d, e, f]
  toHList :: (a, b, c, d, e, f) -> HList Identity (TupleArgs (a, b, c, d, e, f))
toHList (a
a, b
b, c
c, d
d, e
e, f
f) = Identity a
-> HList Identity '[b, c, d, e, f]
-> HList Identity '[a, b, c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (a -> Identity a
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (HList Identity '[b, c, d, e, f]
 -> HList Identity (TupleArgs (a, b, c, d, e, f)))
-> (HList Identity '[] -> HList Identity '[b, c, d, e, f])
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b, c, d, e, f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b
-> HList Identity '[c, d, e, f] -> HList Identity '[b, c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b) (HList Identity '[c, d, e, f] -> HList Identity '[b, c, d, e, f])
-> (HList Identity '[] -> HList Identity '[c, d, e, f])
-> HList Identity '[]
-> HList Identity '[b, c, d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity c
-> HList Identity '[d, e, f] -> HList Identity '[c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (c -> Identity c
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) (HList Identity '[d, e, f] -> HList Identity '[c, d, e, f])
-> (HList Identity '[] -> HList Identity '[d, e, f])
-> HList Identity '[]
-> HList Identity '[c, d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity d -> HList Identity '[e, f] -> HList Identity '[d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (d -> Identity d
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure d
d) (HList Identity '[e, f] -> HList Identity '[d, e, f])
-> (HList Identity '[] -> HList Identity '[e, f])
-> HList Identity '[]
-> HList Identity '[d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity e -> HList Identity '[f] -> HList Identity '[e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (e -> Identity e
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e) (HList Identity '[f] -> HList Identity '[e, f])
-> (HList Identity '[] -> HList Identity '[f])
-> HList Identity '[]
-> HList Identity '[e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity f -> HList Identity '[] -> HList Identity '[f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons (f -> Identity f
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f
f) (HList Identity '[]
 -> HList Identity (TupleArgs (a, b, c, d, e, f)))
-> HList Identity '[]
-> HList Identity (TupleArgs (a, b, c, d, e, f))
forall a b. (a -> b) -> a -> b
$ HList Identity '[]
forall {k} (f :: k -> *). HList f '[]
HNil

class (IsTuple a) => IsPredTuple m a where
  type ToPredTuple m a
  toHListPred :: proxy a -> ToPredTuple m a -> HList (Predicate m) (TupleArgs a)
instance IsPredTuple m (a, b) where
  type ToPredTuple m (a, b) = (Predicate m a, Predicate m b)
  toHListPred :: forall (proxy :: * -> *).
proxy (a, b)
-> ToPredTuple m (a, b) -> HList (Predicate m) (TupleArgs (a, b))
toHListPred proxy (a, b)
_ (Predicate m a
a, Predicate m b
b) = Predicate m a
-> HList (Predicate m) '[b] -> HList (Predicate m) '[a, b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
a (HList (Predicate m) '[b]
 -> HList (Predicate m) (TupleArgs (a, b)))
-> (HList (Predicate m) '[] -> HList (Predicate m) '[b])
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m b
-> HList (Predicate m) '[] -> HList (Predicate m) '[b]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
b (HList (Predicate m) '[] -> HList (Predicate m) (TupleArgs (a, b)))
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b))
forall a b. (a -> b) -> a -> b
$ HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsPredTuple m (a, b, c) where
  type ToPredTuple m (a, b, c) = (Predicate m a, Predicate m b, Predicate m c)
  toHListPred :: forall (proxy :: * -> *).
proxy (a, b, c)
-> ToPredTuple m (a, b, c)
-> HList (Predicate m) (TupleArgs (a, b, c))
toHListPred proxy (a, b, c)
_ (Predicate m a
a, Predicate m b
b, Predicate m c
c) = Predicate m a
-> HList (Predicate m) '[b, c] -> HList (Predicate m) '[a, b, c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
a (HList (Predicate m) '[b, c]
 -> HList (Predicate m) (TupleArgs (a, b, c)))
-> (HList (Predicate m) '[] -> HList (Predicate m) '[b, c])
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m b
-> HList (Predicate m) '[c] -> HList (Predicate m) '[b, c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
b (HList (Predicate m) '[c] -> HList (Predicate m) '[b, c])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[c])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[b, c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m c
-> HList (Predicate m) '[] -> HList (Predicate m) '[c]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m c
c (HList (Predicate m) '[]
 -> HList (Predicate m) (TupleArgs (a, b, c)))
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c))
forall a b. (a -> b) -> a -> b
$ HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsPredTuple m (a, b, c, d) where
  type ToPredTuple m (a, b, c, d) = (Predicate m a, Predicate m b, Predicate m c, Predicate m d)
  toHListPred :: forall (proxy :: * -> *).
proxy (a, b, c, d)
-> ToPredTuple m (a, b, c, d)
-> HList (Predicate m) (TupleArgs (a, b, c, d))
toHListPred proxy (a, b, c, d)
_ (Predicate m a
a, Predicate m b
b, Predicate m c
c, Predicate m d
d) = Predicate m a
-> HList (Predicate m) '[b, c, d]
-> HList (Predicate m) '[a, b, c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
a (HList (Predicate m) '[b, c, d]
 -> HList (Predicate m) (TupleArgs (a, b, c, d)))
-> (HList (Predicate m) '[] -> HList (Predicate m) '[b, c, d])
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m b
-> HList (Predicate m) '[c, d] -> HList (Predicate m) '[b, c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
b (HList (Predicate m) '[c, d] -> HList (Predicate m) '[b, c, d])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[c, d])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[b, c, d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m c
-> HList (Predicate m) '[d] -> HList (Predicate m) '[c, d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m c
c (HList (Predicate m) '[d] -> HList (Predicate m) '[c, d])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[d])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[c, d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m d
-> HList (Predicate m) '[] -> HList (Predicate m) '[d]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m d
d (HList (Predicate m) '[]
 -> HList (Predicate m) (TupleArgs (a, b, c, d)))
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d))
forall a b. (a -> b) -> a -> b
$ HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsPredTuple m (a, b, c, d, e) where
  type ToPredTuple m (a, b, c, d, e) = (Predicate m a, Predicate m b, Predicate m c, Predicate m d, Predicate m e)
  toHListPred :: forall (proxy :: * -> *).
proxy (a, b, c, d, e)
-> ToPredTuple m (a, b, c, d, e)
-> HList (Predicate m) (TupleArgs (a, b, c, d, e))
toHListPred proxy (a, b, c, d, e)
_ (Predicate m a
a, Predicate m b
b, Predicate m c
c, Predicate m d
d, Predicate m e
e) = Predicate m a
-> HList (Predicate m) '[b, c, d, e]
-> HList (Predicate m) '[a, b, c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
a (HList (Predicate m) '[b, c, d, e]
 -> HList (Predicate m) (TupleArgs (a, b, c, d, e)))
-> (HList (Predicate m) '[] -> HList (Predicate m) '[b, c, d, e])
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d, e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m b
-> HList (Predicate m) '[c, d, e]
-> HList (Predicate m) '[b, c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
b (HList (Predicate m) '[c, d, e]
 -> HList (Predicate m) '[b, c, d, e])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[c, d, e])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[b, c, d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m c
-> HList (Predicate m) '[d, e] -> HList (Predicate m) '[c, d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m c
c (HList (Predicate m) '[d, e] -> HList (Predicate m) '[c, d, e])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[d, e])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[c, d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m d
-> HList (Predicate m) '[e] -> HList (Predicate m) '[d, e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m d
d (HList (Predicate m) '[e] -> HList (Predicate m) '[d, e])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[e])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[d, e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m e
-> HList (Predicate m) '[] -> HList (Predicate m) '[e]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m e
e (HList (Predicate m) '[]
 -> HList (Predicate m) (TupleArgs (a, b, c, d, e)))
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d, e))
forall a b. (a -> b) -> a -> b
$ HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil
instance IsPredTuple m (a, b, c, d, e, f) where
  type ToPredTuple m (a, b, c, d, e, f) = (Predicate m a, Predicate m b, Predicate m c, Predicate m d, Predicate m e, Predicate m f)
  toHListPred :: forall (proxy :: * -> *).
proxy (a, b, c, d, e, f)
-> ToPredTuple m (a, b, c, d, e, f)
-> HList (Predicate m) (TupleArgs (a, b, c, d, e, f))
toHListPred proxy (a, b, c, d, e, f)
_ (Predicate m a
a, Predicate m b
b, Predicate m c
c, Predicate m d
d, Predicate m e
e, Predicate m f
f) = Predicate m a
-> HList (Predicate m) '[b, c, d, e, f]
-> HList (Predicate m) '[a, b, c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m a
a (HList (Predicate m) '[b, c, d, e, f]
 -> HList (Predicate m) (TupleArgs (a, b, c, d, e, f)))
-> (HList (Predicate m) '[]
    -> HList (Predicate m) '[b, c, d, e, f])
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d, e, f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m b
-> HList (Predicate m) '[c, d, e, f]
-> HList (Predicate m) '[b, c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m b
b (HList (Predicate m) '[c, d, e, f]
 -> HList (Predicate m) '[b, c, d, e, f])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[c, d, e, f])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[b, c, d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m c
-> HList (Predicate m) '[d, e, f]
-> HList (Predicate m) '[c, d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m c
c (HList (Predicate m) '[d, e, f]
 -> HList (Predicate m) '[c, d, e, f])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[d, e, f])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[c, d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m d
-> HList (Predicate m) '[e, f] -> HList (Predicate m) '[d, e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m d
d (HList (Predicate m) '[e, f] -> HList (Predicate m) '[d, e, f])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[e, f])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[d, e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m e
-> HList (Predicate m) '[f] -> HList (Predicate m) '[e, f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m e
e (HList (Predicate m) '[f] -> HList (Predicate m) '[e, f])
-> (HList (Predicate m) '[] -> HList (Predicate m) '[f])
-> HList (Predicate m) '[]
-> HList (Predicate m) '[e, f]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate m f
-> HList (Predicate m) '[] -> HList (Predicate m) '[f]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> HList f xs1 -> HList f (x : xs1)
HCons Predicate m f
f (HList (Predicate m) '[]
 -> HList (Predicate m) (TupleArgs (a, b, c, d, e, f)))
-> HList (Predicate m) '[]
-> HList (Predicate m) (TupleArgs (a, b, c, d, e, f))
forall a b. (a -> b) -> a -> b
$ HList (Predicate m) '[]
forall {k} (f :: k -> *). HList f '[]
HNil

-- | A predicate checking if the input matches a tuple matching the given predicates.
-- Works for tuples up to 6 elements.
--
-- >>> (1, 10, "hello world") `shouldSatisfy` P.tup (P.eq 1, P.gt 2, P.hasPrefix "hello ")
tup :: forall a m. (IsPredTuple m a, Monad m) => ToPredTuple m a -> Predicate m a
tup :: forall a (m :: * -> *).
(IsPredTuple m a, Monad m) =>
ToPredTuple m a -> Predicate m a
tup ToPredTuple m a
predTup =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual ->
        ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll [Text] -> Text
tupify ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HList (Predicate m) (TupleArgs a)
-> HList Identity (TupleArgs a) -> m [PredicateFuncResult]
forall (m :: * -> *) (xs :: [*]).
Monad m =>
HList (Predicate m) xs
-> HList Identity xs -> m [PredicateFuncResult]
runPredicates HList (Predicate m) (TupleArgs a)
preds (a -> HList Identity (TupleArgs a)
forall a. IsTuple a => a -> HList Identity (TupleArgs a)
toHList a
actual)
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  preds :: HList (Predicate m) (TupleArgs a)
preds = Proxy a -> ToPredTuple m a -> HList (Predicate m) (TupleArgs a)
forall (proxy :: * -> *).
proxy a -> ToPredTuple m a -> HList (Predicate m) (TupleArgs a)
forall (m :: * -> *) a (proxy :: * -> *).
IsPredTuple m a =>
proxy a -> ToPredTuple m a -> HList (Predicate m) (TupleArgs a)
toHListPred (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) ToPredTuple m a
predTup
  tupify :: [Text] -> Text
tupify [Text]
vals = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
vals Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  disp :: Text
disp = [Text] -> Text
tupify ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (forall x. Predicate m x -> Text)
-> HList (Predicate m) (TupleArgs a) -> [Text]
forall {k} (f :: k -> *) y (xs :: [k]).
(forall (x :: k). f x -> y) -> HList f xs -> [y]
HList.toListWith (.predicateDisp) HList (Predicate m) (TupleArgs a)
preds
  dispNeg :: Text
dispNeg = Text
"not " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp

-- | A predicate checking if the input matches the given constructor.
--
-- It takes one argument, which is the constructor, except with all fields
-- taking a Predicate instead of the normal value. Skeletest will rewrite
-- the expression so it typechecks correctly.
--
-- >>> User "user1" "user1@example.com" `shouldSatisfy` P.con User{name = P.eq "user1", email = P.contains "@"}
--
-- Record fields that are omitted are not checked at all; i.e.
-- @P.con Foo{}@ and @P.con Foo{a = P.anything}@ are equivalent.
--
-- Positional arguments work also, as well as dollar signs.
--
-- >>> let email = P.con $ Email P.anything (P.eq "example.com")
-- >>> user `shouldSatisfy` P.con User{email = email}
con :: a -> Predicate m a
con :: forall a (m :: * -> *). a -> Predicate m a
con =
  -- A placeholder that will be replaced with conMatches in the plugin.
  String -> a -> Predicate m a
forall a. HasCallStack => String -> a
invariantViolation String
"P.con was not replaced"

-- | A predicate for checking that a value matches the given constructor.
-- Assumes that the arguments correctly match the constructor being tested,
-- so it should not be written directly, only generated from `con`.
conMatches ::
  (Monad m) =>
  String ->
  Maybe (HList (Const String) fields) ->
  (a -> Maybe (HList Identity fields)) ->
  HList (Predicate m) fields ->
  Predicate m a
conMatches :: forall (m :: * -> *) (fields :: [*]) a.
Monad m =>
String
-> Maybe (HList (Const String) fields)
-> (a -> Maybe (HList Identity fields))
-> HList (Predicate m) fields
-> Predicate m a
conMatches String
conNameS Maybe (HList (Const String) fields)
mFieldNames a -> Maybe (HList Identity fields)
deconstruct HList (Predicate m) fields
preds =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual ->
        case a -> Maybe (HList Identity fields)
deconstruct a
actual of
          Just HList Identity fields
fields -> ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll [Text] -> Text
consify ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HList (Predicate m) fields
-> HList Identity fields -> m [PredicateFuncResult]
forall (m :: * -> *) (xs :: [*]).
Monad m =>
HList (Predicate m) xs
-> HList Identity xs -> m [PredicateFuncResult]
runPredicates HList (Predicate m) fields
preds HList Identity fields
fields
          Maybe (HList Identity fields)
Nothing ->
            PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              PredicateFuncResult
                { predicateSuccess :: Bool
predicateSuccess = Bool
False
                , predicateExplain :: Text
predicateExplain = a -> Text
forall a. a -> Text
render a
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
                , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
                }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  conName :: Text
conName = String -> Text
Text.pack String
conNameS
  disp :: Text
disp = Text
"matches " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
predsDisp
  dispNeg :: Text
dispNeg = Text
"does not match " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
predsDisp
  predsDisp :: Text
predsDisp = [Text] -> Text
consify ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (forall x. Predicate m x -> Text)
-> HList (Predicate m) fields -> [Text]
forall {k} (f :: k -> *) y (xs :: [k]).
(forall (x :: k). f x -> y) -> HList f xs -> [y]
HList.toListWith (.predicateDisp) HList (Predicate m) fields
preds

  -- consify ["= 1", "anything"] => User{id = (= 1), name = anything}
  -- consify ["= 1", "anything"] => Foo (= 1) anything
  consify :: [Text] -> Text
consify [Text]
vals =
    case HList (Const String) fields -> [String]
forall {k} a (xs :: [k]). HList (Const a) xs -> [a]
HList.uncheck (HList (Const String) fields -> [String])
-> Maybe (HList (Const String) fields) -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HList (Const String) fields)
mFieldNames of
      Maybe [String]
Nothing -> [Text] -> Text
Text.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
conName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
parens [Text]
vals
      Just [String]
fieldNames ->
        let fields :: [Text]
fields = (String -> Text -> Text) -> [String] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
field Text
v -> String -> Text
Text.pack String
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens Text
v) [String]
fieldNames [Text]
vals
         in Text
conName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
fields Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

{----- Numeric -----}

-- | A predicate checking if the input is equal to the given value within some tolerance.
--
-- Useful for checking equality with floats, which might not be exactly equal.
-- For more information, see: https://jvns.ca/blog/2023/01/13/examples-of-floating-point-problems/.
--
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol 0.3
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Just 1e-6} 0.3
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.abs = 1e-12} 0.3
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Just 1e-6, P.abs = 1e-12} 0.3
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Nothing} 0.3
-- >>> (0.1 + 0.2) `shouldSatisfy` P.approx P.tol{P.rel = Nothing, P.abs = 1e-12} 0.3
approx :: (Fractional a, Ord a, Monad m) => Tolerance -> a -> Predicate m a
approx :: forall a (m :: * -> *).
(Fractional a, Ord a, Monad m) =>
Tolerance -> a -> Predicate m a
approx Tolerance{Maybe Rational
Rational
rel :: Maybe Rational
abs :: Rational
abs :: Tolerance -> Rational
rel :: Tolerance -> Maybe Rational
..} =
  Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
"≈" Text
"≉" ((a -> a -> Bool) -> a -> Predicate m a)
-> (a -> a -> Bool) -> a -> Predicate m a
forall a b. (a -> b) -> a -> b
$ \a
actual a
expected ->
    a -> a
forall a. Num a => a -> a
Prelude.abs (a
actual a -> a -> a
forall a. Num a => a -> a -> a
- a
expected) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
getTolerance a
expected
 where
  mRelTol :: Maybe a
mRelTol = Rational -> a
forall {a}. Fractional a => Rational -> a
fromTol (Rational -> a) -> Maybe Rational -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Rational
rel
  absTol :: a
absTol = Rational -> a
forall {a}. Fractional a => Rational -> a
fromTol Rational
abs
  getTolerance :: a -> a
getTolerance a
expected =
    case Maybe a
mRelTol of
      Just a
relTol -> a -> a -> a
forall a. Ord a => a -> a -> a
max (a
relTol a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
Prelude.abs a
expected) a
absTol
      Maybe a
Nothing -> a
absTol

  fromTol :: Rational -> a
fromTol Rational
x
    | Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"tolerance can't be negative: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Rational -> String
forall a. Show a => a -> String
show Rational
x
    | Bool
otherwise = Rational -> a
forall {a}. Fractional a => Rational -> a
fromRational Rational
x

-- | The tolerance to use in 'approx'.
--
-- An input satisfies a tolerance if it's within the relative tolerance
-- (rel * input) or the absolute tolerance of the reference value.
data Tolerance = Tolerance
  { Tolerance -> Maybe Rational
rel :: Maybe Rational
  -- ^ If provided, the relative tolerance. Defaults to 1e-6.
  , Tolerance -> Rational
abs :: Rational
  -- ^ The absolute tolerance. Defaults to 1e-12.
  }

-- | The default tolerance for 'approx'.
tol :: Tolerance
tol :: Tolerance
tol = Tolerance{rel :: Maybe Rational
rel = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
1e-6, abs :: Rational
abs = Rational
1e-12}

{----- Combinators -----}

infixr 1 <<<, >>>

-- | A predicate checking if the input matches the given predicate, after applying the given function.
--
-- >>> "hello" `shouldSatisfy` (P.eq 5 P.<<< length)
(<<<) :: (Monad m) => Predicate m a -> (b -> a) -> Predicate m b
Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} <<< :: forall (m :: * -> *) a b.
Monad m =>
Predicate m a -> (b -> a) -> Predicate m b
<<< b -> a
f =
  Predicate
    { predicateFunc :: b -> m PredicateFuncResult
predicateFunc = (PredicateFuncResult -> PredicateFuncResult)
-> m PredicateFuncResult -> m PredicateFuncResult
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PredicateFuncResult -> PredicateFuncResult
showCtx (m PredicateFuncResult -> m PredicateFuncResult)
-> (b -> m PredicateFuncResult) -> b -> m PredicateFuncResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m PredicateFuncResult
predicateFunc (a -> m PredicateFuncResult)
-> (b -> a) -> b -> m PredicateFuncResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f
    , Text
predicateDisp :: Text
predicateDisp :: Text
predicateDisp
    , Text
predicateDispNeg :: Text
predicateDispNeg :: Text
predicateDispNeg
    }

-- | Same as '<<<', except with the arguments flipped.
--
-- >>> "hello" `shouldSatisfy` (length P.>>> P.eq 5)
(>>>) :: (Monad m) => (b -> a) -> Predicate m a -> Predicate m b
>>> :: forall (m :: * -> *) b a.
Monad m =>
(b -> a) -> Predicate m a -> Predicate m b
(>>>) = (Predicate m a -> (b -> a) -> Predicate m b)
-> (b -> a) -> Predicate m a -> Predicate m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Predicate m a -> (b -> a) -> Predicate m b
forall (m :: * -> *) a b.
Monad m =>
Predicate m a -> (b -> a) -> Predicate m b
(<<<)

-- | A predicate checking if the input does not match the given predicate
--
-- >>> Just 2 `shouldSatisfy` P.just (P.not (P.eq 1))
not :: (Monad m) => Predicate m a -> Predicate m a
not :: forall (m :: * -> *) a. Monad m => Predicate m a -> Predicate m a
not Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual -> do
        PredicateFuncResult
result <- PredicateFuncResult -> PredicateFuncResult
showCtx (PredicateFuncResult -> PredicateFuncResult)
-> m PredicateFuncResult -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m PredicateFuncResult
predicateFunc a
actual
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PredicateFuncResult
result{predicateSuccess = Prelude.not result.predicateSuccess}
    , predicateDisp :: Text
predicateDisp = Text
predicateDispNeg
    , predicateDispNeg :: Text
predicateDispNeg = Text
predicateDisp
    }

-- | A predicate checking if the input matches both of the given predicates
--
-- >>> 1 `shouldSatisfy` P.gt 0 P.&& P.lt 2
(&&) :: (Monad m) => Predicate m a -> Predicate m a -> Predicate m a
Predicate m a
p1 && :: forall (m :: * -> *) a.
Monad m =>
Predicate m a -> Predicate m a -> Predicate m a
&& Predicate m a
p2 = [Predicate m a] -> Predicate m a
forall (m :: * -> *) a. Monad m => [Predicate m a] -> Predicate m a
and [Predicate m a
p1, Predicate m a
p2]

-- | A predicate checking if the input matches one of the given predicates
--
-- >>> 1 `shouldSatisfy` P.lt 5 P.|| P.gt 10
(||) :: (Monad m) => Predicate m a -> Predicate m a -> Predicate m a
Predicate m a
p1 || :: forall (m :: * -> *) a.
Monad m =>
Predicate m a -> Predicate m a -> Predicate m a
|| Predicate m a
p2 = [Predicate m a] -> Predicate m a
forall (m :: * -> *) a. Monad m => [Predicate m a] -> Predicate m a
or [Predicate m a
p1, Predicate m a
p2]

-- | A predicate checking if the input matches all of the given predicates
--
-- >>> 1 `shouldSatisfy` P.and [P.gt 0, P.lt 2]
and :: (Monad m) => [Predicate m a] -> Predicate m a
and :: forall (m :: * -> *) a. Monad m => [Predicate m a] -> Predicate m a
and [Predicate m a]
preds =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual ->
        ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll (Text -> [Text] -> Text
forall a b. a -> b -> a
const Text
"All predicates passed") ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Predicate m a -> m PredicateFuncResult)
-> [Predicate m a] -> m [PredicateFuncResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Predicate m a
p -> Predicate m a
p.predicateFunc a
actual) [Predicate m a]
preds
    , predicateDisp :: Text
predicateDisp = [Text] -> Text
andify [Text]
predList
    , predicateDispNeg :: Text
predicateDispNeg = Text
"At least one failure:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
andify [Text]
predList
    }
 where
  andify :: [Text] -> Text
andify = Text -> [Text] -> Text
Text.intercalate Text
"\nand "
  predList :: [Text]
predList = (Predicate m a -> Text) -> [Predicate m a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
parens (Text -> Text) -> (Predicate m a -> Text) -> Predicate m a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.predicateDisp)) [Predicate m a]
preds

-- | A predicate checking if the input matches any of the given predicates
--
-- >>> 1 `shouldSatisfy` P.or [P.lt 5, P.gt 10]
or :: (Monad m) => [Predicate m a] -> Predicate m a
or :: forall (m :: * -> *) a. Monad m => [Predicate m a] -> Predicate m a
or [Predicate m a]
preds =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual ->
        ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAny (Text -> [Text] -> Text
forall a b. a -> b -> a
const Text
"No predicates passed") ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Predicate m a -> m PredicateFuncResult)
-> [Predicate m a] -> m [PredicateFuncResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Predicate m a
p -> Predicate m a
p.predicateFunc a
actual) [Predicate m a]
preds
    , predicateDisp :: Text
predicateDisp = [Text] -> Text
orify [Text]
predList
    , predicateDispNeg :: Text
predicateDispNeg = Text
"All failures:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
orify [Text]
predList
    }
 where
  orify :: [Text] -> Text
orify = Text -> [Text] -> Text
Text.intercalate Text
"\nor "
  predList :: [Text]
predList = (Predicate m a -> Text) -> [Predicate m a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
parens (Text -> Text) -> (Predicate m a -> Text) -> Predicate m a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.predicateDisp)) [Predicate m a]
preds

{----- Containers -----}

-- | A predicate checking if the input is a list-like type where some element matches the given predicate.
--
-- >>> [1, 2, 3] `shouldSatisfy` P.any (P.eq 1)
any :: (Foldable t, Monad m) => Predicate m a -> Predicate m (t a)
any :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
Predicate m a -> Predicate m (t a)
any Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} =
  Predicate
    { predicateFunc :: t a -> m PredicateFuncResult
predicateFunc = \t a
actual ->
        ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAny (Text -> [Text] -> Text
forall a b. a -> b -> a
const Text
"No values matched") ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m PredicateFuncResult) -> [a] -> m [PredicateFuncResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m PredicateFuncResult
predicateFunc (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
actual)
    , predicateDisp :: Text
predicateDisp = Text
"at least one element matching " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens Text
predicateDisp
    , predicateDispNeg :: Text
predicateDispNeg = Text
"no elements matching " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens Text
predicateDisp
    }

-- | A predicate checking if the input is a list-like type where all elements match the given predicate.
--
-- >>> [1, 2, 3] `shouldSatisfy` P.all (P.gt 0)
all :: (Foldable t, Monad m) => Predicate m a -> Predicate m (t a)
all :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
Predicate m a -> Predicate m (t a)
all Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} =
  Predicate
    { predicateFunc :: t a -> m PredicateFuncResult
predicateFunc = \t a
actual ->
        ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll (Text -> [Text] -> Text
forall a b. a -> b -> a
const Text
"All values matched") ([PredicateFuncResult] -> PredicateFuncResult)
-> m [PredicateFuncResult] -> m PredicateFuncResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m PredicateFuncResult) -> [a] -> m [PredicateFuncResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m PredicateFuncResult
predicateFunc (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
actual)
    , predicateDisp :: Text
predicateDisp = Text
"all elements matching " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens Text
predicateDisp
    , predicateDispNeg :: Text
predicateDispNeg = Text
"some elements not matching " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens Text
predicateDisp
    }

-- | A predicate checking if the input is a list-like type where the given element is present.
-- Equivalent to @P.any . P.eq@.
--
-- >>> [1, 2, 3] `shouldSatisfy` P.elem 1
elem :: (Eq a, Foldable t, Monad m) => a -> Predicate m (t a)
elem :: forall a (t :: * -> *) (m :: * -> *).
(Eq a, Foldable t, Monad m) =>
a -> Predicate m (t a)
elem = Predicate m a -> Predicate m (t a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
Predicate m a -> Predicate m (t a)
any (Predicate m a -> Predicate m (t a))
-> (a -> Predicate m a) -> a -> Predicate m (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Predicate m a
forall a (m :: * -> *). (Eq a, Monad m) => a -> Predicate m a
eq

{----- Subsequences -----}

class HasSubsequences a where
  isPrefixOf :: a -> a -> Bool
  isInfixOf :: a -> a -> Bool
  isSuffixOf :: a -> a -> Bool
  isEmpty :: a -> Bool
instance (Eq a) => HasSubsequences [a] where
  isPrefixOf :: [a] -> [a] -> Bool
isPrefixOf = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf
  isInfixOf :: [a] -> [a] -> Bool
isInfixOf = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isInfixOf
  isSuffixOf :: [a] -> [a] -> Bool
isSuffixOf = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isSuffixOf
  isEmpty :: [a] -> Bool
isEmpty = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null
instance HasSubsequences Text where
  isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
Text.isPrefixOf
  isInfixOf :: Text -> Text -> Bool
isInfixOf = Text -> Text -> Bool
Text.isInfixOf
  isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
Text.isSuffixOf
  isEmpty :: Text -> Bool
isEmpty = Text -> Bool
Text.null

-- | @since 0.4.0
instance HasSubsequences LazyText.Text where
  isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
LazyText.isPrefixOf
  isInfixOf :: Text -> Text -> Bool
isInfixOf = Text -> Text -> Bool
LazyText.isInfixOf
  isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
LazyText.isSuffixOf
  isEmpty :: Text -> Bool
isEmpty = Text -> Bool
LazyText.null

-- | A predicate checking if the input has the given prefix
--
-- >>> [1, 2, 3] `shouldSatisfy` P.hasPrefix [1, 2]
-- >>> "hello world" `shouldSatisfy` P.hasPrefix "hello "
hasPrefix :: (HasSubsequences a, Monad m) => a -> Predicate m a
hasPrefix :: forall a (m :: * -> *).
(HasSubsequences a, Monad m) =>
a -> Predicate m a
hasPrefix a
prefix =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
val -> do
        let success :: Bool
success = a
prefix a -> a -> Bool
forall a. HasSubsequences a => a -> a -> Bool
`isPrefixOf` a
val
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
success
            , predicateExplain :: Text
predicateExplain =
                if Bool
success
                  then a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp
                  else a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
"has prefix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
prefix
  dispNeg :: Text
dispNeg = Text
"does not have prefix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
prefix

-- | A predicate checking if the input contains the given subsequence
--
-- >>> [1, 2, 3] `shouldSatisfy` P.hasInfix [2]
-- >>> "hello world" `shouldSatisfy` P.hasInfix "ello"
hasInfix :: (HasSubsequences a, Monad m) => a -> Predicate m a
hasInfix :: forall a (m :: * -> *).
(HasSubsequences a, Monad m) =>
a -> Predicate m a
hasInfix a
elems =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
val -> do
        let success :: Bool
success = a
elems a -> a -> Bool
forall a. HasSubsequences a => a -> a -> Bool
`isInfixOf` a
val
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
success
            , predicateExplain :: Text
predicateExplain =
                if Bool
success
                  then a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp
                  else a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
"has infix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
elems
  dispNeg :: Text
dispNeg = Text
"does not have infix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
elems

-- | A predicate checking if the input has the given suffix
--
-- >>> [1, 2, 3] `shouldSatisfy` P.hasSuffix [2, 3]
-- >>> "hello world" `shouldSatisfy` P.hasSuffix " world"
hasSuffix :: (HasSubsequences a, Monad m) => a -> Predicate m a
hasSuffix :: forall a (m :: * -> *).
(HasSubsequences a, Monad m) =>
a -> Predicate m a
hasSuffix a
suffix =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
val -> do
        let success :: Bool
success = a
suffix a -> a -> Bool
forall a. HasSubsequences a => a -> a -> Bool
`isSuffixOf` a
val
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
success
            , predicateExplain :: Text
predicateExplain =
                if Bool
success
                  then a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp
                  else a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
"has suffix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
suffix
  dispNeg :: Text
dispNeg = Text
"does not have suffix " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
suffix

-- | A predicate checking if the input is empty.
--
-- >>> [] `shouldSatisfy` P.empty
-- >>> "" `shouldSatisfy` P.empty
--
-- @since 0.4.0
empty :: (HasSubsequences a, Monad m) => Predicate m a
empty :: forall a (m :: * -> *).
(HasSubsequences a, Monad m) =>
Predicate m a
empty =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
val -> do
        let success :: Bool
success = a -> Bool
forall a. HasSubsequences a => a -> Bool
isEmpty a
val
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
success
            , predicateExplain :: Text
predicateExplain =
                if Bool
success
                  then a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp
                  else a -> Text
forall a. a -> Text
render a
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
"is empty"
  dispNeg :: Text
dispNeg = Text
"is not empty"

{----- IO -----}

-- | A predicate checking if the input is an IO action that returns a value matching the given predicate.
--
-- >>> pure 1 `shouldSatisfy` P.returns (P.eq 1)
returns :: (MonadIO m) => Predicate m a -> Predicate m (m a)
returns :: forall (m :: * -> *) a.
MonadIO m =>
Predicate m a -> Predicate m (m a)
returns Predicate{Text
a -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: a -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} =
  Predicate
    { predicateFunc :: m a -> m PredicateFuncResult
predicateFunc = \m a
io -> do
        a
x <- m a
io
        PredicateFuncResult{Bool
Text
ShowFailCtx
predicateShowFailCtx :: PredicateFuncResult -> ShowFailCtx
predicateExplain :: PredicateFuncResult -> Text
predicateSuccess :: PredicateFuncResult -> Bool
predicateSuccess :: Bool
predicateExplain :: Text
predicateShowFailCtx :: ShowFailCtx
..} <- a -> m PredicateFuncResult
predicateFunc a
x
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
predicateSuccess
            , predicateExplain :: Text
predicateExplain =
                if Bool
predicateSuccess
                  then Text
predicateExplain
                  else
                    let failCtx :: FailCtx
failCtx =
                          FailCtx
                            { failCtxExpected :: Text
failCtxExpected = Text
predicateDisp
                            , failCtxActual :: Text
failCtxActual = a -> Text
forall a. a -> Text
render a
x
                            }
                     in FailCtx -> ShowFailCtx -> Text -> Text
withFailCtx FailCtx
failCtx ShowFailCtx
predicateShowFailCtx Text
predicateExplain
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
HideFailCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
predicateDisp
    , predicateDispNeg :: Text
predicateDispNeg = Text
predicateDispNeg
    }

-- | A predicate checking if the input is an IO action that throws an exception matching the given predicate.
--
-- >>> throwIO MyException `shouldSatisfy` P.throws (P.eq MyException)
throws :: (Exception e, MonadUnliftIO m) => Predicate m e -> Predicate m (m a)
throws :: forall e (m :: * -> *) a.
(Exception e, MonadUnliftIO m) =>
Predicate m e -> Predicate m (m a)
throws Predicate{Text
e -> m PredicateFuncResult
predicateFunc :: forall (m :: * -> *) a. Predicate m a -> a -> m PredicateFuncResult
predicateDisp :: forall (m :: * -> *) a. Predicate m a -> Text
predicateDispNeg :: forall (m :: * -> *) a. Predicate m a -> Text
predicateFunc :: e -> m PredicateFuncResult
predicateDisp :: Text
predicateDispNeg :: Text
..} =
  Predicate
    { predicateFunc :: m a -> m PredicateFuncResult
predicateFunc = \m a
io ->
        m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m a
io m (Either e a)
-> (Either e a -> m PredicateFuncResult) -> m PredicateFuncResult
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left e
e -> do
            PredicateFuncResult{Bool
Text
ShowFailCtx
predicateShowFailCtx :: PredicateFuncResult -> ShowFailCtx
predicateExplain :: PredicateFuncResult -> Text
predicateSuccess :: PredicateFuncResult -> Bool
predicateSuccess :: Bool
predicateExplain :: Text
predicateShowFailCtx :: ShowFailCtx
..} <- e -> m PredicateFuncResult
predicateFunc e
e
            PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              PredicateFuncResult
                { predicateSuccess :: Bool
predicateSuccess = Bool
predicateSuccess
                , predicateExplain :: Text
predicateExplain =
                    if Bool
predicateSuccess
                      then Text
predicateExplain
                      else
                        let failCtx :: FailCtx
failCtx =
                              FailCtx
                                { failCtxExpected :: Text
failCtxExpected = Text
disp
                                , failCtxActual :: Text
failCtxActual = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
e
                                }
                         in FailCtx -> ShowFailCtx -> Text -> Text
withFailCtx FailCtx
failCtx ShowFailCtx
predicateShowFailCtx Text
predicateExplain
                , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
HideFailCtx
                }
          Right a
x ->
            PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              PredicateFuncResult
                { predicateSuccess :: Bool
predicateSuccess = Bool
False
                , predicateExplain :: Text
predicateExplain =
                    FailCtx -> Text
renderFailCtx
                      FailCtx
                        { failCtxExpected :: Text
failCtxExpected = Text
disp
                        , failCtxActual :: Text
failCtxActual = a -> Text
forall a. a -> Text
render a
x
                        }
                , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
HideFailCtx
                }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
"throws (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
predicateDisp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  dispNeg :: Text
dispNeg = Text
"does not throw (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
predicateDisp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

{----- Utilities -----}

mkPredicateOp ::
  (Monad m) =>
  -- | operator
  Text ->
  -- | negative operator
  Text ->
  -- | actual -> expected -> success
  (a -> a -> Bool) ->
  -- | expected
  a ->
  Predicate m a
mkPredicateOp :: forall (m :: * -> *) a.
Monad m =>
Text -> Text -> (a -> a -> Bool) -> a -> Predicate m a
mkPredicateOp Text
op Text
negOp a -> a -> Bool
f a
expected =
  Predicate
    { predicateFunc :: a -> m PredicateFuncResult
predicateFunc = \a
actual -> do
        let success :: Bool
success = a -> a -> Bool
f a
actual a
expected
        PredicateFuncResult -> m PredicateFuncResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          PredicateFuncResult
            { predicateSuccess :: Bool
predicateSuccess = Bool
success
            , predicateExplain :: Text
predicateExplain =
                if Bool
success
                  then a -> Text
forall a. a -> Text
render a
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
disp
                  else a -> Text
forall a. a -> Text
render a
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dispNeg
            , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = ShowFailCtx
noCtx
            }
    , predicateDisp :: Text
predicateDisp = Text
disp
    , predicateDispNeg :: Text
predicateDispNeg = Text
dispNeg
    }
 where
  disp :: Text
disp = Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
expected
  dispNeg :: Text
dispNeg = Text
negOp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. a -> Text
render a
expected

runPredicates :: (Monad m) => HList (Predicate m) xs -> HList Identity xs -> m [PredicateFuncResult]
runPredicates :: forall (m :: * -> *) (xs :: [*]).
Monad m =>
HList (Predicate m) xs
-> HList Identity xs -> m [PredicateFuncResult]
runPredicates HList (Predicate m) xs
preds = (forall x. (:*:) (Predicate m) Identity x -> m PredicateFuncResult)
-> HList (Predicate m :*: Identity) xs -> m [PredicateFuncResult]
forall {k} (m :: * -> *) (f :: k -> *) y (xs :: [k]).
Monad m =>
(forall (x :: k). f x -> m y) -> HList f xs -> m [y]
HList.toListWithM (:*:) (Predicate m) Identity x -> m PredicateFuncResult
forall x. (:*:) (Predicate m) Identity x -> m PredicateFuncResult
forall (m :: * -> *) a.
(:*:) (Predicate m) Identity a -> m PredicateFuncResult
run (HList (Predicate m :*: Identity) xs -> m [PredicateFuncResult])
-> (HList Identity xs -> HList (Predicate m :*: Identity) xs)
-> HList Identity xs
-> m [PredicateFuncResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HList (Predicate m) xs
-> HList Identity xs -> HList (Predicate m :*: Identity) xs
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
HList f xs -> HList g xs -> HList (f :*: g) xs
HList.hzip HList (Predicate m) xs
preds
 where
  run :: (Predicate m :*: Identity) a -> m PredicateFuncResult
  run :: forall (m :: * -> *) a.
(:*:) (Predicate m) Identity a -> m PredicateFuncResult
run (Predicate m a
p :*: Identity a
x) = Predicate m a
p.predicateFunc a
x

verifyAll :: ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll :: ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAll [Text] -> Text
mergeMessages [PredicateFuncResult]
results =
  PredicateFuncResult
    { predicateSuccess :: Bool
predicateSuccess = Maybe PredicateFuncResult -> Bool
forall a. Maybe a -> Bool
isNothing Maybe PredicateFuncResult
firstFailure
    , predicateExplain :: Text
predicateExplain =
        case Maybe PredicateFuncResult
firstFailure of
          Just PredicateFuncResult
p -> PredicateFuncResult
p.predicateExplain
          Maybe PredicateFuncResult
Nothing -> [Text] -> Text
mergeMessages ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (PredicateFuncResult -> Text) -> [PredicateFuncResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (.predicateExplain) [PredicateFuncResult]
results
    , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = [PredicateFuncResult] -> ShowFailCtx
showMergedCtxs [PredicateFuncResult]
results
    }
 where
  firstFailure :: Maybe PredicateFuncResult
firstFailure = [PredicateFuncResult] -> Maybe PredicateFuncResult
forall a. [a] -> Maybe a
listToMaybe ([PredicateFuncResult] -> Maybe PredicateFuncResult)
-> [PredicateFuncResult] -> Maybe PredicateFuncResult
forall a b. (a -> b) -> a -> b
$ (PredicateFuncResult -> Bool)
-> [PredicateFuncResult] -> [PredicateFuncResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
Prelude.not (Bool -> Bool)
-> (PredicateFuncResult -> Bool) -> PredicateFuncResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.predicateSuccess)) [PredicateFuncResult]
results

verifyAny :: ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAny :: ([Text] -> Text) -> [PredicateFuncResult] -> PredicateFuncResult
verifyAny [Text] -> Text
mergeMessages [PredicateFuncResult]
results =
  PredicateFuncResult
    { predicateSuccess :: Bool
predicateSuccess = Maybe PredicateFuncResult -> Bool
forall a. Maybe a -> Bool
isJust Maybe PredicateFuncResult
firstSuccess
    , predicateExplain :: Text
predicateExplain =
        case Maybe PredicateFuncResult
firstSuccess of
          Just PredicateFuncResult
p -> PredicateFuncResult
p.predicateExplain
          Maybe PredicateFuncResult
Nothing -> [Text] -> Text
mergeMessages ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (PredicateFuncResult -> Text) -> [PredicateFuncResult] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (.predicateExplain) [PredicateFuncResult]
results
    , predicateShowFailCtx :: ShowFailCtx
predicateShowFailCtx = [PredicateFuncResult] -> ShowFailCtx
showMergedCtxs [PredicateFuncResult]
results
    }
 where
  firstSuccess :: Maybe PredicateFuncResult
firstSuccess = [PredicateFuncResult] -> Maybe PredicateFuncResult
forall a. [a] -> Maybe a
listToMaybe ([PredicateFuncResult] -> Maybe PredicateFuncResult)
-> [PredicateFuncResult] -> Maybe PredicateFuncResult
forall a b. (a -> b) -> a -> b
$ (PredicateFuncResult -> Bool)
-> [PredicateFuncResult] -> [PredicateFuncResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (.predicateSuccess) [PredicateFuncResult]
results

render :: a -> Text
render :: forall a. a -> Text
render = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. a -> String
anythingToString