diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,12 @@ # Revision history for inspection-testing -## 0.3 -- UNRELEASED +## 0.4 -- 2018-10-12 + +* Support GHC-8.6 +* On GHC-8.4 or newer, `inspect` and `inspectTest` will automatically load the + plugin. + +## 0.3 -- 2018-07-07 * 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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,7 +14,6 @@ ```haskell {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-} module Simple where import Test.Inspection @@ -101,6 +100,14 @@ -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-module-prefixes -dsuppress-type-signatures -dsuppress-uniques + + +It does not seem to do anything (on GHC < 8.4) +---------------------------------------------- + +Add this line to your module: + + {-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-} Can I comment or help? ---------------------- diff --git a/Test/Inspection.hs b/Test/Inspection.hs --- a/Test/Inspection.hs +++ b/Test/Inspection.hs @@ -32,8 +32,8 @@ import Language.Haskell.TH 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 +#if MIN_VERSION_GLASGOW_HASKELL(8,4,0,0) +import Language.Haskell.TH.Syntax (addCorePlugin) #endif import Data.Data import GHC.Exts (lazy) @@ -44,14 +44,12 @@ To use inspection testing, you need to 1. enable the @TemplateHaskell@ language extension - 2. load the plugin using @-fplugin Test.Inspection.Plugin@ - 3. declare your proof obligations using 'inspect' or 'inspectTest' + 2. declare your proof obligations using 'inspect' or 'inspectTest' An example module is @ {-\# LANGUAGE TemplateHaskell \#-} -{-\# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin \#-} module Simple where import Test.Inspection @@ -64,6 +62,11 @@ inspect $ 'lhs === 'rhs @ + +On GHC < 8.4, you have to explicitly load the plugin: +@ +{-\# LANGUAGE TemplateHaskell \#-} +@ -} -- Description of test obligations @@ -72,7 +75,7 @@ -- -- It is recommended to build it using 'mkObligation', for backwards -- compatibility when new fields are added. You can also use the more --- memonic convenience functions like '(===)' or 'hasNoType'. +-- mnemonic convenience functions like '(===)' or 'hasNoType'. -- -- The obligation needs to be passed to 'inspect'. data Obligation = Obligation @@ -110,7 +113,7 @@ -- If the boolean flag is true, then ignore types during the comparison. = EqualTo Name Bool - -- | Do none of these types anywhere in the definition of the function + -- | Do none of these types appear anywhere in the definition of the function -- (neither locally bound nor passed as arguments) | NoTypes [Name] @@ -149,7 +152,7 @@ (==-) = mkEquality False True infix 9 ==- --- | Reclare two functions to be equal, but expect the test to fail (see 'EqualTo' and 'expectFail') +-- | Declare 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 @@ -196,36 +199,16 @@ 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 +#if MIN_VERSION_GLASGOW_HASKELL(8,4,0,0) + addCorePlugin "Test.Inspection.Plugin" +#endif loc <- location annExpr <- liftData (obl { srcLoc = Just loc }) - np <- needsPluginQ - pure $ np ++ [PragmaD (AnnP annTarget annExpr)] + pure $ [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'. @@ -233,7 +216,7 @@ inspect :: Obligation -> Q [Dec] inspect = inspectCommon ModuleAnnotation --- | The result of 'inspectTest', which a more or less helpful text message +-- | The result of 'inspectTest', which has a more or less helpful text message data Result = Failure String | Success String deriving Show diff --git a/Test/Inspection/Core.hs b/Test/Inspection/Core.hs --- a/Test/Inspection/Core.hs +++ b/Test/Inspection/Core.hs @@ -1,5 +1,5 @@ --- | This module implements some of analyses of Core expressions necessary for --- "Test.Inspection". Normally, users of this pacakge can ignore this module. +-- | This module implements some analyses of Core expressions necessary for +-- "Test.Inspection". Normally, users of this package can ignore this module. {-# LANGUAGE CPP, FlexibleContexts #-} module Test.Inspection.Core ( slice @@ -88,7 +88,7 @@ type VarPairSet = S.Set VarPair -- | This is a heuristic, which only works if both slices --- have auxillary variables in the right order. +-- have auxiliary variables in the right order. -- (This is mostly to work-around the buggy CSE in GHC-8.0) -- It also breaks if there is shadowing. eqSlice :: Bool {- ^ ignore types -} -> Slice -> Slice -> Bool diff --git a/Test/Inspection/Plugin.hs b/Test/Inspection/Plugin.hs --- a/Test/Inspection/Plugin.hs +++ b/Test/Inspection/Plugin.hs @@ -20,14 +20,12 @@ import Outputable 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 - , tcPlugin = const (Just inspectionTcPlugin) } +plugin = defaultPlugin { installCoreToDos = install } data UponFailure = AbortCompilation | KeepGoing deriving Eq diff --git a/Test/Inspection/TcPlugin.hs b/Test/Inspection/TcPlugin.hs deleted file mode 100644 --- a/Test/Inspection/TcPlugin.hs +++ /dev/null @@ -1,62 +0,0 @@ --- | 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 diff --git a/examples/Dictionary.hs b/examples/Dictionary.hs --- a/examples/Dictionary.hs +++ b/examples/Dictionary.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} module Dictionary (main) where import Test.Inspection @@ -9,11 +8,11 @@ import Data.Traversable (foldMapDefault) import Data.Semigroup (Semigroup) -putStrLn' :: MonadIO m => String -> m () +putStrLn' :: MonadIO m => String -> m () putStrLn' = liftIO . putStrLn action :: MonadIO m => m () -action = replicateM_ 10 (putStrLn' "foo") +action = putStrLn' "foo" >> putStrLn' "bar" specialized :: IO () specialized = action diff --git a/examples/Fusion.hs b/examples/Fusion.hs --- a/examples/Fusion.hs +++ b/examples/Fusion.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} module Fusion (main) where import Test.Inspection diff --git a/examples/GenericLens.hs b/examples/GenericLens.hs --- a/examples/GenericLens.hs +++ b/examples/GenericLens.hs @@ -1,5 +1,4 @@ {-# LANGUAGE RankNTypes, DeriveGeneric, TypeApplications, DataKinds, ExistentialQuantification, TemplateHaskell #-} -{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-} module GenericLens (main) where import GHC.Generics diff --git a/examples/Generics.hs b/examples/Generics.hs --- a/examples/Generics.hs +++ b/examples/Generics.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric, TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-} module Generics (main) where import GHC.Generics diff --git a/examples/NS_NP.hs b/examples/NS_NP.hs --- a/examples/NS_NP.hs +++ b/examples/NS_NP.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GADTs, TypeFamilies, DataKinds, PolyKinds, TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -O #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} module NS_NP (main) where import Test.Inspection diff --git a/examples/Simple.hs b/examples/Simple.hs --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-} module Simple (main) where import Test.Inspection diff --git a/examples/SimpleTest.hs b/examples/SimpleTest.hs --- a/examples/SimpleTest.hs +++ b/examples/SimpleTest.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -O -fplugin=Test.Inspection.Plugin #-} module Main (main) where import Test.Inspection diff --git a/examples/Text.hs b/examples/Text.hs --- a/examples/Text.hs +++ b/examples/Text.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} module Text (main) where import Test.Inspection diff --git a/inspection-testing.cabal b/inspection-testing.cabal --- a/inspection-testing.cabal +++ b/inspection-testing.cabal @@ -1,5 +1,5 @@ name: inspection-testing -version: 0.3 +version: 0.4 synopsis: GHC plugin to do inspection testing description: Some carefully crafted libraries make promises to their users beyond functionality and performance. @@ -34,7 +34,7 @@ build-type: Simple extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 -Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.5.* +Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.6.* source-repository head type: git @@ -44,9 +44,8 @@ exposed-modules: Test.Inspection Test.Inspection.Plugin Test.Inspection.Core - other-modules: Test.Inspection.TcPlugin build-depends: base >=4.9 && <4.13 - build-depends: ghc >= 8.0.2 && <8.6 + build-depends: ghc >= 8.0.2 && <8.7 build-depends: template-haskell build-depends: containers build-depends: transformers @@ -62,7 +61,8 @@ build-depends: base >=4.9 && <4.13 default-language: Haskell2010 ghc-options: -main-is NS_NP - + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite simple type: exitcode-stdio-1.0 @@ -72,6 +72,8 @@ build-depends: base >=4.9 && <4.13 default-language: Haskell2010 ghc-options: -main-is Simple + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite simple-test type: exitcode-stdio-1.0 @@ -80,6 +82,8 @@ build-depends: inspection-testing build-depends: base >=4.9 && <4.13 default-language: Haskell2010 + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite fusion type: exitcode-stdio-1.0 @@ -89,6 +93,8 @@ build-depends: base >=4.9 && <4.13 default-language: Haskell2010 ghc-options: -main-is Fusion + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite generics type: exitcode-stdio-1.0 @@ -98,6 +104,8 @@ build-depends: base >=4.9 && <4.13 default-language: Haskell2010 ghc-options: -main-is Generics + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite dictionary type: exitcode-stdio-1.0 @@ -107,6 +115,8 @@ build-depends: base >=4.9 && <4.13 default-language: Haskell2010 ghc-options: -main-is Dictionary + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin flag more-tests description: Run tests that pull in specific versions of other packages @@ -125,6 +135,8 @@ buildable: False default-language: Haskell2010 ghc-options: -main-is Text + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin test-suite generic-lens type: exitcode-stdio-1.0 @@ -138,4 +150,5 @@ buildable: False default-language: Haskell2010 ghc-options: -main-is GenericLens - + if impl(ghc < 8.4) + ghc-options: -fplugin=Test.Inspection.Plugin