{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use null" #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Test.MockCat.Verify where

import Control.Concurrent.STM (TVar, readTVarIO)
import Test.MockCat.Internal.Types
import Control.Monad (guard, when, unless)
import Data.List (elemIndex, intercalate)
import Data.Maybe
import Test.MockCat.Param
import Prelude hiding (lookup)
import GHC.Stack (HasCallStack)
import Test.MockCat.Internal.Message
import Data.Kind (Type, Constraint)
import Test.MockCat.Cons ((:>))
import Data.Typeable (Typeable, eqT)
import Test.MockCat.Internal.MockRegistry (lookupVerifierForFn, withAllUnitGuards)
import Data.Type.Equality ((:~:) (Refl))
import Data.Dynamic (fromDynamic)
import GHC.TypeLits (TypeError, ErrorMessage(..), Symbol)

-- | Class for verifying mock function.
verify ::
  ( ResolvableMock m
  , Eq (ResolvableParamsOf m)
  , Show (ResolvableParamsOf m)
  ) =>
  m ->
  VerifyMatchType (ResolvableParamsOf m) ->
  IO ()
verify :: forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
verify m
m VerifyMatchType (ResolvableParamsOf m)
matchType = do
  ResolvedMock Maybe [Char]
mockName InvocationRecorder (ResolvableParamsOf m)
recorder <- m -> IO (ResolvedMock (ResolvableParamsOf m))
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
  InvocationList (ResolvableParamsOf m)
invocationList <- TVar (InvocationRecord (ResolvableParamsOf m))
-> IO (InvocationList (ResolvableParamsOf m))
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder (ResolvableParamsOf m)
-> TVar (InvocationRecord (ResolvableParamsOf m))
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder (ResolvableParamsOf m)
recorder)
  case Maybe [Char]
-> InvocationList (ResolvableParamsOf m)
-> VerifyMatchType (ResolvableParamsOf m)
-> Maybe VerifyFailed
forall a.
(Eq a, Show a) =>
Maybe [Char]
-> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed
doVerify Maybe [Char]
mockName InvocationList (ResolvableParamsOf m)
invocationList VerifyMatchType (ResolvableParamsOf m)
matchType of
    Maybe VerifyFailed
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (VerifyFailed [Char]
msg) ->
      [Char] -> Any
forall a. [Char] -> a
errorWithoutStackTrace [Char]
msg Any -> IO () -> IO ()
forall a b. a -> b -> b
`seq` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

doVerify :: (Eq a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed
doVerify :: forall a.
(Eq a, Show a) =>
Maybe [Char]
-> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed
doVerify Maybe [Char]
name InvocationList a
list (MatchAny a
a) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ a -> InvocationList a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem a
a InvocationList a
list
  VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> InvocationList a -> a -> VerifyFailed
forall a.
Show a =>
Maybe [Char] -> InvocationList a -> a -> VerifyFailed
verifyFailedMessage Maybe [Char]
name InvocationList a
list a
a
doVerify Maybe [Char]
name InvocationList a
list (MatchAll a
a) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> InvocationList a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Prelude.any (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) InvocationList a
list
  VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> InvocationList a -> a -> VerifyFailed
forall a.
Show a =>
Maybe [Char] -> InvocationList a -> a -> VerifyFailed
verifyFailedMessage Maybe [Char]
name InvocationList a
list a
a

readInvocationList :: TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList :: forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList TVar (InvocationRecord params)
ref = do
  InvocationRecord params
record <- TVar (InvocationRecord params) -> IO (InvocationRecord params)
forall a. TVar a -> IO a
readTVarIO TVar (InvocationRecord params)
ref
  InvocationList params -> IO (InvocationList params)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InvocationList params -> IO (InvocationList params))
-> InvocationList params -> IO (InvocationList params)
forall a b. (a -> b) -> a -> b
$ InvocationRecord params -> InvocationList params
forall params. InvocationRecord params -> InvocationList params
invocations InvocationRecord params
record

-- | Verify that a resolved mock function was called at least once.
--   This is used internally by typeclass mock verification.
verifyResolvedAny :: ResolvedMock params -> IO ()
verifyResolvedAny :: forall params. ResolvedMock params -> IO ()
verifyResolvedAny (ResolvedMock Maybe [Char]
mockName InvocationRecorder params
recorder) = do
  InvocationList params
invocationList <- TVar (InvocationRecord params) -> IO (InvocationList params)
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder params -> TVar (InvocationRecord params)
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder params
recorder)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InvocationList params -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null InvocationList params
invocationList) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
        [Char]
"\n"
        [ [Char]
"Function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
mockName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was never called"
        ]



compareCount :: CountVerifyMethod -> Int -> Bool
compareCount :: CountVerifyMethod -> Int -> Bool
compareCount (Equal Int
e) Int
a = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e
compareCount (LessThanEqual Int
e) Int
a = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e
compareCount (LessThan Int
e) Int
a = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e
compareCount (GreaterThanEqual Int
e) Int
a = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e
compareCount (GreaterThan Int
e) Int
a = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
e

