{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Test.MockCat.MockT (MockT(..), Definition(..), runMockT, applyTimesIs, neverApply) where
import Control.Monad.State
( StateT(..), MonadIO(..), MonadTrans(..), modify, execStateT )
import GHC.TypeLits (KnownSymbol)
import Data.Data (Proxy)
import Test.MockCat.Mock (Mock, shouldApplyTimesToAnything)
import Data.Foldable (for_)
newtype MockT m a = MockT { forall (m :: * -> *) a. MockT m a -> StateT [Definition] m a
st :: StateT [Definition] m a }
deriving ((forall a b. (a -> b) -> MockT m a -> MockT m b)
-> (forall a b. a -> MockT m b -> MockT m a) -> Functor (MockT m)
forall a b. a -> MockT m b -> MockT m a
forall a b. (a -> b) -> MockT m a -> MockT m b
forall (m :: * -> *) a b. Functor m => a -> MockT m b -> MockT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockT m a -> MockT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MockT m a -> MockT m b
fmap :: forall a b. (a -> b) -> MockT m a -> MockT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> MockT m b -> MockT m a
<$ :: forall a b. a -> MockT m b -> MockT m a
Functor, Functor (MockT m)
Functor (MockT m) =>
(forall a. a -> MockT m a)
-> (forall a b. MockT m (a -> b) -> MockT m a -> MockT m b)
-> (forall a b c.
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c)
-> (forall a b. MockT m a -> MockT m b -> MockT m b)
-> (forall a b. MockT m a -> MockT m b -> MockT m a)
-> Applicative (MockT m)
forall a. a -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m b
forall a b. MockT m (a -> b) -> MockT m a -> MockT m b
forall a b c. (a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
forall (m :: * -> *). Monad m => Functor (MockT m)
forall (m :: * -> *) a. Monad m => a -> MockT m a
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m a
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
forall (m :: * -> *) a b.
Monad m =>
MockT m (a -> b) -> MockT m a -> MockT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> MockT m a
pure :: forall a. a -> MockT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MockT m (a -> b) -> MockT m a -> MockT m b
<*> :: forall a b. MockT m (a -> b) -> MockT m a -> MockT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
liftA2 :: forall a b c. (a -> b -> c) -> MockT m a -> MockT m b -> MockT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
*> :: forall a b. MockT m a -> MockT m b -> MockT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m a
<* :: forall a b. MockT m a -> MockT m b -> MockT m a
Applicative, Applicative (MockT m)
Applicative (MockT m) =>
(forall a b. MockT m a -> (a -> MockT m b) -> MockT m b)
-> (forall a b. MockT m a -> MockT m b -> MockT m b)
-> (forall a. a -> MockT m a)
-> Monad (MockT m)
forall a. a -> MockT m a
forall a b. MockT m a -> MockT m b -> MockT m b
forall a b. MockT m a -> (a -> MockT m b) -> MockT m b
forall (m :: * -> *). Monad m => Applicative (MockT m)
forall (m :: * -> *) a. Monad m => a -> MockT m a
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
forall (m :: * -> *) a b.
Monad m =>
MockT m a -> (a -> MockT m b) -> MockT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> (a -> MockT m b) -> MockT m b
>>= :: forall a b. MockT m a -> (a -> MockT m b) -> MockT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MockT m a -> MockT m b -> MockT m b
>> :: forall a b. MockT m a -> MockT m b -> MockT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> MockT m a
return :: forall a. a -> MockT m a
Monad, (forall (m :: * -> *). Monad m => Monad (MockT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> MockT m a)
-> MonadTrans MockT
forall (m :: * -> *). Monad m => Monad (MockT m)
forall (m :: * -> *) a. Monad m => m a -> MockT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> MockT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> MockT m a
MonadTrans, Monad (MockT m)
Monad (MockT m) =>
(forall a. IO a -> MockT m a) -> MonadIO (MockT m)
forall a. IO a -> MockT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (MockT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MockT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MockT m a
liftIO :: forall a. IO a -> MockT m a
MonadIO)
data Definition = forall f p sym. KnownSymbol sym => Definition {
()
symbol :: Proxy sym,
()
mock :: Mock f p,
()
verify :: Mock f p -> IO ()
}
runMockT :: MonadIO m => MockT m a -> m a
runMockT :: forall (m :: * -> *) a. MonadIO m => MockT m a -> m a
runMockT (MockT StateT [Definition] m a
s) = do
(a, [Definition])
r <- StateT [Definition] m a -> [Definition] -> m (a, [Definition])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT [Definition] m a
s []
let
!a :: a
a = (a, [Definition]) -> a
forall a b. (a, b) -> a
fst (a, [Definition])
r
defs :: [Definition]
defs = (a, [Definition]) -> [Definition]
forall a b. (a, b) -> b
snd (a, [Definition])
r
[Definition] -> (Definition -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Definition]
defs (\(Definition Proxy sym
_ Mock f p
m Mock f p -> IO ()
v) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Mock f p -> IO ()
v Mock f p
m)
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
applyTimesIs :: Monad m => MockT m () -> Int -> MockT m ()
applyTimesIs :: forall (m :: * -> *). Monad m => MockT m () -> Int -> MockT m ()
applyTimesIs (MockT StateT [Definition] m ()
st) Int
a = StateT [Definition] m () -> MockT m ()
forall (m :: * -> *) a. StateT [Definition] m a -> MockT m a
MockT do
[Definition]
defs <- m [Definition] -> StateT [Definition] m [Definition]
forall (m :: * -> *) a. Monad m => m a -> StateT [Definition] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Definition] -> StateT [Definition] m [Definition])
-> m [Definition] -> StateT [Definition] m [Definition]
forall a b. (a -> b) -> a -> b
$ StateT [Definition] m () -> [Definition] -> m [Definition]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT [Definition] m ()
st []
let newDefs :: [Definition]
newDefs = (Definition -> Definition) -> [Definition] -> [Definition]
forall a b. (a -> b) -> [a] -> [b]
map (\(Definition Proxy sym
s Mock f p
m Mock f p -> IO ()
_) -> Proxy sym -> Mock f p -> (Mock f p -> IO ()) -> Definition
forall f p (sym :: Symbol).
KnownSymbol sym =>
Proxy sym -> Mock f p -> (Mock f p -> IO ()) -> Definition
Definition Proxy sym
s Mock f p
m (Mock f p -> Int -> IO ()
forall fun params. Mock fun params -> Int -> IO ()
`shouldApplyTimesToAnything` Int
a)) [Definition]
defs
([Definition] -> [Definition]) -> StateT [Definition] m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++ [Definition]
newDefs)
neverApply :: Monad m => MockT m () -> MockT m ()
neverApply :: forall (m :: * -> *). Monad m => MockT m () -> MockT m ()
neverApply (MockT StateT [Definition] m ()
st) = StateT [Definition] m () -> MockT m ()
forall (m :: * -> *) a. StateT [Definition] m a -> MockT m a
MockT do
[Definition]
defs <- m [Definition] -> StateT [Definition] m [Definition]
forall (m :: * -> *) a. Monad m => m a -> StateT [Definition] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Definition] -> StateT [Definition] m [Definition])
-> m [Definition] -> StateT [Definition] m [Definition]
forall a b. (a -> b) -> a -> b
$ StateT [Definition] m () -> [Definition] -> m [Definition]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT [Definition] m ()
st []
let newDefs :: [Definition]
newDefs = (Definition -> Definition) -> [Definition] -> [Definition]
forall a b. (a -> b) -> [a] -> [b]
map (\(Definition Proxy sym
s Mock f p
m Mock f p -> IO ()
_) -> Proxy sym -> Mock f p -> (Mock f p -> IO ()) -> Definition
forall f p (sym :: Symbol).
KnownSymbol sym =>
Proxy sym -> Mock f p -> (Mock f p -> IO ()) -> Definition
Definition Proxy sym
s Mock f p
m (Mock f p -> Int -> IO ()
forall fun params. Mock fun params -> Int -> IO ()
`shouldApplyTimesToAnything` Int
0)) [Definition]
defs
([Definition] -> [Definition]) -> StateT [Definition] m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([Definition] -> [Definition] -> [Definition]
forall a. [a] -> [a] -> [a]
++ [Definition]
newDefs)