Verify.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}

module Test.MockCat.Internal.Verify where

import Control.Concurrent.STM (readTVarIO, TVar)
import Control.Monad (guard, when)
import Data.List (intercalate)
import Data.Maybe (catMaybes, isNothing)
import Test.MockCat.Internal.Types
import Test.MockCat.Internal.Message
import Test.MockCat.Param (EqParams(..))

import Prelude hiding (lookup)
import Data.Foldable (for_)

-- | Verify an expectation directly against a resolved mock.
--   This is used by 'mock' when expectations are provided.
verifyExpectationDirect :: (EqParams params, Show params) => ResolvedMock params -> Expectation params -> IO ()
verifyExpectationDirect resolved (CountExpectation method args) =
  verifyResolvedCount resolved args method
verifyExpectationDirect resolved (CountAnyExpectation method) =
  verifyResolvedCallCount resolved method
verifyExpectationDirect resolved (OrderExpectation method matchers) =
  verifyResolvedOrder method resolved matchers
verifyExpectationDirect resolved (SimpleExpectation args) =
  verifyResolvedMatch resolved (MatchAny args)
verifyExpectationDirect resolved AnyExpectation =
  verifyResolvedAny resolved

-- | Verify that a resolved mock function was called at least once.
verifyResolvedAny :: ResolvedMock params -> IO ()
verifyResolvedAny (ResolvedMock mockName recorder) = do
  invocationList <- readInvocationList (invocationRef recorder)
  when (null invocationList) $
    errorWithoutStackTrace $
      intercalate
        "\n"
        [ "Function" <> mockNameLabel mockName <> " was never called"
        ]

-- | Verify that mock was called with specific arguments using resolved mock directly.
verifyResolvedMatch :: (EqParams params, Show params) => ResolvedMock params -> VerifyMatchType params -> IO ()
verifyResolvedMatch (ResolvedMock mockName recorder) matchType = do
  invocationList <- readInvocationList (invocationRef recorder)
  case doVerify mockName invocationList matchType of
    Nothing -> pure ()
    Just (VerifyFailed msg) ->
      errorWithoutStackTrace msg `seq` pure ()

-- | Verify call count with specific arguments using resolved mock directly.
verifyResolvedCount :: (EqParams params, Show params) => ResolvedMock params -> params -> CountVerifyMethod -> IO ()
verifyResolvedCount (ResolvedMock mockName recorder) v method = do
  invocationList <- readInvocationList (invocationRef recorder)
  let callCount = length (filter (`eqParams` v) invocationList)
  if compareCount method callCount
    then pure ()
    else
      errorWithoutStackTrace $
        -- If we expected some calls (e.g. atLeast 1) but got 0, and there were OTHER calls,
        -- show the closest match diff to help debugging.
        if callCount == 0 && not (null invocationList)
           && expectsPositive method
          then countWithArgsMismatchMessageWithDiff mockName v invocationList
          else countWithArgsMismatchMessage mockName method callCount

expectsPositive :: CountVerifyMethod -> Bool
expectsPositive (Equal n) = n > 0
expectsPositive (GreaterThanEqual n) = n > 0
expectsPositive (GreaterThan _) = True
expectsPositive (LessThan _) = False -- usually "less than 2" allows 0, so 0 is valid.
expectsPositive (LessThanEqual _) = False -- "at most N" allows 0.

-- | Verify overall call count (ignoring arguments)
verifyResolvedCallCount :: ResolvedMock params -> CountVerifyMethod -> IO ()
verifyResolvedCallCount (ResolvedMock mockName recorder) = verifyCallCount mockName recorder

-- | Verify call order using resolved mock directly.
verifyResolvedOrder :: (EqParams params, Show params) => VerifyOrderMethod -> ResolvedMock params -> [params] -> IO ()
verifyResolvedOrder method (ResolvedMock mockName recorder) matchers = do
  invocationList <- readInvocationList (invocationRef recorder)
  case doVerifyOrder method mockName invocationList matchers of
    Nothing -> pure ()
    Just (VerifyFailed msg) ->
      errorWithoutStackTrace msg `seq` pure ()

-- | Internal helper to read invocation list
readInvocationList :: TVar (InvocationRecord params) -> IO (InvocationList params)
readInvocationList ref = do
  record <- readTVarIO ref
  pure $ invocations record