verifyCount ::
  ( ResolvableMock m
  , Eq (ResolvableParamsOf m)
  ) =>
  m ->
  ResolvableParamsOf m ->
  CountVerifyMethod ->
  IO ()
verifyCount :: forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m)) =>
m -> ResolvableParamsOf m -> CountVerifyMethod -> IO ()
verifyCount m
m ResolvableParamsOf m
v CountVerifyMethod
method = do
  ResolvedMock Maybe [Char]
mockName InvocationRecorder (ResolvableParamsOf m)
recorder <- m -> IO (ResolvedMock (ResolvableParamsOf m))
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
  InvocationList (ResolvableParamsOf m)
invocationList <- TVar (InvocationRecord (ResolvableParamsOf m))
-> IO (InvocationList (ResolvableParamsOf m))
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder (ResolvableParamsOf m)
-> TVar (InvocationRecord (ResolvableParamsOf m))
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder (ResolvableParamsOf m)
recorder)
  let callCount :: Int
callCount = InvocationList (ResolvableParamsOf m) -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((ResolvableParamsOf m -> Bool)
-> InvocationList (ResolvableParamsOf m)
-> InvocationList (ResolvableParamsOf m)
forall a. (a -> Bool) -> [a] -> [a]
filter (ResolvableParamsOf m
v ResolvableParamsOf m -> ResolvableParamsOf m -> Bool
forall a. Eq a => a -> a -> Bool
==) InvocationList (ResolvableParamsOf m)
invocationList)
  if CountVerifyMethod -> Int -> Bool
compareCount CountVerifyMethod
method Int
callCount
    then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else
      [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe [Char] -> CountVerifyMethod -> Int -> [Char]
countWithArgsMismatchMessage Maybe [Char]
mockName CountVerifyMethod
method Int
callCount

-- | Generate error message for count mismatch with arguments
countWithArgsMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String
countWithArgsMismatchMessage :: Maybe [Char] -> CountVerifyMethod -> Int -> [Char]
countWithArgsMismatchMessage Maybe [Char]
mockName CountVerifyMethod
method Int
callCount =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
    [Char]
"\n"
    [ [Char]
"function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
mockName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was not called the expected number of times with the expected arguments.",
      [Char]
"  expected: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> CountVerifyMethod -> [Char]
forall a. Show a => a -> [Char]
show CountVerifyMethod
method,
      [Char]
"   but got: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
callCount
    ]



verifyOrder ::
  (ResolvableMock m
  , Eq (ResolvableParamsOf m)
  , Show (ResolvableParamsOf m)) =>
  VerifyOrderMethod ->
  m ->
  [ResolvableParamsOf m] ->
  IO ()
verifyOrder :: forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
VerifyOrderMethod -> m -> [ResolvableParamsOf m] -> IO ()
verifyOrder VerifyOrderMethod
method m
m [ResolvableParamsOf m]
matchers = do
  ResolvedMock Maybe [Char]
mockName InvocationRecorder (ResolvableParamsOf m)
recorder <- m -> IO (ResolvedMock (ResolvableParamsOf m))
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
  [ResolvableParamsOf m]
invocationList <- TVar (InvocationRecord (ResolvableParamsOf m))
-> IO [ResolvableParamsOf m]
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder (ResolvableParamsOf m)
-> TVar (InvocationRecord (ResolvableParamsOf m))
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder (ResolvableParamsOf m)
recorder)
  case VerifyOrderMethod
-> Maybe [Char]
-> [ResolvableParamsOf m]
-> [ResolvableParamsOf m]
-> Maybe VerifyFailed
forall a.
(Eq a, Show a) =>
VerifyOrderMethod
-> Maybe [Char]
-> InvocationList a
-> InvocationList a
-> Maybe VerifyFailed
doVerifyOrder VerifyOrderMethod
method Maybe [Char]
mockName [ResolvableParamsOf m]
invocationList [ResolvableParamsOf m]
matchers of
    Maybe VerifyFailed
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (VerifyFailed [Char]
msg) ->
      [Char] -> Any
forall a. [Char] -> a
errorWithoutStackTrace [Char]
msg Any -> IO () -> IO ()
forall a b. a -> b -> b
`seq` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

doVerifyOrder ::
  (Eq a, Show a) =>
  VerifyOrderMethod ->
  Maybe MockName ->
  InvocationList a ->
  [a] ->
  Maybe VerifyFailed
doVerifyOrder :: forall a.
(Eq a, Show a) =>
VerifyOrderMethod
-> Maybe [Char]
-> InvocationList a
-> InvocationList a
-> Maybe VerifyFailed
doVerifyOrder VerifyOrderMethod
ExactlySequence Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues
  | InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
calledValues Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
expectedValues = do
      VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
forall a.
Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
verifyFailedOrderParamCountMismatch Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues
  | Bool
otherwise = do
      let unexpectedOrders :: [VerifyOrderResult a]
