{-# 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 :: [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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return
where
noValuesLeft :: IO a
noValuesLeft :: IO a
noValuesLeft = String -> IO a
forall a. HasCallStack => String -> IO a
assertFailure String
"stubAction: no values left"
takeValue :: [a] -> ([a], Maybe a)
takeValue :: [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)
withSpy :: ((a -> IO ()) -> IO ()) -> IO [a]
withSpy :: ((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 (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