{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

{- | Utilities for constructing verifiable stub functions.
     This module provides the core functions for creating mocks and stubs.

     = Key Functions
     * 'mock': Create a verifiable mock function (records calls).
     * 'stub': Create a pure stub function (no recording).
     * 'mockM': Create a monadic mock function (allows explicit side effects).
-}
module Test.MockCat.Mock
  ( MockBuilder
  , buildMock
  , mock
  , mockM
  , createNamedMockFnWithParams
  , stub
  , shouldBeCalled
  , times
  , atLeast
  , atMost
  , greaterThan
  , lessThan
  , once
  , never
  , inOrder
  , inPartialOrder
  , inOrderWith
  , inPartialOrderWith
  , calledWith
  , anything
  , withArgs
  , onCase
  , cases
  , casesIO
  , label
  , Label
  ) where

import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.State (get, put)
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import Prelude hiding (lookup)
import Test.MockCat.Internal.Builder
import qualified Test.MockCat.Internal.MockRegistry as MockRegistry ( register )
import Test.MockCat.Internal.Types
import Test.MockCat.Param
import Test.MockCat.Verify
import Test.MockCat.Cons (Head(..), (:>)(..))

-- | Type family to convert raw values to mock parameters.
--   Raw values (like "foo") are converted to Head :> Param a,
--   while existing Param chains remain unchanged.
type family ToMockParams p where
  ToMockParams (Param a :> rest) = Param a :> rest  -- Already a Param chain, keep as is
  ToMockParams (Param a) = Param a                  -- Single Param, keep as is
  ToMockParams (Cases a b) = Cases a b              -- Cases, keep as is
  ToMockParams (IO a) = IO a                        -- IO, keep as is
  ToMockParams (Head :> a) = Head :> a              -- Already has Head, keep as is
  ToMockParams a = Head :> Param a                  -- Raw value, wrap with Head :> Param

-- | Type class for converting values to mock parameters.
class CreateMock p where
  toParams :: p -> ToMockParams p

-- Instance for Param chains (most specific - should match first)
instance {-# OVERLAPPING #-} CreateMock (Param a :> rest) where
  toParams :: (Param a :> rest) -> ToMockParams (Param a :> rest)
toParams = (Param a :> rest) -> Param a :> rest
(Param a :> rest) -> ToMockParams (Param a :> rest)
forall a. a -> a
id

-- Instance for single Param
instance {-# OVERLAPPING #-} CreateMock (Param a) where
  toParams :: Param a -> ToMockParams (Param a)
toParams = Param a -> Param a
Param a -> ToMockParams (Param a)
forall a. a -> a
id

-- Instance for Cases
instance {-# OVERLAPPING #-} CreateMock (Cases a b) where
  toParams :: Cases a b -> ToMockParams (Cases a b)
toParams = Cases a b -> Cases a b
Cases a b -> ToMockParams (Cases a b)
forall a. a -> a
id

-- Instance for IO
instance {-# OVERLAPPING #-} CreateMock (IO a) where
  toParams :: IO a -> ToMockParams (IO a)
toParams = IO a -> IO a
IO a -> ToMockParams (IO a)
forall a. a -> a
id

-- Instance for Head :> Param r (constant values)
instance {-# OVERLAPPING #-} CreateMock (Head :> Param r) where
  toParams :: (Head :> Param r) -> ToMockParams (Head :> Param r)
toParams = (Head :> Param r) -> Head :> Param r
(Head :> Param r) -> ToMockParams (Head :> Param r)
forall a. a -> a
id

-- Instance for raw values (fallback)
-- This handles raw values by wrapping them with Head :> Param
-- We need to ensure this doesn't match Param chains, Cases, IO, or Head types
instance {-# OVERLAPPABLE #-}
  ( ToMockParams b ~ (Head :> Param b)
  , Normalize b ~ Param b
  , Typeable b
  , ToParamArg b
  ) => CreateMock b where
    toParams :: b -> ToMockParams b
toParams b
value = Head
Head Head -> Param b -> Head :> Param b
forall a b. a -> b -> a :> b
:> b -> Normalize b
forall a. ToParamArg a => a -> Normalize a
toParamArg b
value

-- | Label type for naming mock functions.
newtype Label = Label MockName

-- | Label function for naming mock functions.
--   Use it with 'mock' to provide a name for the mock function.
--   
--   @
--   f <- mock (label "mockName") $ "a" ~> "b"
--   @
label :: MockName -> Label
label :: MockName -> Label
label = MockName -> Label
Label

-- | Type class for creating mock functions with optional name.
class CreateMockFn a where
  mockImpl :: a

-- | Type class for creating stub functions with optional name.
class CreateStubFn a where
  stubImpl :: a

-- | Create a mock function with verification hooks attached (unnamed version).
--   The returned function mimics a pure function (via 'unsafePerformIO') but records its calls for later verification.
--
--   > f <- mock $ "a" ~> "b"
--   > f "a" `shouldBe` "b"
--   > f `shouldBeCalled` "a"
instance
  ( MonadIO m
  , CreateMock p
  , MockBuilder (ToMockParams p) fn verifyParams
  , Typeable verifyParams
  , Typeable fn
  ) =>
  CreateMockFn (p -> m fn)
  where
  mockImpl :: p -> m fn
mockImpl p
p = do
    let params :: ToMockParams p
params = p -> ToMockParams p
forall p. CreateMock p => p -> ToMockParams p
toParams p
p
    BuiltMock { builtMockFn :: forall fn params. BuiltMock fn params -> fn
builtMockFn = fn
fn, builtMockRecorder :: forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder = InvocationRecorder verifyParams
recorder } <- Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
forall (m :: * -> *) params fn verifyParams.
(MonadIO m, MockBuilder params fn verifyParams) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
buildMock Maybe MockName
forall a. Maybe a
Nothing ToMockParams p
params
    IO fn -> m fn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO fn -> m fn) -> IO fn -> m fn
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> InvocationRecorder verifyParams -> fn -> IO fn
forall fn params.
(Typeable params, Typeable (InvocationRecorder params),
 Typeable fn) =>
Maybe MockName -> InvocationRecorder params -> fn -> IO fn
MockRegistry.register Maybe MockName
forall a. Maybe a
Nothing InvocationRecorder verifyParams
recorder fn
fn

-- | Create a named mock function.
--   The name is used in error messages to help you identify which mock failed.
--
--   > f <- mock (label "MyAPI") $ "a" ~> "b"
instance {-# OVERLAPPING #-}
  ( MonadIO m
  , CreateMock p
  , MockBuilder (ToMockParams p) fn verifyParams
  , Typeable verifyParams
  , Typeable fn
  ) =>
  CreateMockFn (Label -> p -> m fn)
  where
  mockImpl :: Label -> p -> m fn
mockImpl (Label MockName
name) p
p = do
    let params :: ToMockParams p
params = p -> ToMockParams p
forall p. CreateMock p => p -> ToMockParams p
toParams p
p
    BuiltMock { builtMockFn :: forall fn params. BuiltMock fn params -> fn
builtMockFn = fn
fn, builtMockRecorder :: forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder = InvocationRecorder verifyParams
recorder } <- Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
forall (m :: * -> *) params fn verifyParams.
(MonadIO m, MockBuilder params fn verifyParams) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
buildMock (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) ToMockParams p
params
    IO fn -> m fn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO fn -> m fn) -> IO fn -> m fn
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> InvocationRecorder verifyParams -> fn -> IO fn
forall fn params.
(Typeable params, Typeable (InvocationRecorder params),
 Typeable fn) =>
Maybe MockName -> InvocationRecorder params -> fn -> IO fn
MockRegistry.register (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) InvocationRecorder verifyParams
recorder fn
fn

-- | Create a mock function with verification hooks attached.
--
-- This function can be used in two ways:
--
-- 1. Without a name:
--    @
--    f <- mock $ "a" ~> "b"
--    @
--
-- 2. With a name (using 'label'):
--    @
--    f <- mock (label "mockName") $ "a" ~> "b"
--    @
--
-- The function creates a verifiable stub that records calls
-- and can be verified via the unified 'shouldBeCalled' API.
-- The function internally uses 'unsafePerformIO' to make the returned function
-- appear pure, but it requires 'MonadIO' for creation.
mock :: CreateMockFn a => a
mock :: forall a. CreateMockFn a => a
mock = a
forall a. CreateMockFn a => a
mockImpl

-- | Type class for creating monadic mock functions without unsafePerformIO.
class CreateMockFnM a where
  mockMImpl :: a

instance
  ( MonadIO m
  , CreateMock p
  , MockIOBuilder (ToMockParams p) fn verifyParams
  , LiftFunTo fn fnM m
  , Typeable verifyParams
  , Typeable fnM
  ) =>
  CreateMockFnM (p -> m fnM)
  where
  mockMImpl :: p -> m fnM
mockMImpl p
p = do
    let params :: ToMockParams p
params = p -> ToMockParams p
forall p. CreateMock p => p -> ToMockParams p
toParams p
p
    BuiltMock { builtMockFn :: forall fn params. BuiltMock fn params -> fn
builtMockFn = fn
fnIO, builtMockRecorder :: forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder = InvocationRecorder verifyParams
verifier } <- Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
forall params fn verifyParams (m :: * -> *).
(MockIOBuilder params fn verifyParams, MonadIO m) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
buildIO Maybe MockName
forall a. Maybe a
Nothing ToMockParams p
params
    let lifted :: fnM
lifted = Proxy m -> fn -> fnM
forall funIO funM (m :: * -> *).
LiftFunTo funIO funM m =>
Proxy m -> funIO -> funM
liftFunTo (Proxy m
forall {k} (t :: k). Proxy t
Proxy :: Proxy m) fn
fnIO
    IO fnM -> m fnM
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO fnM -> m fnM) -> IO fnM -> m fnM
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> InvocationRecorder verifyParams -> fnM -> IO fnM
forall fn params.
(Typeable params, Typeable (InvocationRecorder params),
 Typeable fn) =>
Maybe MockName -> InvocationRecorder params -> fn -> IO fn
MockRegistry.register Maybe MockName
forall a. Maybe a
Nothing InvocationRecorder verifyParams
verifier fnM
lifted

instance {-# OVERLAPPING #-}
  ( MonadIO m
  , CreateMock p
  , MockIOBuilder (ToMockParams p) fn verifyParams
  , LiftFunTo fn fnM m
  , Typeable verifyParams
  , Typeable fnM
  ) =>
  CreateMockFnM (Label -> p -> m fnM)
  where
  mockMImpl :: Label -> p -> m fnM
mockMImpl (Label MockName
name) p
p = do
    let params :: ToMockParams p
params = p -> ToMockParams p
forall p. CreateMock p => p -> ToMockParams p
toParams p
p
    BuiltMock { builtMockFn :: forall fn params. BuiltMock fn params -> fn
builtMockFn = fn
fnIO, builtMockRecorder :: forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder = InvocationRecorder verifyParams
verifier } <- Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
forall params fn verifyParams (m :: * -> *).
(MockIOBuilder params fn verifyParams, MonadIO m) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
forall (m :: * -> *).
MonadIO m =>
Maybe MockName -> ToMockParams p -> m (BuiltMock fn verifyParams)
buildIO (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) ToMockParams p
params
    let lifted :: fnM
lifted = Proxy m -> fn -> fnM
forall funIO funM (m :: * -> *).
LiftFunTo funIO funM m =>
Proxy m -> funIO -> funM
liftFunTo (Proxy m
forall {k} (t :: k). Proxy t
Proxy :: Proxy m) fn
fnIO
    IO fnM -> m fnM
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO fnM -> m fnM) -> IO fnM -> m fnM
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> InvocationRecorder verifyParams -> fnM -> IO fnM
forall fn params.
(Typeable params, Typeable (InvocationRecorder params),
 Typeable fn) =>
Maybe MockName -> InvocationRecorder params -> fn -> IO fn
MockRegistry.register (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) InvocationRecorder verifyParams
verifier fnM
lifted

mockM :: CreateMockFnM a => a
mockM :: forall a. CreateMockFnM a => a
mockM = a
forall a. CreateMockFnM a => a
mockMImpl

-- | Internal function for TH code that already has MockBuilder constraint.
--   This avoids CreateNamedMock instance resolution issues in generated code.
createNamedMockFnWithParams ::
  ( MonadIO m
  , MockBuilder params fn verifyParams
  , Typeable verifyParams
  , Typeable fn
  ) =>
  MockName ->
  params ->
  m fn
createNamedMockFnWithParams :: forall (m :: * -> *) params fn verifyParams.
(MonadIO m, MockBuilder params fn verifyParams,
 Typeable verifyParams, Typeable fn) =>
MockName -> params -> m fn
createNamedMockFnWithParams MockName
name params
params = do
  BuiltMock { builtMockFn :: forall fn params. BuiltMock fn params -> fn
builtMockFn = fn
fn, builtMockRecorder :: forall fn params. BuiltMock fn params -> InvocationRecorder params
builtMockRecorder = InvocationRecorder verifyParams
recorder } <- Maybe MockName -> params -> m (BuiltMock fn verifyParams)
forall (m :: * -> *) params fn verifyParams.
(MonadIO m, MockBuilder params fn verifyParams) =>
Maybe MockName -> params -> m (BuiltMock fn verifyParams)
buildMock (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) params
params
  IO fn -> m fn
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO fn -> m fn) -> IO fn -> m fn
forall a b. (a -> b) -> a -> b
$ Maybe MockName -> InvocationRecorder verifyParams -> fn -> IO fn
forall fn params.
(Typeable params, Typeable (InvocationRecorder params),
 Typeable fn) =>
Maybe MockName -> InvocationRecorder params -> fn -> IO fn
MockRegistry.register (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name) InvocationRecorder verifyParams
recorder fn
fn


-- | Create a pure stub function without verification hooks.
--   Useful when you only need to return values and don't care about verification.
--   This is completely pure and safe.
--
--   > let f = stub $ "a" ~> "b"
instance StubBuilder params fn => CreateStubFn (params -> fn) where
  stubImpl :: params -> fn
stubImpl = Maybe MockName -> params -> fn
forall params fn.
StubBuilder params fn =>
Maybe MockName -> params -> fn
buildStub Maybe MockName
forall a. Maybe a
Nothing

-- | Create a named pure stub function without verification hooks (named version).
--
-- The provided name is used in failure messages.
-- This function creates a simple stub that returns values based on the provided
-- parameters, but does not support verification. Use 'mock' if you need
-- verification capabilities.
--
-- @
-- let f = stub (label "stubName") $ "a" ~> "b"
-- @
instance {-# OVERLAPPING #-} StubBuilder params fn => CreateStubFn (Label -> params -> fn) where
  stubImpl :: Label -> params -> fn
stubImpl (Label MockName
name) = Maybe MockName -> params -> fn
forall params fn.
StubBuilder params fn =>
Maybe MockName -> params -> fn
buildStub (MockName -> Maybe MockName
forall a. a -> Maybe a
Just MockName
name)

{- | Create a pure stub function without verification hooks.

This function can be used in two ways:

1. Without a name:
   @
   let f = stub $ "a" ~> "b"
   @

2. With a name (using 'label'):
   @
   let f = stub (label "stubName") $ "a" ~> "b"
   @

This function creates a simple stub that returns values based on the provided
parameters, but does not support verification. Use 'mock' if you need
verification capabilities.
-}
stub :: CreateStubFn a => a
stub :: forall a. CreateStubFn a => a
stub = a
forall a. CreateStubFn a => a
stubImpl

{- | Register a stub case within a 'Cases' builder. -}
onCase :: a -> Cases a ()
onCase :: forall a. a -> Cases a ()
onCase a
a = State [a] () -> Cases a ()
forall a b. State [a] b -> Cases a b
Cases (State [a] () -> Cases a ()) -> State [a] () -> Cases a ()
forall a b. (a -> b) -> a -> b
$ do
  [a]
st <- StateT [a] Identity [a]
forall s (m :: * -> *). MonadState s m => m s
get
  [a] -> State [a] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([a]
st [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a])

{- | Define stub cases from a list of patterns. -}
cases :: [a] -> Cases a ()
cases :: forall a. [a] -> Cases a ()
cases [a]
a = State [a] () -> Cases a ()
forall a b. State [a] b -> Cases a b
Cases (State [a] () -> Cases a ()) -> State [a] () -> Cases a ()
forall a b. (a -> b) -> a -> b
$ [a] -> State [a] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
a

{- | IO variant of 'cases'. -}
casesIO :: [a] -> Cases (IO a) ()
casesIO :: forall a. [a] -> Cases (IO a) ()
casesIO = State [IO a] () -> Cases (IO a) ()
forall a b. State [a] b -> Cases a b
Cases (State [IO a] () -> Cases (IO a) ())
-> ([a] -> State [IO a] ()) -> [a] -> Cases (IO a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([IO a] -> State [IO a] ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([IO a] -> State [IO a] ())
-> ([a] -> [IO a]) -> [a] -> State [IO a] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IO a) -> [a] -> [IO a]
forall a b. (a -> b) -> [a] -> [b]
map a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

class LiftFunTo funIO funM (m :: Type -> Type) | funIO m -> funM where
  liftFunTo :: Proxy m -> funIO -> funM

instance MonadIO m => LiftFunTo (IO r) (m r) m where
  liftFunTo :: Proxy m -> IO r -> m r
liftFunTo Proxy m
_ = IO r -> m r
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance LiftFunTo restIO restM m => LiftFunTo (a -> restIO) (a -> restM) m where
  liftFunTo :: Proxy m -> (a -> restIO) -> a -> restM
liftFunTo Proxy m
proxy a -> restIO
f a
a = Proxy m -> restIO -> restM
forall funIO funM (m :: * -> *).
LiftFunTo funIO funM m =>
Proxy m -> funIO -> funM
liftFunTo Proxy m
proxy (a -> restIO
f a
a)