unexpectedOrders = InvocationList a -> InvocationList a -> [VerifyOrderResult a]
forall a.
Eq a =>
InvocationList a -> InvocationList a -> [VerifyOrderResult a]
collectUnExpectedOrder InvocationList a
calledValues InvocationList a
expectedValues
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [VerifyOrderResult a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VerifyOrderResult a]
unexpectedOrders Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [VerifyOrderResult a] -> VerifyFailed
forall a.
Show a =>
Maybe [Char] -> [VerifyOrderResult a] -> VerifyFailed
verifyFailedSequence Maybe [Char]
name [VerifyOrderResult a]
unexpectedOrders
doVerifyOrder VerifyOrderMethod
PartiallySequence Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues
  | InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
calledValues Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
expectedValues = do
      VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
forall a.
Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
verifyFailedOrderParamCountMismatch Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues
  | Bool
otherwise = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InvocationList a -> InvocationList a -> Bool
forall a. Eq a => InvocationList a -> InvocationList a -> Bool
isOrderNotMatched InvocationList a
calledValues InvocationList a
expectedValues
      VerifyFailed -> Maybe VerifyFailed
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerifyFailed -> Maybe VerifyFailed)
-> VerifyFailed -> Maybe VerifyFailed
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
forall a.
Show a =>
Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
verifyFailedPartiallySequence Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues

verifyFailedPartiallySequence :: Show a => Maybe MockName -> InvocationList a -> [a] -> VerifyFailed
verifyFailedPartiallySequence :: forall a.
Show a =>
Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
verifyFailedPartiallySequence Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues =
  [Char] -> VerifyFailed
VerifyFailed ([Char] -> VerifyFailed) -> [Char] -> VerifyFailed
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
      [Char]
"\n"
      [ [Char]
"function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was not called with the expected arguments in the expected order.",
        [Char]
"  expected order:",
        [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
"    " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show (a -> [Char]) -> InvocationList a -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvocationList a
expectedValues,
        [Char]
"  but got:",
        [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
"    " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show (a -> [Char]) -> InvocationList a -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvocationList a
calledValues
      ]

isOrderNotMatched :: Eq a => InvocationList a -> [a] -> Bool
isOrderNotMatched :: forall a. Eq a => InvocationList a -> InvocationList a -> Bool
isOrderNotMatched InvocationList a
calledValues InvocationList a
expectedValues =
  Maybe (InvocationList a) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (InvocationList a) -> Bool)
-> Maybe (InvocationList a) -> Bool
forall a b. (a -> b) -> a -> b
$
    (Maybe (InvocationList a) -> a -> Maybe (InvocationList a))
-> Maybe (InvocationList a)
-> InvocationList a
-> Maybe (InvocationList a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
      ( \Maybe (InvocationList a)
candidates a
e -> do
          Maybe (InvocationList a)
candidates Maybe (InvocationList a)
-> (InvocationList a -> Maybe (InvocationList a))
-> Maybe (InvocationList a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InvocationList a
c -> do
            Int
index <- a -> InvocationList a -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
e InvocationList a
c
            InvocationList a -> Maybe (InvocationList a)
forall a. a -> Maybe a
Just (InvocationList a -> Maybe (InvocationList a))
-> InvocationList a -> Maybe (InvocationList a)
forall a b. (a -> b) -> a -> b
$ Int -> InvocationList a -> InvocationList a
forall a. Int -> [a] -> [a]
drop (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) InvocationList a
c
      )
      (InvocationList a -> Maybe (InvocationList a)
forall a. a -> Maybe a
Just InvocationList a
calledValues)
      InvocationList a
expectedValues

verifyFailedOrderParamCountMismatch :: Maybe MockName -> InvocationList a -> [a] -> VerifyFailed
verifyFailedOrderParamCountMismatch :: forall a.
Maybe [Char]
-> InvocationList a -> InvocationList a -> VerifyFailed
verifyFailedOrderParamCountMismatch Maybe [Char]
name InvocationList a
calledValues InvocationList a
expectedValues =
  [Char] -> VerifyFailed
VerifyFailed ([Char] -> VerifyFailed) -> [Char] -> VerifyFailed
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
      [Char]
"\n"
      [ [Char]
"function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was not called with the expected arguments in the expected order (count mismatch).",
        [Char]
"  expected: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
expectedValues),
        [Char]
"   but got: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (InvocationList a -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList a
calledValues)
      ]

verifyFailedSequence :: Show a => Maybe MockName -> [VerifyOrderResult a] -> VerifyFailed
verifyFailedSequence :: forall a.
Show a =>
Maybe [Char] -> [VerifyOrderResult a] -> VerifyFailed
verifyFailedSequence Maybe [Char]
name [VerifyOrderResult a]
fails =
  [Char] -> VerifyFailed
VerifyFailed ([Char] -> VerifyFailed) -> [Char] -> VerifyFailed
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
      [Char]
"\n"
      ( ([Char]
"function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was not called with the expected arguments in the expected order.") [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (VerifyOrderResult a -> [Char]
forall a. Show a => VerifyOrderResult a -> [Char]
verifyOrderFailedMesssage (VerifyOrderResult a -> [Char])
-> [VerifyOrderResult a] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VerifyOrderResult a]
fails)
      )



collectUnExpectedOrder :: Eq a => InvocationList a -> [a] -> [VerifyOrderResult a]
collectUnExpectedOrder :: forall a.
Eq a =>
InvocationList a -> InvocationList a -> [VerifyOrderResult a]
collectUnExpectedOrder InvocationList a
calledValues InvocationList a
expectedValues =
  [Maybe (VerifyOrderResult a)] -> [VerifyOrderResult a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (VerifyOrderResult a)] -> [VerifyOrderResult a])
