MockT.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Test.MockCat.MockT (MockT(..), Definition(..), runMockT, applyTimesIs, neverApply, MonadMockDefs(..)) where
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Reader (ReaderT(..), runReaderT)
import GHC.TypeLits (KnownSymbol)
import Data.Data (Proxy)
import Test.MockCat.Mock (Mock, shouldApplyTimesToAnything)
import Data.Foldable (for_)
import UnliftIO (MonadUnliftIO(..))
import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')

{- | MockT is a thin wrapper over @ReaderT (IORef [Definition])@ providing
     mock/stub registration and post-run verification.

Concurrency safety (summary):
  * Within a single 'runMockT' invocation, concurrent applications of stub
    functions are recorded without lost or double counts. This is achieved via
    atomic modifications ('atomicModifyIORef'').
  * The /moment/ a call is recorded is when the stub's return value is evaluated;
    if you only create an application but never force the result, it will not
    appear in the verification log.
  * Order-sensitive checks reflect evaluation order, not necessarily wall-clock
    start order between threads.
  * Perform verification (e.g. 'shouldApplyTimes', 'applyTimesIs') after all
    parallel work has completed; running it mid-flight may observe fewer calls
    simply because some results are still lazy.
  * Each 'runMockT' call uses a fresh IORef store; mocks are not shared across
    separate 'runMockT' boundaries.
-}
newtype MockT m a = MockT { unMockT :: ReaderT (IORef [Definition]) m a }
  deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)

class Monad m => MonadMockDefs m where
  addDefinition :: Definition -> m ()
  getDefinitions :: m [Definition]

instance MonadUnliftIO m => MonadUnliftIO (MockT m) where
  withRunInIO inner = MockT $ ReaderT $ \ref ->
    withRunInIO $ \run -> inner (\(MockT r) -> run (runReaderT r ref))

data Definition = forall f p sym. KnownSymbol sym => Definition {
  symbol :: Proxy sym,
  mock :: Mock f p,
  verify :: Mock f p -> IO ()
}

{- | Run MockT monad.
  After run, verification is performed to see if the stub function has been applied.

  @
  import Test.Hspec
  import Test.MockCat
  ...

  class (Monad m) => FileOperation m where
    writeFile :: FilePath -\> Text -\> m ()
    readFile :: FilePath -\> m Text

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

  makeMock [t|FileOperation|]

  spec :: Spec
  spec = do
    it "test runMockT" do
      result \<- runMockT do
        _readFile $ "input.txt" |\> pack "content"
        _writeFile $ "output.text" |\> pack "content" |\> ()
        operationProgram "input.txt" "output.text"

      result `shouldBe` ()
  @

-}
runMockT :: MonadIO m => MockT m a -> m a
runMockT (MockT r) = do
  ref <- liftIO $ newIORef []
  a <- runReaderT r ref
  defs <- liftIO $ readIORef ref
  for_ defs (\(Definition _ m v) -> liftIO $ v m)
  pure a

{- | Specify how many times a stub function (or group of stub definitions) must
     be applied (to /any/ arguments). The function patches the verification
     predicate for the provided stub definitions so that, after 'runMockT'
     completes, the total number of evaluated applications is checked.

  Concurrency & laziness notes:
    * Counting is thread-safe: each evaluated application contributes exactly 1.
    * An application is only counted once its return value is evaluated; ensure
      your test forces (e.g. via @shouldBe@ or sequencing) all stub results
      before relying on the count.
    * Invoke 'applyTimesIs' inside the 'runMockT' block during setup; do not
      call it after the block ends.

  @
  import Test.Hspec
  import Test.MockCat
  ...

  class (Monad m) => FileOperation m where
    writeFile :: FilePath -\> Text -\> m ()
    readFile :: FilePath -\> m Text

  operationProgram ::
    FileOperation m =>
    FilePath ->
    FilePath ->
    m ()
  operationProgram inputPath outputPath = do
    content <- readFile inputPath
    when (content == pack "ng") $ writeFile outputPath content

  makeMock [t|FileOperation|]

  spec :: Spec
  spec = do
    it "test runMockT" do
      result <- runMockT do
        _readFile ("input.txt" |> pack "content")
        _writeFile ("output.text" |> pack "content" |> ()) `applyTimesIs` 0
        operationProgram "input.txt" "output.text"

      result `shouldBe` ()

  @

-}
applyTimesIs :: MonadIO m => MockT m () -> Int -> MockT m ()
applyTimesIs (MockT inner) a = MockT $ ReaderT $ \ref -> do
  tmp <- liftIO $ newIORef []
  _ <- runReaderT inner tmp
  defs <- liftIO $ readIORef tmp
  let patched = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` a)) defs
  liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ patched, ()))
  pure ()

neverApply :: MonadIO m => MockT m () -> MockT m ()
neverApply (MockT inner) = MockT $ ReaderT $ \ref -> do
  tmp <- liftIO $ newIORef []
  _ <- runReaderT inner tmp
  defs <- liftIO $ readIORef tmp
  let patched = map (\(Definition s m _) -> Definition s m (`shouldApplyTimesToAnything` 0)) defs
  liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ patched, ()))
  pure ()

instance MonadIO m => MonadMockDefs (MockT m) where
  addDefinition d = MockT $ ReaderT $ \ref -> liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ [d], ()))
  getDefinitions = MockT $ ReaderT $ \ref -> liftIO $ readIORef ref

instance MonadIO m => MonadMockDefs (ReaderT (IORef [Definition]) m) where
  addDefinition d = ReaderT $ \ref -> liftIO $ atomicModifyIORef' ref (\xs -> (xs ++ [d], ()))
  getDefinitions = ReaderT $ \ref -> liftIO $ readIORef ref