mockcat-1.0.0.0: test/Test/MockCat/TypeClassSpec.hs
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Test.MockCat.TypeClassSpec (spec) where
import Data.Text (Text)
import Test.Hspec (Spec)
import Test.MockCat
import Prelude hiding (readFile, writeFile)
import Data.Data
import Data.List (find)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Unsafe.Coerce (unsafeCoerce)
import Data.Maybe (fromMaybe)
import Control.Monad.Reader (MonadReader)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader.Class (ask, MonadReader (local))
import Control.Monad.Trans.Class (lift)
import Control.Monad.State (MonadState (..))
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Test.MockCat.Verify as Verify
import Test.MockCat.SharedSpecDefs
import qualified Test.MockCat.TypeClassCommonSpec as SpecCommon
import Test.MockCat.Internal.Types (BuiltMock(..))
import qualified Test.MockCat.Internal.MockRegistry as Registry (register)
ensureVerifiable ::
( MonadIO m
, Verify.ResolvableMock target
) =>
target ->
m ()
ensureVerifiable target =
liftIO $ do
m <- Verify.resolveForVerification target
case m of { Just _ -> pure (); Nothing -> Verify.verificationFailure }
instance MonadIO m => FileOperation (MockT m) where
readFile path = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `readFile`.") $ findParam (Proxy :: Proxy "readFile") defs
!result = mockFn path
pure result
writeFile path content = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `writeFile`.") $ findParam (Proxy :: Proxy "writeFile") defs
!result = mockFn path content
pure result
instance MonadIO m => ApiOperation (MockT m) where
post content = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `post`.") $ findParam (Proxy :: Proxy "post") defs
!result = mockFn content
pure result
instance MonadIO m => MonadReader SpecCommon.Environment (MockT m) where
ask = MockT do
defs <- getDefinitions
let
mock = fromMaybe (error "no answer found stub function `ask`.") $ findParam (Proxy :: Proxy "ask") defs
!result = mock
pure result
local = undefined
-- instance MonadState s m => MonadState s (MockT m) where
-- get = lift get
-- put = lift . put
-- state f = lift (state f)
_ask ::
( Verify.ResolvableParamsOf env ~ ()
, MonadIO m
, Typeable env
, Show env
, Eq env
) =>
env ->
MockT m env
_ask p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "ask" (Head :> param p)
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "ask") mockInstance NoVerification)
pure mockInstance
_readFile ::
( MockBuilder params (FilePath -> Text) (Param FilePath)
, MonadIO m
) =>
params ->
MockT m (FilePath -> Text)
_readFile p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "readFile" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "readFile") mockInstance NoVerification)
pure mockInstance
_writeFile ::
( MockBuilder params (FilePath -> Text -> ()) (Param FilePath :> Param Text)
, MonadIO m
) =>
params ->
MockT m (FilePath -> Text -> ())
_writeFile p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "writeFile" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "writeFile") mockInstance NoVerification)
pure mockInstance
_post ::
( MockBuilder params (Text -> ()) (Param Text)
, MonadIO m
) =>
params ->
MockT m (Text -> ())
_post p = MockT $ do
mockFn <- liftIO $ createNamedMockFnWithParams "post" p
ensureVerifiable mockFn
addDefinition (Definition (Proxy :: Proxy "post") mockFn NoVerification)
pure mockFn
findParam :: KnownSymbol sym => Proxy sym -> [Definition] -> Maybe a
findParam pa definitions = do
let definition = find (\(Definition s _ _) -> symbolVal s == symbolVal pa) definitions
fmap (\(Definition _ f _) -> unsafeCoerce f) definition
instance AssocTypeTest IO where
type ResultType IO = Int
produce = pure 0
instance MonadIO m => TestClass (MockT m) where
getBy a = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_getBy`.") $ findParam (Proxy :: Proxy "_getBy") defs
!result = mockFn a
lift result
echo a = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_echo`.") $ findParam (Proxy :: Proxy "_echo") defs
!result = mockFn a
lift result
instance
( Eq s
, Show s
, MonadState s m
, MonadIO m
) =>
MonadStateSub s (MockT m)
where
fnState maybeValue = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fnState`.") $ findParam (Proxy :: Proxy "_fnState") defs
!result = mockFn maybeValue
lift result
instance
( MonadState String m
, MonadIO m
) =>
MonadStateSub2 s (MockT m)
where
fnState2 label = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fnState2`.") $ findParam (Proxy :: Proxy "_fnState2") defs
!result = mockFn label
lift result
instance Monad m => MonadVar2_1 (MockT m) a
instance MonadIO m => MonadVar2_1Sub (MockT m) a where
fn2_1Sub tag = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fn2_1Sub`.") $ findParam (Proxy :: Proxy "_fn2_1Sub") defs
!result = mockFn tag
lift result
instance MonadIO m => MonadVar3_1 (MockT m) a b
instance MonadIO m => MonadVar3_1Sub (MockT m) a b where
fn3_1Sub tag = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fn3_1Sub`.") $ findParam (Proxy :: Proxy "_fn3_1Sub") defs
!result = mockFn tag
lift result
instance MonadIO m => MonadVar3_2 a (MockT m) b
instance MonadIO m => MonadVar3_2Sub a (MockT m) b where
fn3_2Sub tag = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fn3_2Sub`.") $ findParam (Proxy :: Proxy "_fn3_2Sub") defs
!result = mockFn tag
lift result
instance Monad m => MonadVar2_2 a (MockT m)
instance MonadIO m => MonadVar2_2Sub a (MockT m) where
fn2_2Sub tag = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fn2_2Sub`.") $ findParam (Proxy :: Proxy "_fn2_2Sub") defs
!result = mockFn tag
lift result
instance MonadIO m => MonadVar3_3 a b (MockT m)
instance MonadIO m => MonadVar3_3Sub a b (MockT m) where
fn3_3Sub tag = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fn3_3Sub`.") $ findParam (Proxy :: Proxy "_fn3_3Sub") defs
!result = mockFn tag
lift result
instance MonadIO m => MultiApplyTest (MockT m) where
getValueBy key = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_getValueBy`.") $ findParam (Proxy :: Proxy "_getValueBy") defs
!result = mockFn key
lift result
instance MonadIO m => ExplicitlyReturnMonadicValuesTest (MockT m) where
getByExplicit label = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_getByExplicit`.") $ findParam (Proxy :: Proxy "_getByExplicit") defs
!result = mockFn label
lift result
echoExplicit label = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_echoExplicit`.") $ findParam (Proxy :: Proxy "_echoExplicit") defs
!result = mockFn label
lift result
instance MonadIO m => DefaultMethodTest (MockT m) where
defaultAction = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_defaultAction`.") $ findParam (Proxy :: Proxy "_defaultAction") defs
!result = mockFn
pure result
instance MonadIO m => AssocTypeTest (MockT m) where
type ResultType (MockT m) = ResultType m
produce = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_produce`.") $ findParam (Proxy :: Proxy "_produce") defs
!result = mockFn
pure result
instance MonadIO m => ParamThreeMonad Int Bool (MockT m) where
fnParam3_1 a b = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fnParam3_1`.") $ findParam (Proxy :: Proxy "_fnParam3_1") defs
!result = mockFn a b
lift result
fnParam3_2 = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fnParam3_2`.") $ findParam (Proxy :: Proxy "_fnParam3_2") defs
!result = mockFn
lift result
fnParam3_3 = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_fnParam3_3`.") $ findParam (Proxy :: Proxy "_fnParam3_3") defs
!result = mockFn
lift result
instance (MonadUnliftIO m) => MonadAsync (MockT m) where
mapConcurrently = traverse
_getBy ::
( MockBuilder params (String -> m Int) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m Int) ~ Param String
) =>
params ->
MockT m (String -> m Int)
_getBy p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_getBy" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_getBy") mockInstance NoVerification)
pure mockInstance
_echo ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_echo p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_echo" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_echo") mockInstance NoVerification)
pure mockInstance
_fn2_1Sub ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fn2_1Sub p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fn2_1Sub" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fn2_1Sub") mockInstance NoVerification)
pure mockInstance
_fn2_2Sub ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fn2_2Sub p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fn2_2Sub" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fn2_2Sub") mockInstance NoVerification)
pure mockInstance
_fn3_1Sub ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fn3_1Sub p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_1Sub" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fn3_1Sub") mockInstance NoVerification)
pure mockInstance
_fn3_2Sub ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fn3_2Sub p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_2Sub" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fn3_2Sub") mockInstance NoVerification)
pure mockInstance
_fn3_3Sub ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fn3_3Sub p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fn3_3Sub" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fn3_3Sub") mockInstance NoVerification)
pure mockInstance
_getValueBy ::
( MockBuilder params (String -> m String) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m String) ~ Param String
) =>
params ->
MockT m (String -> m String)
_getValueBy p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_getValueBy" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_getValueBy") mockInstance NoVerification)
pure mockInstance
_fnState ::
( MockBuilder params (Maybe s -> m s) (Param (Maybe s))
, MonadIO m
, Typeable m
, Typeable s
, Verify.ResolvableParamsOf (Maybe s -> m s) ~ Param (Maybe s)
) =>
params ->
MockT m (Maybe s -> m s)
_fnState p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fnState" p
addDefinition (Definition (Proxy :: Proxy "_fnState") mockInstance NoVerification)
pure mockInstance
_fnState2 ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_fnState2 p = MockT $ do
BuiltMock { builtMockFn = mockInstance, builtMockRecorder = verifier } <- liftIO $ buildMock (Just "_fnState2") p
registeredFn <- liftIO $ Registry.register (Just "_fnState2") verifier mockInstance
addDefinition (Definition (Proxy :: Proxy "_fnState2") registeredFn NoVerification)
pure mockInstance
_fnParam3_1 ::
( MockBuilder params (Int -> Bool -> m String) (Param Int :> Param Bool)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (Int -> Bool -> m String) ~ (Param Int :> Param Bool)
) =>
params ->
MockT m (Int -> Bool -> m String)
_fnParam3_1 p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_1" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fnParam3_1") mockInstance NoVerification)
pure mockInstance
_fnParam3_2 ::
( MockBuilder params (m Int) ()
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (m Int) ~ ()
) =>
params ->
MockT m (m Int)
_fnParam3_2 p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_2" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fnParam3_2") mockInstance NoVerification)
pure mockInstance
_fnParam3_3 ::
( MockBuilder params (m Bool) ()
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (m Bool) ~ ()
) =>
params ->
MockT m (m Bool)
_fnParam3_3 p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_fnParam3_3" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_fnParam3_3") mockInstance NoVerification)
pure mockInstance
_getByExplicit ::
( MockBuilder params (String -> m Int) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m Int) ~ Param String
) =>
params ->
MockT m (String -> m Int)
_getByExplicit p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_getByExplicit" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_getByExplicit") mockInstance NoVerification)
pure mockInstance
_echoExplicit ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_echoExplicit p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_echoExplicit" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_echoExplicit") mockInstance NoVerification)
pure mockInstance
_defaultAction ::
( MonadIO m
, Verify.ResolvableParamsOf a ~ ()
, Typeable a
, Show a
, Eq a
) =>
a ->
MockT m a
_defaultAction value = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_defaultAction" (Head :> param value)
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_defaultAction") mockInstance NoVerification)
pure mockInstance
_produce ::
( MonadIO m
, Verify.ResolvableParamsOf a ~ ()
, Typeable a
, Show a
, Eq a
) =>
a ->
MockT m a
_produce value = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_produce" (Head :> param value)
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_produce") mockInstance NoVerification)
pure mockInstance
instance MonadIO m => Teletype (MockT m) where
readTTY = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_readTTY`.") $ findParam (Proxy :: Proxy "_readTTY") defs
!result = mockFn
lift result
writeTTY a = MockT do
defs <- getDefinitions
let
mockFn = fromMaybe (error "no answer found stub function `_writeTTY`.") $ findParam (Proxy :: Proxy "_writeTTY") defs
!result = mockFn a
lift result
_readTTY ::
( MockBuilder params (m String) ()
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (m String) ~ ()
) =>
params ->
MockT m (m String)
_readTTY p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_readTTY" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_readTTY") mockInstance NoVerification)
pure mockInstance
_writeTTY ::
( MockBuilder params (String -> m ()) (Param String)
, MonadIO m
, Typeable m
, Verify.ResolvableParamsOf (String -> m ()) ~ Param String
) =>
params ->
MockT m (String -> m ())
_writeTTY p = MockT $ do
mockInstance <- liftIO $ createNamedMockFnWithParams "_writeTTY" p
ensureVerifiable mockInstance
addDefinition (Definition (Proxy :: Proxy "_writeTTY") mockInstance NoVerification)
pure mockInstance
spec :: Spec
spec = do
-- build SpecDeps and call aggregated spec entrypoint
let deps = SpecCommon.SpecDeps
{ SpecCommon.basicDeps = SpecCommon.BasicDeps _readFile _writeFile
, SpecCommon.mixedDeps = SpecCommon.MixedDeps _readFile _writeFile _post
, SpecCommon.multipleDeps = SpecCommon.MultipleDeps _ask _readFile _writeFile _post
, SpecCommon.readerContextDeps = SpecCommon.ReaderContextDeps _ask _readFile _writeFile
, SpecCommon.sequentialIODeps = SpecCommon.SequentialIODeps _readTTY _writeTTY
, SpecCommon.ttyDeps = SpecCommon.TtyDeps _readTTY _writeTTY
, SpecCommon.implicitMonadicReturnDeps = SpecCommon.ImplicitMonadicReturnDeps _getBy _echo
, SpecCommon.testClassDeps = SpecCommon.TestClassDeps _getBy _echo
, SpecCommon.argumentPatternMatchingDeps = SpecCommon.ArgumentPatternMatchingDeps _getValueBy
, SpecCommon.multiApplyDeps = SpecCommon.MultiApplyDeps _getValueBy
, SpecCommon.monadStateTransformerDeps = SpecCommon.MonadStateTransformerDeps _fnState _fnState2
, SpecCommon.stateDeps = SpecCommon.StateDeps _fnState _fnState2
, SpecCommon.multiParamTypeClassArityDeps = SpecCommon.MultiParamTypeClassArityDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub
, SpecCommon.multiParamDeps = SpecCommon.MultiParamDeps _fn2_1Sub _fn2_2Sub _fn3_1Sub _fn3_2Sub _fn3_3Sub
, SpecCommon.functionalDependenciesDeps = SpecCommon.FunctionalDependenciesDeps _fnParam3_1 _fnParam3_2 _fnParam3_3
, SpecCommon.funDeps = SpecCommon.FunDeps _fnParam3_1 _fnParam3_2 _fnParam3_3
, SpecCommon.explicitMonadicReturnDeps = SpecCommon.ExplicitMonadicReturnDeps _getByExplicit _echoExplicit
, SpecCommon.explicitReturnDeps = SpecCommon.ExplicitReturnDeps _getByExplicit _echoExplicit
, SpecCommon.defaultMethodDeps = SpecCommon.DefaultMethodDeps _defaultAction
, SpecCommon.associatedTypeFamiliesDeps = SpecCommon.AssociatedTypeFamiliesDeps _produce
, SpecCommon.assocTypeDeps = SpecCommon.AssocTypeDeps _produce
, SpecCommon.concurrencyAndUnliftIODeps = SpecCommon.ConcurrencyAndUnliftIODeps _readFile
, SpecCommon.concurrencyDeps = SpecCommon.ConcurrencyDeps _readFile
}
SpecCommon.spec deps