-> [Maybe (VerifyOrderResult a)] -> [VerifyOrderResult a]
forall a b. (a -> b) -> a -> b
$
    (Int -> a -> Maybe (VerifyOrderResult a))
-> InvocationList a -> [Maybe (VerifyOrderResult a)]
forall a b. (Int -> a -> b) -> [a] -> [b]
mapWithIndex
      ( \Int
i a
expectedValue -> do
          let calledValue :: a
calledValue = InvocationList a
calledValues InvocationList a -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ a
expectedValue a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
calledValue
          VerifyOrderResult a -> Maybe (VerifyOrderResult a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerifyOrderResult {index :: Int
index = Int
i, calledValue :: a
calledValue = a
calledValue, a
expectedValue :: a
expectedValue :: a
expectedValue}
      )
      InvocationList a
expectedValues

mapWithIndex :: (Int -> a -> b) -> [a] -> [b]
mapWithIndex :: forall a b. (Int -> a -> b) -> [a] -> [b]
mapWithIndex Int -> a -> b
f [a]
xs = [Int -> a -> b
f Int
i a
x | (Int
i, a
x) <- [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
xs]

-- Legacy shouldApply* helpers removed. Use shouldBeCalled API instead.

type family PrependParam a rest where
  PrependParam a () = Param a
  PrependParam a rest = Param a :> rest

type family FunctionParams fn where
  FunctionParams (a -> fn) = PrependParam a (FunctionParams fn)
  FunctionParams fn = ()

type family ResolvableParamsOf target :: Type where
  ResolvableParamsOf (a -> fn) = FunctionParams (a -> fn)
  ResolvableParamsOf target = ()

type family Or (a :: Bool) (b :: Bool) :: Bool where
  Or 'True _ = 'True
  Or _ 'True = 'True
  Or 'False 'False = 'False

type family Not (a :: Bool) :: Bool where
  Not 'True = 'False
  Not 'False = 'True

type family IsFunctionType target :: Bool where
  IsFunctionType (_a -> _b) = 'True
  IsFunctionType _ = 'False

type family IsIOType target :: Bool where
  IsIOType (IO _) = 'True
  IsIOType _ = 'False

type family IsPureConstant target :: Bool where
  IsPureConstant target = Not (Or (IsFunctionType target) (IsIOType target))

type family RequireCallable (fn :: Symbol) target :: Constraint where
  RequireCallable fn target =
    RequireCallableImpl fn (IsPureConstant target) target

type family RequireCallableImpl (fn :: Symbol) (isPure :: Bool) target :: Constraint where
  RequireCallableImpl fn 'True target =
    TypeError
      ( 'Text fn ':<>: 'Text " is not available for pure constant mocks."
          ':$$: 'Text "  target type: " ':<>: 'ShowType target
          ':$$: 'Text "  hint: convert it into a callable mock or use shouldBeCalled with 'anything'."
      )
  RequireCallableImpl _ 'False _ = ()

-- | Constraint alias for resolvable mock types.
type ResolvableMock m = (Typeable (ResolvableParamsOf m), Typeable (InvocationRecorder (ResolvableParamsOf m)))

-- | Constraint alias for resolvable mock types with specific params.
type ResolvableMockWithParams m params = (ResolvableParamsOf m ~ params, ResolvableMock m)

resolveForVerification ::
  forall target params.
  ( params ~ ResolvableParamsOf target
  , Typeable params
  , Typeable (InvocationRecorder params)
  ) =>
  target ->
  IO (Maybe (Maybe MockName, InvocationRecorder params))
resolveForVerification :: forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (Maybe (Maybe [Char], InvocationRecorder params))
resolveForVerification target
target = do
  let fetch :: IO (Maybe (Maybe [Char], Dynamic))
fetch = target -> IO (Maybe (Maybe [Char], Dynamic))
forall fn. fn -> IO (Maybe (Maybe [Char], Dynamic))
lookupVerifierForFn target
target
  Maybe (Maybe [Char], Dynamic)
result <-
    case Maybe (params :~: ())
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (params :~: ()) of
      Just params :~: ()
Refl -> IO (Maybe (Maybe [Char], Dynamic))
-> IO (Maybe (Maybe [Char], Dynamic))
forall a. IO a -> IO a
withAllUnitGuards IO (Maybe (Maybe [Char], Dynamic))
fetch
      Maybe (params :~: ())
Nothing -> IO (Maybe (Maybe [Char], Dynamic))
fetch
  case Maybe (Maybe [Char], Dynamic)
result of
    Maybe (Maybe [Char], Dynamic)
Nothing -> Maybe (Maybe [Char], InvocationRecorder params)
-> IO (Maybe (Maybe [Char], InvocationRecorder params))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe [Char], InvocationRecorder params)
forall a. Maybe a
Nothing
    Just (Maybe [Char]
name, Dynamic
dynVerifier) ->
      case forall a. Typeable a => Dynamic -> Maybe a
fromDynamic @(InvocationRecorder params) Dynamic
dynVerifier of
        Just InvocationRecorder params
verifier -> Maybe (Maybe [Char], InvocationRecorder params)
-> IO (Maybe (Maybe [Char], InvocationRecorder params))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe [Char], InvocationRecorder params)
 -> IO (Maybe (Maybe [Char], InvocationRecorder params)))
