diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for hmock +## 0.5.1.0 -- 2021-09-25 + +* HMock works with more classes with superclass constraints. +* Classes with default methods are now fully mockable. +* Builds with GHC 9.2.1 +* Fixes for GHC 8.4 and 8.6 + ## 0.5.0.0 -- 2021-09-25 * HMock now depends on `Predicate` from the `explainable-predicates` package. diff --git a/HMock.cabal b/HMock.cabal --- a/HMock.cabal +++ b/HMock.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: HMock -version: 0.5.0.0 +version: 0.5.1.0 synopsis: A flexible mock framework for testing effectful code. description: HMock is a flexible mock framework for testing effectful code in Haskell. Tests can set up expectations about @@ -42,7 +42,7 @@ Test.HMock.Internal.Step, Test.HMock.Internal.TH, Test.HMock.Internal.Util - build-depends: base >=4.11.0 && < 4.16, + build-depends: base >=4.11.0 && < 4.17, constraints >= 0.13 && < 0.14, containers >= 0.6.2 && < 0.7, data-default >= 0.7.1 && < 0.8, @@ -53,7 +53,7 @@ mtl >= 2.2.2 && < 2.3, stm >= 2.5.0 && < 2.6, syb >= 0.7.2 && < 0.8, - template-haskell >= 2.14 && < 2.18, + template-haskell >= 2.14 && < 2.19, transformers-base >= 0.4.5 && < 0.5, unliftio >= 0.2.18 && < 0.3, hs-source-dirs: src diff --git a/src/Test/HMock.hs b/src/Test/HMock.hs --- a/src/Test/HMock.hs +++ b/src/Test/HMock.hs @@ -34,7 +34,7 @@ -- copyFile :: MonadFilesystem m => 'FilePath' -> 'FilePath' -> m () -- copyFile a b = readFile a >>= writeFile b -- --- 'Test.HMock.TH.makeMockable' ''MonadFilesystem +-- 'Test.HMock.TH.makeMockable' [t|MonadFilesystem|] -- -- spec = describe "copyFile" '$' -- it "reads a file and writes its contents to another file" '$' diff --git a/src/Test/HMock/Internal/State.hs b/src/Test/HMock/Internal/State.hs --- a/src/Test/HMock/Internal/State.hs +++ b/src/Test/HMock/Internal/State.hs @@ -36,7 +36,7 @@ import Test.HMock.Mockable (Mockable (..)) import UnliftIO ( MonadIO, - MonadUnliftIO, + MonadUnliftIO(withRunInIO), STM, TVar, atomically, @@ -198,12 +198,16 @@ MonadBase b, MonadCatch, MonadMask, - MonadThrow, - MonadUnliftIO + MonadThrow ) instance MonadTrans MockT where lift = MockT . lift + +-- Note: The 'MonadUnliftIO' instance is implemented manually because deriving +-- it causes compilation failure in GHC 8.6 and 8.8. (See issue #23.) +instance MonadUnliftIO m => MonadUnliftIO (MockT m) where + withRunInIO inner = MockT $ withRunInIO $ \run -> inner (run . unMockT) -- | Applies a function to the base monad of 'MockT'. mapMockT :: (m a -> m b) -> MockT m a -> MockT m b diff --git a/src/Test/HMock/Internal/TH.hs b/src/Test/HMock/Internal/TH.hs --- a/src/Test/HMock/Internal/TH.hs +++ b/src/Test/HMock/Internal/TH.hs @@ -24,14 +24,13 @@ ) where -import Control.Monad.Extra (mapMaybeM) +import Control.Monad.Extra (mapMaybeM, concatMapM) import Data.Generics -import Data.List ((\\)) +import Data.List ((\\), nub) import Data.Maybe (catMaybes, fromMaybe) import Language.Haskell.TH import Language.Haskell.TH.Syntax (NameFlavour (..)) import Test.HMock.Internal.Util (choices) -import Data.Foldable (foldl') #if MIN_VERSION_template_haskell(2,17,0) @@ -188,50 +187,53 @@ -- | Attempts to produce sufficient constraints for the given 'Type' to be an -- instance of the given class 'Name'. resolveInstance :: Name -> [Type] -> Q (Maybe Cxt) -resolveInstance cls args - | all isTypeVar args = return (Just [foldl' AppT (ConT cls) args]) - where - isTypeVar :: Type -> Bool - isTypeVar (VarT _) = True - isTypeVar _ = False resolveInstance cls args = do decs <- reifyInstances cls args - result <- traverse (tryInstance args) decs - case catMaybes result of - [cx] -> return (Just (filter (not . null . freeTypeVars) cx)) + results <- catMaybes <$> traverse (tryInstance args) decs + case results of + [cx] -> pure (Just cx) _ -> return Nothing where tryInstance :: [Type] -> InstanceDec -> Q (Maybe Cxt) tryInstance actualArgs (InstanceD _ cx instType _) = case splitTypeApp instType of - Just (cls', instArgs) | cls' == cls -> - unifyWithin [] instArgs actualArgs >>= \case - Just tbl -> - let cx' = substTypeVars tbl <$> cx - in fmap concat . sequence <$> mapM resolveInstanceType cx' - Nothing -> return Nothing + Just (cls', instArgs) + | cls' == cls -> + unifyWithin [] instArgs actualArgs >>= \case + Just tbl -> simplifyContext (substTypeVars tbl <$> cx) + Nothing -> return Nothing _ -> return Nothing tryInstance _ _ = return Nothing -- | Attempts to produce sufficient constraints for the given 'Type' to be a -- satisfied constraint. The type should be a class applied to its type -- parameters. +-- +-- Unlike 'simplifyContext', this function always resolves the top-level +-- constraint, and returns 'Nothing' if it cannot do so. resolveInstanceType :: Type -> Q (Maybe Cxt) -resolveInstanceType t = case splitTypeApp t of - Just (cls, args) -> resolveInstance cls args - Nothing -> return Nothing +resolveInstanceType t = + maybe (pure Nothing) (uncurry resolveInstance) (splitTypeApp t) -- | Simplifies a context with complex types (requiring FlexibleContexts) to try -- to obtain one with all constraints applied to variables. +-- +-- Should return Nothing if and only if the simplified contraint is +-- unsatisfiable, which is the case if and only if it contains a component with +-- no type variables. simplifyContext :: Cxt -> Q (Maybe Cxt) -simplifyContext (p : preds) = - case splitTypeApp p of - Just (cls, args) -> - resolveInstance cls args >>= \case - Just cxt' -> fmap (cxt' ++) <$> simplifyContext preds - Nothing -> return Nothing - _ -> fmap (p :) <$> simplifyContext preds -simplifyContext [] = return (Just []) +simplifyContext preds + | all isVarApp preds = return (Just preds) + | otherwise = do + let simplifyPred t = fromMaybe [t] <$> resolveInstanceType t + components <- concatMapM simplifyPred preds + if any (null . freeTypeVars) components + then return Nothing + else return (Just (nub components)) + where + isVarApp (ConT _) = True + isVarApp (AppT t (VarT _)) | isVarApp t = True + isVarApp _ = False -- | Remove instance context from a method. -- diff --git a/src/Test/HMock/TH.hs b/src/Test/HMock/TH.hs --- a/src/Test/HMock/TH.hs +++ b/src/Test/HMock/TH.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} @@ -177,7 +176,7 @@ [Dec] -> Q Instance makeInstance options ty cx tbl ps m members = do - processedMembers <- mapM (getMethod ty m tbl) members + processedMembers <- mapM (getMethod ty m tbl) $ filter isRelevantMember members (extraMembers, methods) <- partitionEithers <$> zipWithM memberOrMethod members processedMembers return $ @@ -190,6 +189,10 @@ instExtraMembers = extraMembers } where + isRelevantMember :: Dec -> Bool + isRelevantMember DefaultSigD {} = False + isRelevantMember _ = True + memberOrMethod :: Dec -> Either [String] Method -> Q (Either Dec Method) memberOrMethod dec (Left warnings) = do when (mockVerbose options) $ mapM_ reportWarning warnings @@ -620,12 +623,8 @@ argCxt :: Type -> Q (Maybe Cxt) argCxt argTy | not (isKnownType method argTy) = return Nothing - | VarT v <- argTy = - Just <$> sequence [[t|Eq $(varT v)|], [t|Show $(varT v)|]] - | otherwise = do - eqCxt <- resolveInstance ''Eq [argTy] - showCxt <- resolveInstance ''Show [argTy] - return ((++) <$> eqCxt <*> showCxt) + | otherwise = + simplifyContext [AppT (ConT ''Eq) argTy, AppT (ConT ''Show) argTy] deriveForMockT :: MakeMockableOptions -> Type -> Q [Dec] deriveForMockT options ty = do @@ -660,8 +659,12 @@ AppT (ConT ''MonadIO) (VarT (instMonadVar inst)) ] - simplifyContext - (substTypeVar (instMonadVar inst) (AppT (ConT ''MockT) (VarT m)) <$> cx) + let mockTConstraints = + substTypeVar + (instMonadVar inst) + (AppT (ConT ''MockT) (VarT m)) + <$> cx + simplifyContext mockTConstraints >>= \case Just cxMockT -> (: []) @@ -689,7 +692,7 @@ actionExp (v : vs) e = actionExp vs [|$e $(varE v)|] body argVars = do - defaultCxt <- resolveInstance ''Default [methodResult method] + defaultCxt <- simplifyContext [AppT (ConT ''Default) (methodResult method)] let someMockMethod = case defaultCxt of Just [] -> [|mockMethod|] _ -> [|mockDefaultlessMethod|] diff --git a/test/Classes.hs b/test/Classes.hs --- a/test/Classes.hs +++ b/test/Classes.hs @@ -1,7 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} @@ -17,11 +19,13 @@ module Classes where import Control.DeepSeq (NFData (rnf)) -import Control.Exception (evaluate) +import Control.Exception (SomeException, evaluate) +import Control.Monad.Reader (MonadReader) import Control.Monad.Trans (MonadIO, liftIO) import Data.Default (Default (def)) import Data.Dynamic (Typeable) import Data.Kind (Type) +import Data.List (isInfixOf) import Language.Haskell.TH.Syntax hiding (Type) import QuasiMock import Test.HMock @@ -36,6 +40,9 @@ deriveRecursive (Just AnyclassStrategy) ''NFData ''Dec +anyQMonadFailure :: SomeException -> Bool +anyQMonadFailure e = "(Q monad failure)" `isInfixOf` show e + class MonadSimple m where simple :: String -> m () @@ -69,7 +76,7 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingGADTs `shouldThrow` anyException + missingGADTs `shouldThrow` anyQMonadFailure it "fails when TypeFamilies is disabled" $ example $ do @@ -80,7 +87,7 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingTypeFamilies `shouldThrow` anyException + missingTypeFamilies `shouldThrow` anyQMonadFailure it "fails when DataKinds is disabled" $ example $ do @@ -91,7 +98,7 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingDataKinds `shouldThrow` anyException + missingDataKinds `shouldThrow` anyQMonadFailure it "fails when FlexibleInstances is disabled" $ example $ do @@ -103,7 +110,7 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingDataKinds `shouldThrow` anyException + missingDataKinds `shouldThrow` anyQMonadFailure it "fails when MultiParamTypeClasses is disabled" $ example $ do @@ -117,7 +124,7 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingDataKinds `shouldThrow` anyException + missingDataKinds `shouldThrow` anyQMonadFailure it "fails when ScopedTypeVariables is disabled" $ example $ do @@ -131,11 +138,12 @@ _ <- runQ (makeMockable [t|MonadSimple|]) return () - missingDataKinds `shouldThrow` anyException + missingDataKinds `shouldThrow` anyQMonadFailure it "fails when too many params are given" $ example $ do let tooManyParams = runMockT $ do + allowUnexpected $ QReifyInstances_ anything anything |-> [] $(onReify [|expectAny|] ''MonadSimple) expect $ QReport_ anything (hasSubstr "is applied to too many arguments") @@ -143,7 +151,7 @@ _ <- runQ (makeMockable [t|MonadSimple IO|]) return () - tooManyParams `shouldThrow` anyException + tooManyParams `shouldThrow` anyQMonadFailure it "is mockable" $ example $ do @@ -271,6 +279,36 @@ success failure `shouldThrow` anyException +class MonadReader String m => MonadPassThroughSuper m where + withPassThroughSuper :: m () + +makeMockable [t|MonadPassThroughSuper|] + +passThroughSuperTests :: SpecWith () +passThroughSuperTests = describe "MonadPassThroughSuper" $ do + it "generates mock impl" $ + example $ do + decs <- runMockT $ do + allowUnexpected $ QReifyInstances_ anything anything |-> [] + $(onReify [|expectAny|] ''MonadPassThroughSuper) + expectAny $ + QReifyInstances_ + (eq ''MonadReader) + $( qMatch + [p| + [ VarT _, + AppT (ConT (Name (OccName "MockT") _)) (VarT _) + ] + |] + ) + |-> $( reifyInstancesStatic + ''MonadReader + [VarT (mkName "r"), AppT (ConT ''MockT) (VarT (mkName "v"))] + ) + + runQ (makeMockable [t|MonadPassThroughSuper|]) + evaluate (rnf decs) + class MonadMPTC a m where mptc :: a -> m () mptcList :: [a] -> m () @@ -429,6 +467,7 @@ it "fails without RankNTypes" $ example $ do let missingRankNTypes = runMockT $ do + allowUnexpected $ QReifyInstances_ anything anything |-> [] $(onReify [|expectAny|] ''MonadPolyArg) expectAny $ QIsExtEnabled RankNTypes |-> False expect $ @@ -437,7 +476,7 @@ _ <- runQ (makeMockable [t|MonadPolyArg|]) return () - missingRankNTypes `shouldThrow` anyException + missingRankNTypes `shouldThrow` anyQMonadFailure it "is mockable" $ example $ do @@ -543,6 +582,33 @@ x <- polyResult (3 :: Int) liftIO $ x `shouldBe` 3 +class MonadDefaultSignatures m where + methodWithDefault :: Int -> m Int + default methodWithDefault :: MonadIO m => Int -> m Int + methodWithDefault = liftIO . methodWithDefault + +instance MonadDefaultSignatures IO where + methodWithDefault = pure + +makeMockable [t|MonadDefaultSignatures|] + +defaultSignaturesTests :: SpecWith () +defaultSignaturesTests = describe "MonadDefaultSignatures" $ do + it "generates mock impl" $ + example $ do + decs <- runMockT $ do + allowUnexpected $ QReifyInstances_ anything anything |-> [] + $(onReify [|expectAny|] ''MonadDefaultSignatures) + runQ (makeMockable [t|MonadDefaultSignatures|]) + evaluate (rnf decs) + it "is mockable" $ + example . runMockT $ do + expect $ + MethodWithDefault_ anything + |=> \MethodWithDefault {} -> return 42 + x <- methodWithDefault 0 + liftIO $ x `shouldBe` 42 + class MonadExtraneousMembers m where data SomeDataType m favoriteNumber :: SomeDataType m -> Int @@ -612,6 +678,7 @@ it "fails to derive MockT when class has extra methods" $ example $ do let unmockableMethods = runMockT $ do + allowUnexpected $ QReifyInstances_ anything anything |-> [] $(onReify [|expectAny|] ''MonadExtraneousMembers) expect $ QReport_ anything (hasSubstr "has unmockable methods") @@ -619,7 +686,7 @@ _ <- runQ (makeMockable [t|MonadExtraneousMembers|]) return () - unmockableMethods `shouldThrow` anyException + unmockableMethods `shouldThrow` anyQMonadFailure it "is mockable" $ example $ do @@ -682,7 +749,7 @@ decs <- runMockT $ do allowUnexpected $ QReifyInstances_ anything anything |-> [] $(onReify [|expectAny|] ''MonadManyReturns) - $(onReifyInstances [|expectAny|] ''Default [ConT ''NoDefault]) + $(onReifyInstances [|expectAny|] ''Default [[t|NoDefault|]]) runQ (makeMockable [t|MonadManyReturns|]) evaluate (rnf decs) @@ -738,10 +805,8 @@ decs <- runMockT $ do allowUnexpected $ QReifyInstances_ anything anything |-> [] $(onReify [|expectAny|] ''MonadNestedNoDef) - $( [t|(NoDefault, String)|] - >>= onReifyInstances [|expectAny|] ''Default . (: []) - ) - $(onReifyInstances [|expectAny|] ''Default [ConT ''NoDefault]) + $(onReifyInstances [|expectAny|] ''Default [[t|(NoDefault, String)|]]) + $(onReifyInstances [|expectAny|] ''Default [[t|NoDefault|]]) runQ (makeMockable [t|MonadNestedNoDef|]) evaluate (rnf decs) @@ -763,7 +828,7 @@ _ <- runQ (makeMockable [t|Int|]) return () - wrongKind `shouldThrow` anyException + wrongKind `shouldThrow` anyQMonadFailure it "fails when given an unexpected type constructor" $ example $ do @@ -773,7 +838,7 @@ _ <- runQ (makeMockable [t|(Int, String)|]) return () - notClass `shouldThrow` anyException + notClass `shouldThrow` anyQMonadFailure it "fails when class has no params" $ example $ do @@ -787,7 +852,7 @@ _ <- runQ (makeMockable [t|ClassWithNoParams|]) return () - tooManyParams `shouldThrow` anyException + tooManyParams `shouldThrow` anyQMonadFailure it "fails when class has no mockable methods" $ example $ do @@ -797,7 +862,7 @@ _ <- runQ (makeMockable [t|Show|]) return () - noMockableMethods `shouldThrow` anyException + noMockableMethods `shouldThrow` anyQMonadFailure classTests :: SpecWith () classTests = describe "makeMockable" $ do @@ -805,6 +870,7 @@ suffixTests setupTests superTests + passThroughSuperTests mptcTests fdSpecializedTests fdGeneralTests @@ -812,6 +878,7 @@ polyArgTests unshowableArgTests monadInArgTests + defaultSignaturesTests extraneousMembersTests rankNTests defaultReturnTests diff --git a/test/Demo.hs b/test/Demo.hs --- a/test/Demo.hs +++ b/test/Demo.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} diff --git a/test/QuasiMock.hs b/test/QuasiMock.hs --- a/test/QuasiMock.hs +++ b/test/QuasiMock.hs @@ -51,6 +51,11 @@ qRecover = error "qRecover" qReifyAnnotations = error "qReifyAnnotations" +#if MIN_VERSION_template_haskell(2, 18, 0) + qGetDoc l = mockMethod (QGetDoc l) + qPutDoc l s = mockMethod (QPutDoc l s) +#endif + functionType :: [Type] -> Bool functionType = everything (||) (mkQ False isArrow) where @@ -68,25 +73,32 @@ $(onReify [|allowUnexpected|] ''Enum) $(onReify [|allowUnexpected|] ''Monad) - $(onReifyInstances [|allowUnexpected|] ''Show [ConT ''String]) - $(onReifyInstances [|allowUnexpected|] ''Eq [ConT ''String]) - $(onReifyInstances [|allowUnexpected|] ''Show [ConT ''Char]) - $(onReifyInstances [|allowUnexpected|] ''Eq [ConT ''Char]) - $(onReifyInstances [|allowUnexpected|] ''Show [ConT ''Int]) - $(onReifyInstances [|allowUnexpected|] ''Eq [ConT ''Int]) - $(onReifyInstances [|allowUnexpected|] ''Show [ConT ''Bool]) - $(onReifyInstances [|allowUnexpected|] ''Eq [ConT ''Bool]) - $(onReifyInstances [|allowUnexpected|] ''Default [TupleT 0]) - $(onReifyInstances [|allowUnexpected|] ''Default [ConT ''String]) - $(onReifyInstances [|allowUnexpected|] ''Default [ConT ''Int]) - $( onReifyInstances - [|allowUnexpected|] - ''Default - [AppT (ConT ''Maybe) (ConT ''Bool)] - ) + $(onReifyInstances [|allowUnexpected|] ''Show [[t|String|]]) + $(onReifyInstances [|allowUnexpected|] ''Eq [[t|String|]]) + $(onReifyInstances [|allowUnexpected|] ''Show [[t|Char|]]) + $(onReifyInstances [|allowUnexpected|] ''Eq [[t|Char|]]) + $(onReifyInstances [|allowUnexpected|] ''Show [[t|Int|]]) + $(onReifyInstances [|allowUnexpected|] ''Eq [[t|Int|]]) + $(onReifyInstances [|allowUnexpected|] ''Show [[t|Bool|]]) + $(onReifyInstances [|allowUnexpected|] ''Eq [[t|Bool|]]) + $(onReifyInstances [|allowUnexpected|] ''Default [[t|()|]]) + $(onReifyInstances [|allowUnexpected|] ''Default [[t|String|]]) + $(onReifyInstances [|allowUnexpected|] ''Default [[t|Int|]]) + $(onReifyInstances [|allowUnexpected|] ''Default [[t|Maybe Bool|]]) allowUnexpected $ QReifyInstances_ (eq ''Show) (is functionType) |-> [] allowUnexpected $ QReifyInstances_ (eq ''Eq) (is functionType) |-> [] + + allowUnexpected $ + QReifyInstances_ + (eq ''Show) + (elemsAre [$(qMatch [p|VarT _|])]) + |-> $(reifyInstancesStatic ''Show [VarT (mkName "a")]) + allowUnexpected $ + QReifyInstances_ + (eq ''Eq) + (elemsAre [$(qMatch [p|VarT _|])]) + |-> $(reifyInstancesStatic ''Eq [VarT (mkName "a")]) allowUnexpected $ QReifyInstances_ diff --git a/test/QuasiMockBase.hs b/test/QuasiMockBase.hs --- a/test/QuasiMockBase.hs +++ b/test/QuasiMockBase.hs @@ -46,7 +46,8 @@ reifyInstancesStatic :: Name -> [Type] -> Q Exp reifyInstancesStatic n ts = reifyInstances n ts >>= lift -onReifyInstances :: Q Exp -> Name -> [Type] -> Q Exp -onReifyInstances handler n ts = do +onReifyInstances :: Q Exp -> Name -> [Q Type] -> Q Exp +onReifyInstances handler n qts = do + ts <- sequence qts result <- reifyInstances n ts [|$handler (QReifyInstances $(lift n) $(lift ts) |-> $(lift result))|] diff --git a/test/TH.hs b/test/TH.hs --- a/test/TH.hs +++ b/test/TH.hs @@ -10,9 +10,12 @@ import Test.HMock import Test.HMock.Internal.TH (resolveInstance, unifyTypes) import Test.Hspec +import Test.Predicates (anything, eq) data NotShowable +class NoInstances a + $(pure []) thUtilSpec :: SpecWith () @@ -49,6 +52,13 @@ liftIO $ result `shouldBe` Just [(v, ConT ''Char)] describe "resolveInstance" $ do + it "fails for missing instances" $ + example $ + runMockT $ do + allowUnexpected $ QReifyInstances_ (eq ''NoInstances) anything |-> [] + result <- runQ $ resolveInstance ''NoInstances [ConT ''String] + liftIO $ result `shouldBe` Nothing + it "finds unrestricted instances" $ example $ runMockT $ do @@ -66,10 +76,8 @@ example $ runMockT $ do $(onReify [|expectAny|] ''NotShowable) - $(onReifyInstances [|expectAny|] ''Show [ConT ''NotShowable]) - $( [t|(Int, NotShowable)|] - >>= onReifyInstances [|expectAny|] ''Show . (: []) - ) + $(onReifyInstances [|expectAny|] ''Show [[t|NotShowable|]]) + $(onReifyInstances [|expectAny|] ''Show [[t|(Int, NotShowable)|]]) t <- runQ [t|(Int, NotShowable)|] result <- runQ $ resolveInstance ''Show [t]