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