-> Maybe (Maybe [Char], InvocationRecorder params)
-> IO (Maybe (Maybe [Char], InvocationRecorder params))
forall a b. (a -> b) -> a -> b
$ (Maybe [Char], InvocationRecorder params)
-> Maybe (Maybe [Char], InvocationRecorder params)
forall a. a -> Maybe a
Just (Maybe [Char]
name, InvocationRecorder params
verifier)
        Maybe (InvocationRecorder params)
Nothing -> Maybe (Maybe [Char], InvocationRecorder params)
-> IO (Maybe (Maybe [Char], InvocationRecorder params))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe [Char], InvocationRecorder params)
forall a. Maybe a
Nothing


-- | Verify that a function was called the expected number of times
verifyCallCount ::
  Maybe MockName ->
  InvocationRecorder params ->
  CountVerifyMethod ->
  IO ()
verifyCallCount :: forall params.
Maybe [Char]
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
verifyCallCount Maybe [Char]
maybeName InvocationRecorder params
recorder CountVerifyMethod
method = do
  InvocationList params
invocationList <- TVar (InvocationRecord params) -> IO (InvocationList params)
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder params -> TVar (InvocationRecord params)
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder params
recorder)
  let callCount :: Int
callCount = InvocationList params -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length InvocationList params
invocationList
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CountVerifyMethod -> Int -> Bool
compareCount CountVerifyMethod
method Int
callCount) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
      Maybe [Char] -> CountVerifyMethod -> Int -> [Char]
countMismatchMessage Maybe [Char]
maybeName CountVerifyMethod
method Int
callCount

-- | Generate error message for count mismatch
countMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String
countMismatchMessage :: Maybe [Char] -> CountVerifyMethod -> Int -> [Char]
countMismatchMessage Maybe [Char]
maybeName CountVerifyMethod
method Int
callCount =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
    [Char]
"\n"
    [ [Char]
"function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
maybeName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was not called the expected number of times.",
      [Char]
"  expected: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> CountVerifyMethod -> [Char]
showCountMethod CountVerifyMethod
method,
      [Char]
"   but got: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
callCount
    ]
  where
    showCountMethod :: CountVerifyMethod -> [Char]
showCountMethod (Equal Int
n) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    showCountMethod (LessThanEqual Int
n) = [Char]
"<= " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    showCountMethod (GreaterThanEqual Int
n) = [Char]
">= " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    showCountMethod (LessThan Int
n) = [Char]
"< " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    showCountMethod (GreaterThan Int
n) = [Char]
"> " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n

verificationFailure :: IO a
verificationFailure :: forall a. IO a
verificationFailure =
  [Char] -> IO a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
verificationFailureMessage

data ResolvedMock params = ResolvedMock {
  forall params. ResolvedMock params -> Maybe [Char]
resolvedMockName :: Maybe MockName,
  forall params. ResolvedMock params -> InvocationRecorder params
resolvedMockRecorder :: InvocationRecorder params
}

requireResolved ::
  forall target params.
  ( params ~ ResolvableParamsOf target
  , Typeable params
  , Typeable (InvocationRecorder params)
  ) =>
  target ->
  IO (ResolvedMock params)
requireResolved :: forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved target
target = do
  target -> IO (Maybe (Maybe [Char], InvocationRecorder params))
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (Maybe (Maybe [Char], InvocationRecorder params))
resolveForVerification target
target IO (Maybe (Maybe [Char], InvocationRecorder params))
-> (Maybe (Maybe [Char], InvocationRecorder params)
    -> IO (ResolvedMock params))
-> IO (ResolvedMock params)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Maybe [Char]
name, InvocationRecorder params
recorder) -> ResolvedMock params -> IO (ResolvedMock params)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolvedMock params -> IO (ResolvedMock params))
-> ResolvedMock params -> IO (ResolvedMock params)
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> InvocationRecorder params -> ResolvedMock params
forall params.
Maybe [Char] -> InvocationRecorder params -> ResolvedMock params
ResolvedMock Maybe [Char]
name InvocationRecorder params
recorder
    Maybe (Maybe [Char], InvocationRecorder params)
Nothing -> IO (ResolvedMock params)
forall a. IO a
verificationFailure

verificationFailureMessage :: String
verificationFailureMessage :: [Char]
verificationFailureMessage =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
    [Char]
