WithMockSpec.hs

{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.MockCat.WithMockSpec (spec) where

import Prelude hiding (readFile, writeFile, any)
import Data.Text (pack)
import Test.Hspec (Spec, describe, it, shouldBe, shouldThrow, anyErrorCall)
import Test.MockCat
import Test.MockCat.SharedSpecDefs
import GHC.IO (evaluate)
import Control.Concurrent.Async (async, wait)
import Control.Concurrent (threadDelay)
import Control.Monad (void, forM, forM_)
import Control.Monad.IO.Unlift (withRunInIO)
import Control.Monad.IO.Class (liftIO)
import Control.Exception (try, ErrorCall(..))

-- Generate mocks for FileOperation
makeAutoLiftMock [t|FileOperation|]



perCall :: Int -> a -> a
perCall _ x = x

operationProgram ::
  FileOperation m =>
  FilePath ->
  FilePath ->
  m ()
operationProgram inputPath outputPath = do
  content <- readFile inputPath
  writeFile outputPath content

spec :: Spec
spec = do
  describe "user-defined type comparison" $ do
    it "should be able to compare user-defined types with Eq and Show" $ do
      withMock $ do
        let p = Post 1 "title"
        f <- mock (p ~> True)
        liftIO $ f p `shouldBe` True

    it "should work with expects and specific value" $ do
      withMock $ do
        let p = Post 1 "title"
        f <- mock (any @Post ~> True) `expects` (called once `with` p)
        liftIO $ f p `shouldBe` True

    it "should work with expects and ANY" $ do
      withMock $ do
        let p = Post 1 "title"
        f <- mock (any @Post ~> True) `expects` (called once `with` any @Post)
        liftIO $ f p `shouldBe` True

  describe "withMock basic functionality" $ do
    it "simple mock with expects" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True) `expects` (called once `with` "a")
        liftIO $ mockFn "a" `shouldBe` True

    it "simple mock with expects using param" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True) `expects` (called once `with` param "a")
        liftIO $ mockFn "a" `shouldBe` True

    it "fails when not called" $ do
      withMock (do 
        mock (any @String ~> True)
          `expects` (called once `with` "a")
        pure ()) `shouldThrow` anyErrorCall

    it "error message when not called" $ do
      result <- try $ withMock $ do 
        mock (any @String ~> True)
          `expects` (called once `with` "a")
        pure ()
      case result of
        Left (ErrorCall msg) -> do
          let expected =
                "function was not called the expected number of times with the expected arguments.\n" <>
                "  expected: 1\n" <>
                "   but got: 0"
          msg `shouldBe` expected
        _ -> fail "Expected ErrorCall"

    it "atLeast expectation" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True) `expects` (called (atLeast 1) `with` "a")

        void $ liftIO $ evaluate $ mockFn "a"
        void $ liftIO $ evaluate $ mockFn "a"
        void $ liftIO $ evaluate $ mockFn "a"

    it "anything expectation" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` called once

        void $ liftIO $ evaluate $ mockFn "a"

    it "anything expectation error message when not called" $ do
      result <- try $ withMock $ do 
        mock (any @String ~> True)
          `expects` called once
        pure ()
      case result of
        Left (ErrorCall msg) -> do
          let expected =
                "function was not called the expected number of times.\n" <>
                "  expected: 1\n" <>
                "   but got: 0"
          msg `shouldBe` expected
        _ -> fail "Expected ErrorCall"





    it "never expectation without args succeeds when not called" $ do
      withMock $ do 
        mock (any @String ~> True)
          `expects` called never
        pure ()

    it "never expectation without args fails when called" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` called never
        liftIO $ mockFn "a" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "never expectation with args succeeds when not called with that arg" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` (called never `with` "z")
        liftIO $ mockFn "a" `shouldBe` True
        pure ()

    it "never expectation with args fails when called with that arg" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` (called never `with` "z")
        liftIO $ mockFn "z" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "multiple expectations in do block" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 2) `with` "a"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        pure ()

    it "multiple expectations in do block fails when not all satisfied" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 2) `with` "a"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        -- missing: mockFn "b"
        pure ()) `shouldThrow` anyErrorCall

    it "multiple expectations in do block with never" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called once `with` "a"
            called never `with` "z"
        liftIO $ mockFn "a" `shouldBe` True
        pure ()

    it "multiple expectations in do block with never fails when violated" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called once `with` "a"
            called never `with` "z"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "z" `shouldBe` True  -- This should fail
        pure ()) `shouldThrow` anyErrorCall

    it "multiple expectations with different counts" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 3) `with` "a"
            called (atLeast 2) `with` "b"
            called once `with` "c"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        liftIO $ mockFn "c" `shouldBe` True
        pure ()

    it "multiple expectations fails when count is insufficient" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 3) `with` "a"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        -- missing one more "a" call
        liftIO $ mockFn "b" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "multiple expectations fails when atLeast is not satisfied" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (atLeast 2) `with` "a"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        -- missing one more "a" call (need at least 2)
        liftIO $ mockFn "b" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "multiple expectations with mixed never and count" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 2) `with` "a"
            called never `with` "z"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        pure ()

    it "multiple expectations with never fails when never is violated" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 2) `with` "a"
            called never `with` "z"
            called once `with` "b"
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "z" `shouldBe` True  -- This should fail
        pure ()) `shouldThrow` anyErrorCall


  describe "withMock verification failures" $ do
    it "fails when called fewer times than expected" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called (times 3) `with` "a"

        liftIO $ evaluate $ mockFn "a"
        liftIO $ evaluate $ mockFn "a"
        pure ()) `shouldThrow` anyErrorCall

    it "fails when called with unexpected arguments" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called once `with` "a"

        liftIO $ evaluate $ mockFn "b"
        pure ()) `shouldThrow` anyErrorCall

    it "fails when called but never expected" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            called never `with` "z"

        liftIO $ evaluate $ mockFn "z"
        pure ()) `shouldThrow` anyErrorCall

  describe "withMock with runMockT" $ do
    it "can use runMockT inside withMock" $ do
      withMock $ do
        result <- runMockT do
          _readFile $ "input.txt" ~> pack "content"
          _writeFile $ "output.txt" ~> pack "content" ~> ()
          operationProgram "input.txt" "output.txt"

        liftIO $ result `shouldBe` ()

  describe "order verification" $ do
    it "calledInOrder succeeds when called in correct order" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInOrder ["a", "b", "c"]

        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        liftIO $ mockFn "c" `shouldBe` True
        pure ()

    it "calledInOrder fails when called in wrong order" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInOrder ["a", "b", "c"]

        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "c" `shouldBe` True  -- Wrong order: should be "b"
        liftIO $ mockFn "b" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "calledInOrder fails when not all calls are made" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInOrder ["a", "b", "c"]

        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True
        -- missing: mockFn "c"
        pure ()) `shouldThrow` anyErrorCall

    it "calledInSequence succeeds when sequence is followed" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInSequence ["a", "c"]

        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "b" `shouldBe` True  -- This is ignored
        liftIO $ mockFn "c" `shouldBe` True
        pure ()

    it "calledInSequence fails when sequence is violated" $ do
      withMock (do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInSequence ["a", "c"]

        liftIO $ mockFn "c" `shouldBe` True  -- Wrong: "a" should come first
        liftIO $ mockFn "a" `shouldBe` True
        pure ()) `shouldThrow` anyErrorCall

    it "calledInSequence succeeds with extra calls in between" $ do
      withMock $ do 
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInSequence ["a", "c"]

        liftIO $ mockFn "a" `shouldBe` True
        liftIO $ mockFn "x" `shouldBe` True
        liftIO $ mockFn "y" `shouldBe` True
        liftIO $ mockFn "c" `shouldBe` True
        pure ()

  describe "multiple mocks" $ do
    it "can define multiple mocks in withMock" $ do
      withMock $ do 
        fn1 <- mock (any @String ~> True)
        pure fn1 `expects` do
            called once `with` "a" 

        fn2 <- mock (any @String ~> any @String ~> False)
        pure fn2 `expects` do
            called once `with` ("x" ~> "y")

        liftIO $ fn1 "a" `shouldBe` True
        liftIO $ fn2 "x" "y" `shouldBe` False
        pure ()

  describe "withMock scope isolation" $ do
    it "mocks from different withMock blocks do not interfere" $ do
      -- First withMock block: expect one call
      withMock $ do 
        fn1 <- mock (any @String ~> True)
        pure fn1 `expects` do
            called once `with` "a"
        liftIO $ evaluate $ fn1 "a"

      -- Second withMock block: expect zero (if leaked, would see 1 and fail)
      withMock $ do 
        mock (any @String ~> True)
          `expects` do
            called never `with` "a"
        pure ()

    it "multiple sequential withMock blocks are independent" $ do
      -- Block 1: call with "x"
      withMock $ do
        fn1 <- mock (any @String ~> True)
        pure fn1 `expects` do
            called once `with` "x"
        liftIO $ evaluate $ fn1 "x"

      -- Block 2: call with "y"
      withMock $ do
        fn2 <- mock (any @String ~> True)
        pure fn2 `expects` do
            called once `with` "y"
        liftIO $ evaluate $ fn2 "y"

      -- Block 3: no calls
      withMock $ do
        mock (any ~> True)
          `expects` do
            called never `with` "z"
        pure ()

  describe "withMock concurrency" $ do
    it "counts calls across parallel threads" $ do
      withMock $ do
        mockFn <- mock (any ~> True)
        pure mockFn `expects` do
            called (times 10)

        withRunInIO $ \runInIO -> do
          as <- forM [1 .. 10] $ \i ->
            async $ runInIO $ do
              liftIO $ evaluate $ perCall i (mockFn "a")
              pure ()
          mapM_ wait as

    it "handles concurrent calls with different arguments" $ do
      withMock $ do
        mockFn <- mock (any ~> True)
        pure mockFn `expects` do
            called (times 5) `with` "a"
            called (times 5) `with` "b"

        withRunInIO $ \runInIO -> do
          as1 <- forM [1 .. 5] $ \i ->
            async $ runInIO $ liftIO $ evaluate $ perCall i (mockFn "a")
          as2 <- forM [1 .. 5] $ \i ->
            async $ runInIO $ liftIO $ evaluate $ perCall (100 + i) (mockFn "b")
          mapM_ wait (as1 ++ as2)

    it "stress test: many threads with many calls" $ do
      let threads = 20 :: Int
          callsPerThread = 10 :: Int
          total = threads * callsPerThread :: Int

      withMock $ do
        mockFn <- mock (any ~> True)
        pure mockFn `expects` do
            called (times total)

        withRunInIO $ \runInIO -> do
          as <- forM [1 .. threads] $ \threadIx ->
            async $ runInIO $ do
              forM_ [1 .. callsPerThread] $ \callIx -> do
                let tag = threadIx * 1000 + callIx
                liftIO $ evaluate $ perCall tag (mockFn "stress")
                liftIO $ threadDelay 1
          mapM_ wait as

    it "concurrent calls preserve order expectations" $ do
      withMock $ do
        mockFn <- mock (any @String ~> True)
        pure mockFn `expects` do
            calledInOrder ["first", "second", "third"]

        withRunInIO $ \runInIO -> do
          -- Sequential calls to preserve order
          runInIO $ void $ liftIO $ evaluate $ mockFn "first"
          runInIO $ void $ liftIO $ evaluate $ mockFn "second"
          runInIO $ void $ liftIO $ evaluate $ mockFn "third"