{-# 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
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)
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