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

{- | Run MockT monad.
  After run, verification is performed to see if the stub function has been applied.

  @
  import Test.Hspec
  import Test.MockCat
  ...

  class (Monad m) => FileOperation m where
    writeFile :: FilePath -\> Text -\> m ()
    readFile :: FilePath -\> m Text

  operationProgram ::
    FileOperation m =\>
    FilePath -\>
    FilePath -\>
    m ()
  operationProgram inputPath outputPath = do
    content \<- readFile inputPath
    writeFile outputPath content

  makeMock [t|FileOperation|]

  spec :: Spec
  spec = do
    it "test runMockT" do
      result \<- runMockT do
        _readFile $ "input.txt" |\> pack "content"
        _writeFile $ "output.text" |\> pack "content" |\> ()
        operationProgram "input.txt" "output.text"

      result `shouldBe` ()
  @

-}
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

{- | Specify how many times a stub function should be applied.

  @
  import Test.Hspec
  import Test.MockCat
  ...

  class (Monad m) => FileOperation m where
    writeFile :: FilePath -\> Text -\> m ()
    readFile :: FilePath -\> m Text

  operationProgram ::
    FileOperation m =>
    FilePath ->
    FilePath ->
    m ()
  operationProgram inputPath outputPath = do
    content <- readFile inputPath
    when (content == pack "ng") $ writeFile outputPath content

  makeMock [t|FileOperation|]

  spec :: Spec
  spec = do
    it "test runMockT" do
      result <- runMockT do
        _readFile ("input.txt" |> pack "content")
        _writeFile ("output.text" |> pack "content" |> ()) `applyTimesIs` 0
        operationProgram "input.txt" "output.text"

      result `shouldBe` ()

  @

-}
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)