packages feed

inspection-testing 0.2.0.1 → 0.3

raw patch · 15 files changed

+327/−115 lines, 15 filesdep ~basedep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, ghc

API changes (from Hackage documentation)

- Test.Inspection: NoType :: Name -> Property
- Test.Inspection.Internal: KeepAlive :: KeepAlive
- Test.Inspection.Internal: data KeepAlive
- Test.Inspection.Internal: instance Data.Data.Data Test.Inspection.Internal.KeepAlive
+ Test.Inspection: NoTypeClasses :: [Name] -> Property
+ Test.Inspection: NoTypes :: [Name] -> Property
+ Test.Inspection: hasNoGenerics :: Name -> Obligation
+ Test.Inspection: hasNoTypeClasses :: Name -> Obligation
+ Test.Inspection: hasNoTypeClassesExcept :: Name -> [Name] -> Obligation
+ Test.Inspection.Core: doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr)

Files

ChangeLog.md view
@@ -1,5 +1,15 @@ # Revision history for inspection-testing +## 0.3 -- UNRELEASED++* On GHC-8.5 or newer, use of `inspect` or `inspectTest` without actually+  loading the plugin will cause compilation to fail at type-checking time+  (thanks to @adamgundry for the idea)+* Support for `hasNoTypeClass` (thanks to @phadej)+* Support for `hasNoGenerics` (thanks to @isovector)+* No need to keep referenced variables alive using annotations:+  Simply mentioning them in a Template Haskell splice keeps them alive!+ ## 0.2.0.1 -- 2018-02-02  * Support GHC HEAD (8.5)
README.md view
@@ -75,10 +75,15 @@  Currently, inspection-testing supports - * checking two definitions to be equal (useful in the context of generic programming)- * checking the absence of a certain type (useful in the context of list or stream fusion)+ * checking two definitions to be equal (useful in the context of generic+   programming)+ * checking the absence of a certain type (useful in the context of list or+   stream fusion)  * checking the absence of allocation (generally useful) +In general, the checks need to be placed in the same module as the+checked-definition.+ Possible further applications includes   * checking that all recursive functions are (efficiently called) join-points@@ -87,8 +92,8 @@  Let me know if you need any of these, or have further ideas. -Help, I am drowining in Core!------------------------------+Help, I am drowning in Core!+----------------------------  inspection-testing prints the Core more or less like GHC would, and the same flags can be used to control the level of detail. In particular, you might want
Test/Inspection.hs view
@@ -11,6 +11,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-} module Test.Inspection (     -- * Synopsis     -- $synposis@@ -21,32 +24,33 @@     Result(..),     -- * Defining obligations     Obligation(..), mkObligation, Property(..),-    (===), (==-), (=/=), hasNoType,+    -- * Convenience functions+    -- $convenience+    (===), (==-), (=/=), hasNoType, hasNoGenerics,+    hasNoTypeClasses, hasNoTypeClassesExcept, ) where -import Control.Monad import Language.Haskell.TH-import Language.Haskell.TH.Syntax (getQ, putQ, liftData, addTopDecls)+import Language.Haskell.TH.Syntax (Quasi(qNewName), liftData, addTopDecls)+#if MIN_VERSION_GLASGOW_HASKELL(8,5,0,0)+import Language.Haskell.TH.Syntax (getQ, putQ) -- only for needsPluginQ+#endif import Data.Data import GHC.Exts (lazy)--import Data.Maybe (fromMaybe)-import qualified Data.Set as S--import Test.Inspection.Internal+import GHC.Generics (V1(), U1(), M1(), K1(), (:+:), (:*:), (:.:), Rec1, Par1)  {- $synposis  To use inspection testing, you need to - 1. enable the @TemplateHaskell@ langauge extension+ 1. enable the @TemplateHaskell@ language extension  2. load the plugin using @-fplugin Test.Inspection.Plugin@  3. declare your proof obligations using 'inspect' or 'inspectTest'  An example module is  @-{&#45;\# LANGAUGE TemplateHaskell \#&#45;}+{&#45;\# LANGUAGE TemplateHaskell \#&#45;} {&#45;\# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin \#&#45;} module Simple where @@ -75,7 +79,7 @@     { target      :: Name         -- ^ The target of a test obligation; invariably the name of a local         -- definition. To get the name of a function @foo@, write @'foo@. This requires-        -- @{&#45;\# LANGAUGE TemplateHaskell \#&#45;}@.+        -- @{&#45;\# LANGUAGE TemplateHaskell \#&#45;}@.     , property    :: Property         -- ^ The property of the target to be checked.     , testName :: Maybe String@@ -100,23 +104,22 @@     -- @f = g@, or the definition of @g@ is @g = f@, or if the definitions are     -- @f = e@ and @g = e@.     --+    -- In general @f@ and @g@ need to be defined in this module, so that their+    -- actual defintions can be inspected.+    --     -- If the boolean flag is true, then ignore types during the comparison.     = EqualTo Name Bool -    -- | Does this type not occur anywhere in the definition of the function+    -- | Do none of these types anywhere in the definition of the function     -- (neither locally bound nor passed as arguments)-    | NoType Name+    | NoTypes [Name]      -- | Does this function perform no heap allocations.     | NoAllocation-    deriving Data -allLocalNames :: Obligation -> [Name]-allLocalNames obl = target obl : goProp (property obl)-  where-    goProp :: Property -> [Name]-    goProp (EqualTo n _) = [n]-    goProp _ = []+    -- | Does this value contain dictionaries (/except/ of the listed classes).+    | NoTypeClasses [Name]+    deriving Data  -- | Creates an inspection obligation for the given function name -- with default values for the optional fields.@@ -130,18 +133,23 @@     , storeResult = Nothing     } --- | Convenience function to declare two functions to be equal+{- $convenience++These convenience functions create common test obligations directly.+-}++-- | Declare two functions to be equal (see 'EqualTo') (===) :: Name -> Name -> Obligation (===) = mkEquality False False infix 9 === --- | Convenience function to declare two functions to be equal, but ignoring--- type lambdas, type arguments and type casts+-- | Declare two functions to be equal, but ignoring+-- type lambdas, type arguments and type casts (see 'EqualTo') (==-) :: Name -> Name -> Obligation (==-) = mkEquality False True infix 9 ==- --- | Convenience function to declare two functions to be equal, but expect the test to fail+-- | Reclare two functions to be equal, but expect the test to fail (see 'EqualTo' and 'expectFail') -- (This is useful for documentation purposes, or as a TODO list.) (=/=) :: Name -> Name -> Obligation (=/=) = mkEquality True False@@ -152,21 +160,72 @@     (mkObligation n1 (EqualTo n2 ignore_types))         { expectFail = expectFail } --- | Convenience function to declare that a function’s implementation does not--- mention a type+-- | Declare that in a function’s implementation, the given type does not occur. ----- @inspect $ fusedFunction `hasNoType` ''[]@+-- More precisely: No locally bound variable (let-bound, lambda-bound or+-- pattern-bound) has a type that contains the given type constructor.+--+-- @'inspect' $ fusedFunction ``hasNoType`` ''[]@ hasNoType :: Name -> Name -> Obligation-hasNoType n tn = mkObligation n (NoType tn)+hasNoType n tn = mkObligation n (NoTypes [tn]) +-- | Declare that a function’s implementation does not contain any generic types.+-- This is just 'asNoType' applied to the usual type constructors used in+-- "GHC.Generics".+--+-- @inspect $ hasNoGenerics genericFunction@+hasNoGenerics :: Name -> Obligation+hasNoGenerics n =+    mkObligation n+        (NoTypes [ ''V1, ''U1, ''M1, ''K1, ''(:+:), ''(:*:), ''(:.:), ''Rec1+                 , ''Par1+                 ])++-- | Declare that a function's implementation does not include dictionaries.+--+-- More precisely: No locally bound variable (let-bound, lambda-bound or+-- pattern-bound) has a type that contains a type that mentions a type class.+--+-- @'inspect' $ 'hasNoTypeClasses' specializedFunction@+hasNoTypeClasses :: Name -> Obligation+hasNoTypeClasses n = hasNoTypeClassesExcept n []++-- | A variant of 'hasNoTypeClasses', which white-lists some type-classes.+--+-- @'inspect' $ fieldLens ``hasNoTypeClassesExcept`` [''Functor]@+hasNoTypeClassesExcept :: Name -> [Name] -> Obligation+hasNoTypeClassesExcept n tns = mkObligation n (NoTypeClasses tns)++-- | Internal class that prevents compilation when the plugin is not loaded+class PluginNotLoaded++_pretendItsUsed :: PluginNotLoaded => ()+_pretendItsUsed = ()++needsPluginQ :: Q [Dec]+#if MIN_VERSION_GLASGOW_HASKELL(8,5,0,0)+needsPluginQ = getQ >>= \case+    Just NeedsPluginInserted -> return []+    Nothing -> do+        putQ NeedsPluginInserted+        [d| needsTestInspectionPlugin :: ()+            needsTestInspectionPlugin = (() :: PluginNotLoaded => ())+            |]++-- | To ensure we insert needsPlugin only once+data NeedsPluginInserted = NeedsPluginInserted+#else+needsPluginQ = return []+#endif+ -- The exported TH functions  inspectCommon :: AnnTarget -> Obligation -> Q [Dec] inspectCommon annTarget obl = do     loc <- location     annExpr <- liftData (obl { srcLoc = Just loc })-    rememberDs <- concat <$> mapM rememberName (allLocalNames obl)-    pure $ PragmaD (AnnP annTarget annExpr) : rememberDs+    np <- needsPluginQ+    pure $ np ++ [PragmaD (AnnP annTarget annExpr)]  -- | As seen in the example above, the entry point to inspection testing is the -- 'inspect' function, to which you pass an 'Obligation'.@@ -192,7 +251,7 @@ inspectTest :: Obligation -> Q Exp inspectTest obl = do     nameS <- genName-    name <- newName nameS+    name <- newUniqueName nameS     anns <- inspectCommon (ValueAnnotation name) obl     addTopDecls $         [ SigD name (ConT ''Result)@@ -205,22 +264,11 @@         (r,c) <- loc_start <$> location         return $ "inspect_" ++ show r ++ "_" ++ show c --- We need to ensure that names refernced in obligations are kept alive--- We do so by annotating them with 'KeepAlive'--newtype SeenNames = SeenNames (S.Set Name)---- Annotate each name only once-nameSeen :: Name -> Q Bool-nameSeen n = do-    SeenNames s <- fromMaybe (SeenNames S.empty) <$> getQ-    let seen = n `S.member` s-    unless seen $ putQ $ SeenNames (S.insert n s)-    pure seen--rememberName :: Name -> Q [Dec]-rememberName n = do-    seen <- nameSeen n-    if seen then return [] else do-        kaExpr <- liftData KeepAlive-        pure [ PragmaD (AnnP (ValueAnnotation n) kaExpr) ]+-- | Like newName, but even more unique (unique across different splices),+-- and with unique @nameBase@s. Precondition: the string is a valid Haskell+-- alphanumeric identifier (could be upper- or lower-case).+newUniqueName :: Quasi q => String -> q Name+newUniqueName str = do+  n <- qNewName str+  qNewName $ show n+-- This is from https://ghc.haskell.org/trac/ghc/ticket/13054#comment:1
Test/Inspection/Core.hs view
@@ -8,6 +8,7 @@   , eqSlice   , freeOfType   , doesNotAllocate+  , doesNotContainTypeClasses   ) where  import CoreSyn@@ -22,6 +23,7 @@ import PprCore import Coercion import Util+import TyCon (TyCon, isClassTyCon)  import qualified Data.Set as S import Control.Monad.State.Strict@@ -195,7 +197,10 @@ -- | Returns @True@ if the given core expression mentions no type constructor -- anywhere that has the given name. freeOfType :: Slice -> Name -> Maybe (Var, CoreExpr)-freeOfType slice tcN = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]+freeOfType slice tcN = allTyCons (\tc -> getName tc /= tcN) slice++allTyCons :: (TyCon -> Bool) -> Slice -> Maybe (Var, CoreExpr)+allTyCons predicate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]   where     goV v = goT (varType v) @@ -216,7 +221,7 @@      goT (TyVarTy _)      = True     goT (AppTy t1 t2)    = goT t1 && goT t2-    goT (TyConApp tc ts) = getName tc /= tcN && all goT ts+    goT (TyConApp tc ts) = predicate tc && all goT ts                         -- ↑ This is the crucial bit     goT (ForAllTy _ t)   = goT t #if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)@@ -268,3 +273,7 @@         -- unlifted      goA a (_,_, e) = go a e++doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr)+doesNotContainTypeClasses slice tcNs+    = allTyCons (\tc -> not (isClassTyCon tc) || any (getName tc ==) tcNs) slice
− Test/Inspection/Internal.hs
@@ -1,23 +0,0 @@--- |--- Description : Inspection testing--- Copyright   : (c) Joachim Breitner, 2017--- License     : MIT--- Maintainer  : mail@joachim-breitner.de--- Portability : GHC specifc----{-# LANGUAGE DeriveDataTypeable #-}-module Test.Inspection.Internal-    ( KeepAlive(..)-    ) where--import Data.Data---- | An annotation to keep names alive-data KeepAlive = KeepAlive-    deriving Data--{--keep_alive :: a-keep_alive = keep_alive-{-# NOINLINE keep_alive #-}--}
Test/Inspection/Plugin.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-} module Test.Inspection.Plugin (plugin) where  import Control.Monad@@ -11,20 +12,22 @@ import Data.Either import Data.Maybe import Data.Bifunctor+import Data.List import qualified Data.Map.Strict as M import qualified Language.Haskell.TH.Syntax as TH  import GhcPlugins hiding (SrcLoc) import Outputable -import Test.Inspection.Internal (KeepAlive(..)) import Test.Inspection (Obligation(..), Property(..), Result(..))+import Test.Inspection.TcPlugin (inspectionTcPlugin) import Test.Inspection.Core  -- | The plugin. It supports the option @-fplugin-opt=Test.Inspection.Plugin:keep-going@ to -- ignore a failing build. plugin :: Plugin-plugin = defaultPlugin { installCoreToDos = install }+plugin = defaultPlugin { installCoreToDos = install+                       , tcPlugin = const (Just inspectionTcPlugin)  }  data UponFailure = AbortCompilation | KeepGoing deriving Eq @@ -41,17 +44,9 @@ extractObligations :: ModGuts -> (ModGuts, [(ResultTarget, Obligation)]) extractObligations guts = (guts', obligations)   where-    (anns', obligations) = partitionMaybe findObligationAnn (mg_anns guts)-    anns_clean = filter (not . isKeepAliveAnn) anns'+    (anns_clean, obligations) = partitionMaybe findObligationAnn (mg_anns guts)     guts' = guts { mg_anns = anns_clean } -isKeepAliveAnn :: Annotation -> Bool-isKeepAliveAnn (Annotation (NamedTarget _) payload)-    | Just KeepAlive <- fromSerialized deserializeWithData payload-    = True-isKeepAliveAnn _-    = False- findObligationAnn :: Annotation -> Maybe (ResultTarget, Obligation) findObligationAnn (Annotation (ModuleTarget _) payload)     | Just obl <- fromSerialized deserializeWithData payload@@ -71,8 +66,11 @@ prettyProperty :: Module -> TH.Name -> Property -> String prettyProperty mod target (EqualTo n2 False)  = showTHName mod target ++ " === " ++ showTHName mod n2 prettyProperty mod target (EqualTo n2 True)   = showTHName mod target ++ " ==- " ++ showTHName mod n2-prettyProperty mod target (NoType t)          = showTHName mod target ++ " `hasNoType` " ++ showTHName mod t+prettyProperty mod target (NoTypes [t])       = showTHName mod target ++ " `hasNoType` " ++ showTHName mod t+prettyProperty mod target (NoTypes ts)        = showTHName mod target ++ " mentions none of " ++ intercalate ", " (map (showTHName mod) ts) prettyProperty mod target NoAllocation        = showTHName mod target ++ " does not allocate"+prettyProperty mod target (NoTypeClasses [])        = showTHName mod target ++ " does not contain dictionary values"+prettyProperty mod target (NoTypeClasses ts)        = showTHName mod target ++ " does not contain dictionary values except of " ++ intercalate ", " (map (showTHName mod) ts)  -- | Like show, but omit the module name if it is he current module showTHName :: Module -> TH.Name -> String@@ -150,8 +148,8 @@  checkProperty :: ModGuts -> TH.Name -> Property -> CoreM CheckResult checkProperty guts thn1 (EqualTo thn2 ignore_types) = do-    Just n1 <- thNameToGhcName thn1-    Just n2 <- thNameToGhcName thn2+    n1 <- fromTHName thn1+    n2 <- fromTHName thn2      let p1 = lookupNameInGuts guts n1     let p2 = lookupNameInGuts guts n2@@ -178,24 +176,24 @@        -> pure . Just $ ppr n1 <+> text " and " <+> ppr n2 <+>                 text "are different external names"        | Nothing <- p1-       -> pure . Just $ ppr n1 <+> text "is an external names"+       -> pure . Just $ ppr n1 <+> text "is an external name"        | Nothing <- p2-       -> pure . Just $ ppr n2 <+> text "is an external names"+       -> pure . Just $ ppr n2 <+> text "is an external name"   where     binds = flattenBinds (mg_binds guts) -checkProperty guts thn (NoType tht) = do-    Just n <- thNameToGhcName thn-    Just t <- thNameToGhcName tht+checkProperty guts thn (NoTypes thts) = do+    n <- fromTHName thn+    ts <- mapM fromTHName thts     case lookupNameInGuts guts n of         Nothing -> pure . Just $ ppr n <+> text "is not a local name"-        Just (v, _) -> case freeOfType (slice binds v) t of+        Just (v, _) -> case msum $ map (freeOfType (slice binds v)) ts of             Just _ -> pure . Just $ pprSlice (slice binds v)             Nothing -> pure Nothing   where binds = flattenBinds (mg_binds guts)  checkProperty guts thn NoAllocation = do-    Just n <- thNameToGhcName thn+    n <- fromTHName thn     case lookupNameInGuts guts n of         Nothing -> pure . Just $ ppr n <+> text "is not a local name"         Just (v, _) -> case doesNotAllocate (slice binds v) of@@ -203,6 +201,24 @@             Nothing -> pure Nothing   where binds = flattenBinds (mg_binds guts) +checkProperty guts thn (NoTypeClasses thts) = do+    n <- fromTHName thn+    ts <- mapM fromTHName thts+    case lookupNameInGuts guts n of+        Nothing -> pure . Just $ ppr n <+> text "is not a local name"+        Just (v, _) -> case doesNotContainTypeClasses (slice binds v) ts of+            Just (v',e') -> pure . Just $ nest 4 (ppr v' <+> text "=" <+> ppr e')+            Nothing -> pure Nothing+  where binds = flattenBinds (mg_binds guts)+    ++fromTHName :: TH.Name -> CoreM Name+fromTHName thn = thNameToGhcName thn >>= \case+    Nothing -> do+        errorMsg $ text "Could not resolve TH name" <+> text (show thn)+        liftIO $ exitFailure -- kill the compiler. Is there a nicer way?+    Just n -> return n+ storeResults :: Updates -> ModGuts -> CoreM ModGuts storeResults = flip (foldM (flip (uncurry go)))   where@@ -213,7 +229,7 @@  dcExpr :: TH.Name -> CoreM CoreExpr dcExpr thn = do-    Just name <- thNameToGhcName thn+    name <- fromTHName thn     dc <- lookupDataCon name     pure $ Var (dataConWrapId dc) 
+ Test/Inspection/TcPlugin.hs view
@@ -0,0 +1,62 @@+-- | See "Test.Inspection".+--+{-# LANGUAGE CPP #-}+module Test.Inspection.TcPlugin (inspectionTcPlugin) where++-- For the TC plugin+import Module     (mkModuleName)+import OccName    (mkTcOcc)+import TcEvidence+import TcPluginM+import TcRnTypes+import Class+#if MIN_VERSION_GLASGOW_HASKELL(8,5,0,0)+import MkCore+import TyCon+#endif+import Type++inspectionTcPlugin :: TcPlugin+inspectionTcPlugin =+  TcPlugin { tcPluginInit  = lookupPNLTyCon+           , tcPluginSolve = solvePNL+           , tcPluginStop  = const (return ())+           }++lookupPNLTyCon :: TcPluginM Class+lookupPNLTyCon = do+    Found _ md   <- findImportedModule testInspectionModule Nothing+    pnlNm <- lookupOrig md (mkTcOcc "PluginNotLoaded")+    tcLookupClass pnlNm+  where+    testInspectionModule  = mkModuleName "Test.Inspection"++#if MIN_VERSION_GLASGOW_HASKELL(8,5,0,0)+mkNullaryEv :: Class -> EvTerm+mkNullaryEv cls = EvExpr appDc+  where+    tyCon = classTyCon cls+    dc = tyConSingleDataCon tyCon+    appDc = mkCoreConApps dc []+# else+mkNullaryEv :: Class -> EvTerm+mkNullaryEv _ = error "Test.Inspection.TcPlugin needs GHC 8.6 or later"+#endif++findClassConstraint :: Class -> Ct -> Bool+findClassConstraint cls ct+    | Just (cls', []) <- getClassPredTys_maybe (ctPred ct)+    , cls' == cls+    = True+    | otherwise+    = False++solvePNL :: Class -- ^ PNL's TyCon+         -> [Ct]  -- ^ [G]iven constraints+         -> [Ct]  -- ^ [D]erived constraints+         -> [Ct]  -- ^ [W]anted constraints+         -> TcPluginM TcPluginResult+solvePNL inspectionTcCls _ _ wanteds =+    return $ TcPluginOk [(mkNullaryEv inspectionTcCls, x)| x <- our_wanteds ] []+  where+    our_wanteds = filter (findClassConstraint inspectionTcCls) wanteds
+ examples/Dictionary.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+module Dictionary (main) where++import Test.Inspection+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad (replicateM_)+import Data.Traversable (foldMapDefault)+import Data.Semigroup (Semigroup)++putStrLn' :: MonadIO m =>  String -> m ()+putStrLn' = liftIO . putStrLn++action :: MonadIO m => m ()+action = replicateM_ 10 (putStrLn' "foo")++specialized :: IO ()+specialized = action++inspect $ hasNoTypeClasses 'specialized+inspect $ (hasNoTypeClasses 'action) { expectFail = True }++inspect $ hasNoTypeClassesExcept 'action [''MonadIO, ''Monad, ''Applicative, ''Functor]++listFoldMap :: Monoid m => (a -> m) -> [a] -> m+listFoldMap = foldMapDefault++#if __GLASGOW_HASKELL__ >= 802+inspect $ hasNoTypeClassesExcept 'listFoldMap [''Monoid, ''Semigroup]+#else+inspect $ (hasNoTypeClassesExcept 'listFoldMap [''Monoid, ''Semigroup]) { expectFail = True }+#endif+++main :: IO ()+main = return ()
examples/Fusion.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-module Fusion where+module Fusion (main) where  import Test.Inspection import Data.List (foldl', sort)
+ examples/Generics.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveGeneric, TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-}+module Generics (main) where++import GHC.Generics+import Test.Inspection++data Record = MkRecord+  { fieldA :: Int+  , fieldB :: Bool+  } deriving Generic+++myRecord :: Record+myRecord = MkRecord 1 True++genericRep :: Rep Record x+genericRep = from myRecord+++roundTripRep :: Record+roundTripRep = to $ from myRecord++main :: IO ()+main = return ()++-- the check+inspect $ hasNoGenerics 'roundTripRep+inspect $ (hasNoGenerics 'genericRep) { expectFail = True }+
examples/NS_NP.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -O #-} {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-module NS_NP where+module NS_NP (main) where  import Test.Inspection 
examples/Simple.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}-module Simple where+module Simple (main) where  import Test.Inspection import Data.Maybe
examples/SimpleTest.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -O -fplugin=Test.Inspection.Plugin #-}-module Main where+module Main (main) where  import Test.Inspection import Data.Maybe
examples/Text.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-module Text where+module Text (main) where  import Test.Inspection 
inspection-testing.cabal view
@@ -1,5 +1,5 @@ name:                inspection-testing-version:             0.2.0.1+version:             0.3 synopsis:            GHC plugin to do inspection testing description:         Some carefully crafted libraries make promises to their                      users beyond functionality and performance.@@ -43,9 +43,9 @@ library   exposed-modules:     Test.Inspection                        Test.Inspection.Plugin-                       Test.Inspection.Internal                        Test.Inspection.Core-  build-depends:       base >=4.9 && <4.12+  other-modules:       Test.Inspection.TcPlugin+  build-depends:       base >=4.9 && <4.13   build-depends:       ghc >= 8.0.2 && <8.6   build-depends:       template-haskell   build-depends:       containers@@ -59,7 +59,7 @@   hs-source-dirs:      examples   main-is:             NS_NP.hs   build-depends:       inspection-testing-  build-depends:       base >=4.9 && <4.12+  build-depends:       base >=4.9 && <4.13   default-language:    Haskell2010   ghc-options:         -main-is NS_NP @@ -69,7 +69,7 @@   hs-source-dirs:      examples   main-is:             Simple.hs   build-depends:       inspection-testing-  build-depends:       base >=4.9 && <4.12+  build-depends:       base >=4.9 && <4.13   default-language:    Haskell2010   ghc-options:         -main-is Simple @@ -78,7 +78,7 @@   hs-source-dirs:      examples   main-is:             SimpleTest.hs   build-depends:       inspection-testing-  build-depends:       base >=4.9 && <4.12+  build-depends:       base >=4.9 && <4.13   default-language:    Haskell2010  test-suite fusion@@ -86,10 +86,28 @@   hs-source-dirs:      examples   main-is:             Fusion.hs   build-depends:       inspection-testing-  build-depends:       base >=4.9 && <4.12+  build-depends:       base >=4.9 && <4.13   default-language:    Haskell2010   ghc-options:         -main-is Fusion +test-suite generics+  type:                exitcode-stdio-1.0+  hs-source-dirs:      examples+  main-is:             Generics.hs+  build-depends:       inspection-testing+  build-depends:       base >=4.9 && <4.13+  default-language:    Haskell2010+  ghc-options:         -main-is Generics++test-suite dictionary+  type:                exitcode-stdio-1.0+  hs-source-dirs:      examples+  main-is:             Dictionary.hs+  build-depends:       inspection-testing+  build-depends:       base >=4.9 && <4.13+  default-language:    Haskell2010+  ghc-options:         -main-is Dictionary+ flag more-tests   description: Run tests that pull in specific versions of other packages   default: False@@ -100,7 +118,7 @@   main-is:             Text.hs   if flag(more-tests)     build-depends:       inspection-testing-    build-depends:       base >=4.9 && <4.12+    build-depends:       base >=4.9 && <4.13     build-depends:       text ==1.2.2.2     build-depends:       bytestring   else@@ -114,7 +132,7 @@   main-is:             GenericLens.hs   if flag(more-tests)     build-depends:       inspection-testing-    build-depends:       base >=4.9 && <4.12+    build-depends:       base >=4.9 && <4.13     build-depends:       generic-lens ==0.4.1.0   else     buildable:         False