{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# OPTIONS_GHC -Wno-orphans #-} {- HLINT ignore "Use newtype instead of data" -} module Test.MockCat.DeriveSpec (spec) where import Test.Hspec import Test.MockCat import Control.Monad (void) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Reader (MonadReader(..), ReaderT(..), runReaderT) import Control.Monad.Except (ExceptT(..), runExceptT) import Control.Monad.IO.Class (MonadIO(..)) -- Target class for deriveMockInstances class Monad m => Logger m where logInfo :: String -> m () instance Logger IO where logInfo _ = pure () deriveMockInstances [t|Logger|] -- Complex patterns for deriveMockInstances class Monad m => ComplexLogger m where logMany :: String -> [Int] -> m () logIf :: Bool -> String -> m () instance ComplexLogger IO where logMany _ _ = pure () logIf _ _ = pure () deriveMockInstances [t|ComplexLogger|] -- Target class for deriveNoopInstance class Monad m => Auditor m where audit :: String -> m () deriveNoopInstance [t|Auditor|] -- Custom error for testing data CustomError = CustomError String deriving (Eq, Show) -- Direct MonadError mock test makeAutoLiftMock [t|MonadError CustomError|] -- Isolated monad to avoid MonadError IOException IO conflict newtype TestM a = TestM { runTestM :: IO a } deriving (Functor, Applicative, Monad, MonadIO) spec :: Spec spec = do describe "MTL instances" $ do it "can use catchError directly in MockT" $ do let action = runMockT $ do let action' = throwError "error" :: MockT (ExceptT String IO) Int action' `catchError` (\e -> if e == "error" then pure 42 else throwError e) runExceptT action `shouldReturn` Right (42 :: Int) it "can use ask directly in MockT" $ do let action = runMockT (ask :: MockT (ReaderT String IO) String) runReaderT action "env" `shouldReturn` "env" describe "deriveMockInstances" $ do it "can derive basic custom typeclass instances" $ do runMockT (logInfo "hello" :: MockT IO ()) `shouldReturn` () it "can derive complex custom typeclass instances (multi-args, list)" $ do runMockT (do logMany "counts" [1, 2, 3] logIf True "active" pure ()) `shouldReturn` () describe "deriveNoopInstance" $ do it "doesn't require stubs for noop methods" $ do runMockT (audit "something" :: MockT IO ()) `shouldReturn` () describe "makeMock/makeAutoLiftMock with MonadError" $ do it "can mock standard MonadError directly using isolated TestM" $ do let action :: MockT TestM () action = do _throwError (CustomError "fail" ~> (pure () :: MockT TestM ())) void (throwError (CustomError "fail") :: MockT TestM ()) runTestM (runMockT action) `shouldReturn` ()