{-# 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
  IORef [a]
ref <- forall a. a -> IO (IORef a)
newIORef [a]
values
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [a]
ref forall a. [a] -> ([a], Maybe a)
takeValue forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. IO a
noValuesLeft forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    noValuesLeft :: IO a
    noValuesLeft :: forall a. IO a
noValuesLeft = 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
      [] -> ([], forall a. Maybe a
Nothing)
      a
a : [a]
as -> ([a]
as, 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
  IORef [a]
ref <- forall a. a -> IO (IORef a)
newIORef []
  (a -> IO ()) -> IO ()
action (\ a
x -> forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
ref forall a b. (a -> b) -> a -> b
$ \ [a]
xs -> (a
x forall a. a -> [a] -> [a]
: [a]
xs, ()))
  forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IORef a -> IO a
readIORef IORef [a]
ref