"\n"
    [ [Char]
"Error: 'shouldBeCalled' can only verify functions created by 'mock'.",
      [Char]
"",
      [Char]
"The value you passed could not be recognized as a mock function.",
      [Char]
"",
      [Char]
"This usually happens in one of the following cases:",
      [Char]
"  - You passed a normal (non-mock) function.",
      [Char]
"  - You passed a stub or value not created via 'mock' / 'mockIO'.",
      [Char]
"  - You are trying to verify a value that was never registered as a mock.",
      [Char]
"",
      [Char]
"How to fix it:",
      [Char]
"  1. Make sure you created the function with 'mock' (or 'mockIO' for IO)",
      [Char]
"     before calling 'shouldBeCalled'.",
      [Char]
"  2. Pass that mock value directly to 'shouldBeCalled'",
      [Char]
"     (not the original function or a plain value).",
      [Char]
"",
      [Char]
"If this message still appears, check that:",
      [Char]
"  - You are not passing a pure constant.",
      [Char]
"  - The mock value is still in scope where 'shouldBeCalled' is used.",
      [Char]
"",
      [Char]
"Tip: If you prefer automatic verification,",
      [Char]
"consider using 'withMock', which runs all expectations at the end",
      [Char]
"of the block."
    ]

-- ============================================
-- shouldBeCalled API
-- ============================================

-- | Verification specification for shouldBeCalled
data VerificationSpec params where
  -- | Count verification with specific arguments
  CountVerification :: CountVerifyMethod -> params -> VerificationSpec params
  -- | Count verification without arguments (any arguments)
  CountAnyVerification :: CountVerifyMethod -> VerificationSpec params
  -- | Order verification
  OrderVerification :: VerifyOrderMethod -> [params] -> VerificationSpec params
  -- | Simple verification with arguments (at least once)
  SimpleVerification :: params -> VerificationSpec params
  -- | Simple verification without arguments (at least once, any arguments)
  AnyVerification :: VerificationSpec params

-- | Times condition for count verification
newtype TimesSpec = TimesSpec CountVerifyMethod

-- | Create a times condition for exact count.
--
--   > f `shouldBeCalled` times 3
--   > f `shouldBeCalled` (times 3 `with` "arg")
times :: Int -> TimesSpec
times :: Int -> TimesSpec
times Int
n = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
Equal Int
n)

-- | Create a times condition for at least count (>=).
--
--   > f `shouldBeCalled` atLeast 1
atLeast :: Int -> TimesSpec
atLeast :: Int -> TimesSpec
atLeast Int
n = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
GreaterThanEqual Int
n)

-- | Create a times condition for at most count (<=).
--
--   > f `shouldBeCalled` atMost 2
atMost :: Int -> TimesSpec
atMost :: Int -> TimesSpec
atMost Int
n = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
LessThanEqual Int
n)

-- | Create a times condition for greater than count (>).
greaterThan :: Int -> TimesSpec
greaterThan :: Int -> TimesSpec
greaterThan Int
n = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
GreaterThan Int
n)

-- | Create a times condition for less than count (<).
lessThan :: Int -> TimesSpec
lessThan :: Int -> TimesSpec
lessThan Int
n = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
LessThan Int
n)

-- | Create a times condition for exactly once.
--   Equivalent to 'times 1'.
once :: TimesSpec
once :: TimesSpec
once = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
Equal Int
1)

-- | Create a times condition for never (zero times).
--   Equivalent to 'times 0'.
never :: TimesSpec
never :: TimesSpec
never = CountVerifyMethod -> TimesSpec
TimesSpec (Int -> CountVerifyMethod
Equal Int
0)

-- | Order condition for order verification
newtype OrderSpec = OrderSpec VerifyOrderMethod

-- | Create an order condition for exact sequence
inOrder :: OrderSpec
inOrder :: OrderSpec
inOrder = VerifyOrderMethod -> OrderSpec
OrderSpec VerifyOrderMethod
ExactlySequence

-- | Create an order condition for partial sequence
inPartialOrder :: OrderSpec
inPartialOrder :: OrderSpec
inPartialOrder = VerifyOrderMethod -> OrderSpec
OrderSpec VerifyOrderMethod
PartiallySequence

-- | Create a simple verification with arguments.
--   This accepts both raw values and Param chains.
--
--   > f `shouldBeCalled` calledWith "a"
calledWith :: params -> VerificationSpec params
calledWith :: forall params. params -> VerificationSpec params
calledWith = params -> VerificationSpec params
forall params. params -> VerificationSpec params
SimpleVerification

-- | Create a simple verification without arguments.
--   It verifies that the function was called at least once, with ANY arguments.
--
--   > f `shouldBeCalled` anything
anything :: forall params. VerificationSpec params
anything :: forall params. VerificationSpec params
anything = VerificationSpec params
forall params. VerificationSpec params
AnyVerification

-- | Type class for combining times condition with arguments
class WithArgs spec params where
  type WithResult spec params :: Type
  with :: spec -> params -> WithResult spec params

-- | Instance for times condition with arguments
instance (Eq params, Show params) => WithArgs TimesSpec params where
  type WithResult TimesSpec params = VerificationSpec params
  with :: TimesSpec -> params -> WithResult TimesSpec params
with (TimesSpec CountVerifyMethod
method) = CountVerifyMethod -> params -> VerificationSpec params
forall params.
CountVerifyMethod -> params -> VerificationSpec params
CountVerification CountVerifyMethod
method