-- | Helper to verify call count (low level)
verifyCallCount ::
  Maybe MockName ->
  InvocationRecorder params ->
  CountVerifyMethod ->
  IO ()
verifyCallCount maybeName recorder method = do
  result <- tryVerifyCallCount maybeName recorder method
  for_ result errorWithoutStackTrace

tryVerifyCallCount ::
  Maybe MockName ->
  InvocationRecorder params ->
  CountVerifyMethod ->
  IO (Maybe String)
tryVerifyCallCount maybeName recorder method = do
  invocationList <- readInvocationList (invocationRef recorder)
  let callCount = length invocationList
  if compareCount method callCount
    then pure Nothing
    else pure $ Just $ countMismatchMessage maybeName method callCount

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

countWithArgsMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String
countWithArgsMismatchMessage mockName method callCount =
  intercalate
    "\n"
    [ "function" <> mockNameLabel mockName <> " was not called the expected number of times with the expected arguments.",
      "  expected: " <> show method,
      "   but got: " <> show callCount
    ]

countMismatchMessage :: Maybe MockName -> CountVerifyMethod -> Int -> String
countMismatchMessage maybeName method callCount =
  intercalate
    "\n"
    [ "function" <> mockNameLabel maybeName <> " was not called the expected number of times.",
      "  expected: " <> showCountMethod method,
      "   but got: " <> show callCount
    ]
  where
    showCountMethod (Equal n) = show n
    showCountMethod (LessThanEqual n) = "<= " <> show n
    showCountMethod (GreaterThanEqual n) = ">= " <> show n
    showCountMethod (LessThan n) = "< " <> show n
    showCountMethod (GreaterThan n) = "> " <> show n

doVerify :: (EqParams a, Show a) => Maybe MockName -> InvocationList a -> VerifyMatchType a -> Maybe VerifyFailed
doVerify name list (MatchAny a) = do
  guard $ not (elemEqParams a list)
  pure $ verifyFailedMessage name list a
doVerify name list (MatchAll a) = do
  guard $ not (all (eqParams a) list)
  pure $ verifyFailedMessage name list a

doVerifyOrder ::
  (EqParams a, Show a) =>
  VerifyOrderMethod ->
  Maybe MockName ->
  InvocationList a ->
  [a] ->
  Maybe VerifyFailed
doVerifyOrder ExactlySequence name calledValues expectedValues
  | length calledValues /= length expectedValues = do
      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues
  | otherwise = do
      let unexpectedOrders = collectUnExpectedOrder calledValues expectedValues
      guard $ not (null unexpectedOrders)
      pure $ verifyFailedSequence name unexpectedOrders
doVerifyOrder PartiallySequence name calledValues expectedValues
  | length calledValues < length expectedValues = do
      pure $ verifyFailedOrderParamCountMismatch name calledValues expectedValues
  | otherwise = do
      guard $ isOrderNotMatched calledValues expectedValues
      pure $ verifyFailedPartiallySequence name calledValues expectedValues

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

isOrderNotMatched :: EqParams a => InvocationList a -> [a] -> Bool
isOrderNotMatched calledValues expectedValues =
  isNothing $
    foldl
      ( \candidates e -> do
          candidates >>= \c -> do
            index <- elemIndexEqParams e c
            Just $ drop (index + 1) c
      )
      (Just calledValues)
      expectedValues

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

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

collectUnExpectedOrder :: EqParams a => InvocationList a -> [a] -> [VerifyOrderResult a]
collectUnExpectedOrder calledValues expectedValues =
  catMaybes $
    mapWithIndex
      ( \i expectedValue -> do
          let calledValue = calledValues !! i
          guard $ not (expectedValue `eqParams` calledValue)
          pure VerifyOrderResult {index = i, calledValue = calledValue, expectedValue}
      )
      expectedValues

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

elemEqParams :: EqParams a => a -> [a] -> Bool
elemEqParams _ [] = False
elemEqParams x (y:ys) = eqParams x y || elemEqParams x ys

elemIndexEqParams :: EqParams a => a -> [a] -> Maybe Int
elemIndexEqParams x = go 0
  where
    go _ [] = Nothing
    go i (y:ys)
      | eqParams x y = Just i
      | otherwise    = go (i+1) ys