{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module Test.Hspec.Contrib.Mocks.V1 (
  stubAction
, withSpy
) where

import           Test.HUnit
import           Data.CallStack (HasCallStack)
import           Data.IORef

#if !MIN_VERSION_base(4,6,0)
atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' = atomicModifyIORef
#endif

-- | Create a [test stub](https://en.wikipedia.org/wiki/Test_stub) action.
--
-- >>> stub <- stubAction ["foo", "bar", "baz"]
-- >>> stub
-- "foo"
-- >>> stub
-- "bar"
-- >>> stub
-- "baz"
-- >>> stub
-- *** Exception: HUnitFailure ...stubAction: no values left...
--
-- @since 0.5.2
stubAction :: HasCallStack => [a] -> IO (IO a)
stubAction :: forall a. HasCallStack => [a] -> IO (IO a)
stubAction [a]
values = do
  ref <- [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef [a]
values
  return $ do
    atomicModifyIORef ref takeValue >>= maybe noValuesLeft return
  where
    noValuesLeft :: IO a
    noValuesLeft :: forall a. IO a
noValuesLeft = String -> IO a
forall a. HasCallStack => String -> IO a
assertFailure String
"stubAction: no values left"

    takeValue :: [a] -> ([a], Maybe a)
    takeValue :: forall a. [a] -> ([a], Maybe a)
takeValue [a]
xs = case [a]
xs of
      [] -> ([], Maybe a
forall a. Maybe a
Nothing)
      a
a : [a]
as -> ([a]
as, a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | Create a [test spy](https://en.wikipedia.org/wiki/Test_double) action.
--
-- Record any arguments that are passed to that action.
--
-- >>> withSpy $ \ spy -> spy "foo" >> spy "bar" >> spy "baz"
-- ["foo","bar","baz"]
--
-- @since 0.5.2
withSpy :: ((a -> IO ()) -> IO ()) -> IO [a]
withSpy :: forall a. ((a -> IO ()) -> IO ()) -> IO [a]
withSpy (a -> IO ()) -> IO ()
action = do
  ref <- [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef []
  action (\ a
x -> IORef [a] -> ([a] -> ([a], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
ref (([a] -> ([a], ())) -> IO ()) -> ([a] -> ([a], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ [a]
xs -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, ()))
  reverse `fmap` readIORef ref