-- | Type family to normalize argument types for 'withArgs'
type family NormalizeWithArg a :: Type where
  NormalizeWithArg (Param a :> rest) = Param a :> rest
  NormalizeWithArg (Param a) = Param a
  NormalizeWithArg a = Param a

-- | Type class to normalize argument types (to Param or Param chain)
class ToNormalizedArg a where
  toNormalizedArg :: a -> NormalizeWithArg a

instance ToNormalizedArg (Param a :> rest) where
  toNormalizedArg :: (Param a :> rest) -> NormalizeWithArg (Param a :> rest)
toNormalizedArg = (Param a :> rest) -> Param a :> rest
(Param a :> rest) -> NormalizeWithArg (Param a :> rest)
forall a. a -> a
id

instance ToNormalizedArg (Param a) where
  toNormalizedArg :: Param a -> NormalizeWithArg (Param a)
toNormalizedArg = Param a -> Param a
Param a -> NormalizeWithArg (Param a)
forall a. a -> a
id

instance {-# OVERLAPPABLE #-} (NormalizeWithArg a ~ Param a, WrapParam a) => ToNormalizedArg a where
  toNormalizedArg :: a -> NormalizeWithArg a
toNormalizedArg = a -> Param a
a -> NormalizeWithArg a
forall a. WrapParam a => a -> Param a
wrap



-- | New function for combining times condition with arguments (supports raw values)
--   This will replace 'with' once the old 'with' is removed
withArgs ::
  forall params.
  ( ToNormalizedArg params
  , Eq (NormalizeWithArg params)
  , Show (NormalizeWithArg params)
  ) => TimesSpec -> params -> VerificationSpec (NormalizeWithArg params)
withArgs :: forall params.
(ToNormalizedArg params, Eq (NormalizeWithArg params),
 Show (NormalizeWithArg params)) =>
TimesSpec -> params -> VerificationSpec (NormalizeWithArg params)
withArgs (TimesSpec CountVerifyMethod
method) params
args = CountVerifyMethod
-> NormalizeWithArg params
-> VerificationSpec (NormalizeWithArg params)
forall params.
CountVerifyMethod -> params -> VerificationSpec params
CountVerification CountVerifyMethod
method (params -> NormalizeWithArg params
forall a. ToNormalizedArg a => a -> NormalizeWithArg a
toNormalizedArg params
args)

infixl 8 `withArgs`

-- | Verify that the mock was called with the specified sequence of arguments in exact order.
--
--   > f `shouldBeCalled` inOrderWith ["a", "b"]
inOrderWith ::
  forall params.
  ( ToNormalizedArg params
  , Eq (NormalizeWithArg params)
  , Show (NormalizeWithArg params)
  ) => [params] -> VerificationSpec (NormalizeWithArg params)
inOrderWith :: forall params.
(ToNormalizedArg params, Eq (NormalizeWithArg params),
 Show (NormalizeWithArg params)) =>
[params] -> VerificationSpec (NormalizeWithArg params)
inOrderWith [params]
args = VerifyOrderMethod
-> [NormalizeWithArg params]
-> VerificationSpec (NormalizeWithArg params)
forall params.
VerifyOrderMethod -> [params] -> VerificationSpec params
OrderVerification VerifyOrderMethod
ExactlySequence ((params -> NormalizeWithArg params)
-> [params] -> [NormalizeWithArg params]
forall a b. (a -> b) -> [a] -> [b]
map params -> NormalizeWithArg params
forall a. ToNormalizedArg a => a -> NormalizeWithArg a
toNormalizedArg [params]
args)

-- | Verify that the mock was called with the specified sequence of arguments, allowing other calls in between.
--
--   > f `shouldBeCalled` inPartialOrderWith ["a", "c"]
--   > -- This passes if calls were: "a", "b", "c"
inPartialOrderWith ::
  forall params.
  ( ToNormalizedArg params
  , Eq (NormalizeWithArg params)
  , Show (NormalizeWithArg params)
  ) => [params] -> VerificationSpec (NormalizeWithArg params)
inPartialOrderWith :: forall params.
(ToNormalizedArg params, Eq (NormalizeWithArg params),
 Show (NormalizeWithArg params)) =>
[params] -> VerificationSpec (NormalizeWithArg params)
inPartialOrderWith [params]
args = VerifyOrderMethod
-> [NormalizeWithArg params]
-> VerificationSpec (NormalizeWithArg params)
forall params.
VerifyOrderMethod -> [params] -> VerificationSpec params
OrderVerification VerifyOrderMethod
PartiallySequence ((params -> NormalizeWithArg params)
-> [params] -> [NormalizeWithArg params]
forall a b. (a -> b) -> [a] -> [b]
map params -> NormalizeWithArg params
forall a. ToNormalizedArg a => a -> NormalizeWithArg a
toNormalizedArg [params]
args)

-- | Main verification function class
class ShouldBeCalled m spec where
  shouldBeCalled :: HasCallStack => m -> spec -> IO ()

-- | Instance for times spec alone (without arguments)
instance
  ( ResolvableMockWithParams m params
  , RequireCallable "shouldBeCalled" m
  ) => ShouldBeCalled m TimesSpec where
  shouldBeCalled :: HasCallStack => m -> TimesSpec -> IO ()
shouldBeCalled m
m (TimesSpec CountVerifyMethod
method) = do
    ResolvedMock Maybe [Char]
mockName InvocationRecorder params
verifier <- m -> IO (ResolvedMock params)
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
    Maybe [Char]
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
forall params.
Maybe [Char]
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
verifyCallCount Maybe [Char]
mockName InvocationRecorder params
verifier CountVerifyMethod
method

-- | Instance for VerificationSpec (handles all verification types)
instance {-# OVERLAPPING #-}
  ( ResolvableMockWithParams m params
  , Eq params
  , Show params
  , RequireCallable "shouldBeCalled" m
  ) => ShouldBeCalled m (VerificationSpec params) where
  shouldBeCalled :: HasCallStack => m -> VerificationSpec params -> IO ()
shouldBeCalled m
m VerificationSpec params
spec = case VerificationSpec params
spec of
    CountVerification CountVerifyMethod
method params
args ->
      m -> ResolvableParamsOf m -> CountVerifyMethod -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m)) =>
m -> ResolvableParamsOf m -> CountVerifyMethod -> IO ()
verifyCount m
m params
ResolvableParamsOf m
args CountVerifyMethod
method
    CountAnyVerification CountVerifyMethod
count ->
      do
        ResolvedMock Maybe [Char]
mockName InvocationRecorder params
recorder <- m -> IO (ResolvedMock params)
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
        Maybe [Char]
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
forall params.
Maybe [Char]
-> InvocationRecorder params -> CountVerifyMethod -> IO ()
verifyCallCount Maybe [Char]
mockName InvocationRecorder params
recorder CountVerifyMethod
count
    OrderVerification VerifyOrderMethod
method [params]
argsList ->
      VerifyOrderMethod -> m -> [ResolvableParamsOf m] -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
VerifyOrderMethod -> m -> [ResolvableParamsOf m] -> IO ()
verifyOrder VerifyOrderMethod
method m
m [params]
[ResolvableParamsOf m]
argsList
    SimpleVerification params
args ->
      m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
verify m
m (params -> VerifyMatchType params
forall a. a -> VerifyMatchType a
MatchAny params
args)
    VerificationSpec params
AnyVerification ->
      do
        ResolvedMock Maybe [Char]
mockName InvocationRecorder params
recorder <- m -> IO (ResolvedMock params)
forall target params.
(params ~ ResolvableParamsOf target, Typeable params,
 Typeable (InvocationRecorder params)) =>
target -> IO (ResolvedMock params)
requireResolved m
m
        [params]
invocationList <- TVar (InvocationRecord params) -> IO [params]
forall params.
TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList (InvocationRecorder params -> TVar (InvocationRecord params)
forall params.
InvocationRecorder params -> TVar (InvocationRecord params)
invocationRef InvocationRecorder params
recorder)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([params] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [params]
invocationList) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [Char] -> IO ()
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
              [Char]
"\n"
              [ [Char]
"Function" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> [Char]
mockNameLabel Maybe [Char]
mockName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was never called"
              ]

-- | Instance for Param chains (e.g., "a" ~> "b")
instance {-# OVERLAPPING #-}
  ( ResolvableMockWithParams m (Param a :> rest)
  , Eq (Param a :> rest)
  , Show (Param a :> rest)
  ) => ShouldBeCalled m (Param a :> rest) where
  shouldBeCalled :: HasCallStack => m -> (Param a :> rest) -> IO ()
shouldBeCalled m
m Param a :> rest
args =
    m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
verify m
m ((Param a :> rest) -> VerifyMatchType (Param a :> rest)
forall a. a -> VerifyMatchType a
MatchAny Param a :> rest
args)

-- | Instance for single Param (e.g., param "a")
instance {-# OVERLAPPING #-}
  ( ResolvableMockWithParams m (Param a)
  , Eq (Param a)
  , Show (Param a)
  ) => ShouldBeCalled m (Param a) where
  shouldBeCalled :: HasCallStack => m -> Param a -> IO ()
shouldBeCalled m
m Param a
args =
    m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
verify m
m (Param a -> VerifyMatchType (Param a)
forall a. a -> VerifyMatchType a
MatchAny Param a
args)

-- | Instance for raw values (e.g., "a")
--   This converts raw values to Param at runtime
instance {-# OVERLAPPABLE #-}
  ( ResolvableMockWithParams m (Param a)
  , Eq (Param a)
  , Show (Param a)
  , Show a
  , Eq a
  ) => ShouldBeCalled m a where
  shouldBeCalled :: HasCallStack => m -> a -> IO ()
shouldBeCalled m
m a
arg =
    m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
forall m.
(ResolvableMock m, Eq (ResolvableParamsOf m),
 Show (ResolvableParamsOf m)) =>
m -> VerifyMatchType (ResolvableParamsOf m) -> IO ()
verify m
m (Param a -> VerifyMatchType (Param a)
forall a. a -> VerifyMatchType a
MatchAny (a -> Param a
forall v. (Show v, Eq v) => v -> Param v
param a
arg))