Permit type variables

ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for ban-instance
 
+## 0.1.1.0 - 2026-03-30
+
+* Enable banning instances including type variables.
+
 ## 0.1.0.1 - 2019-11-08
 
 * Remove broken test.

README.md

@@ -71,3 +71,9 @@ instance FromJSON (V2 Foo) where -- ...
 
 * Type quotations `[t|...|]` do not support free variables
   ([GHC#5616](https://gitlab.haskell.org/ghc/ghc/issues/5616)).
+  To overcome this limitation, `banInstance` allows you to use an explicit
+  `forall`. For example:
+
+  ```haskell
+  $(banInstance [t|forall a. ToJSON (Maybe a)|] "use a newtype wrapper at the API layer")
+  ```

ban-instance.cabal

@@ -1,5 +1,6 @@
+cabal-version:  1.18
 name:           ban-instance
-version:        0.1.0.1
+version:        0.1.1.0
 synopsis:       For when a type should never be an instance of a class
 description:
   <<https://raw.githubusercontent.com/qfpl/assets/master/data61-transparent-bg.png>>
@@ -23,13 +24,7 @@ copyright:      (c) 2017, Commonwealth Scientific and Industrial Research Organi
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
-cabal-version:  >= 1.10
-tested-with: GHC == 8.0.2
-              || == 8.2.2
-              || == 8.4.4
-              || == 8.6.5
-              || == 8.8.1
-              || == 8.10.7
+tested-with: GHC == 8.10.7
               || == 9.0.1
               || == 9.2.7
               || == 9.4.5
@@ -38,8 +33,8 @@ tested-with: GHC == 8.0.2
               || == 9.10.2
               || == 9.12.2
 
-extra-source-files: ChangeLog.md
-                    README.md
+extra-doc-files: ChangeLog.md
+                 README.md
 
 source-repository head
   type: git
@@ -49,7 +44,7 @@ library
   hs-source-dirs: src
   ghc-options: -Wall
   build-depends: base >= 4.7 && < 4.22
-               , template-haskell >= 2.11 && < 2.24
+               , template-haskell >= 2.16 && < 2.24
   exposed-modules: Language.Haskell.Instance.Ban
   default-language: Haskell2010
 

src/Language/Haskell/Instance/Ban.hs

@@ -38,6 +38,12 @@ import Language.Haskell.TH.Syntax
 -- @
 -- \$(banInstance [t|ToJSON Foo|] "why ToJSON Foo should never be defined")
 -- @
+--
+-- To ban instances containing type variables:
+--
+-- @
+-- \$(banInstance [t|forall a. ToJSON (Maybe a)|] "why ToJSON (Maybe a) should never be defined")
+-- @
 banInstance
   :: TypeQ
      -- ^ The instance you want to ban.
@@ -53,18 +59,28 @@ banInstance constraintQ message = do
                                   ':$$: 'Text "Instance banned at " ':<>: 'Text $(symbol $ formatLocation loc)
                                   ':$$: 'Text ""
                                   )|]]
-  pure <$> instanceD context constraintQ (convertClassDecs classDecs)
+  pure <$> instanceD context (withoutForall <$> constraintQ) (convertClassDecs classDecs)
 
 symbol :: String -> TypeQ
 symbol = litT . strTyLit
 
 formatLocation :: Loc -> String
 formatLocation Loc{..} = concat ["[", loc_package, ":", loc_module, "] ", loc_filename, ":",  show $ fst loc_start]
 
+withoutForall :: Type -> Type
+withoutForall topTy = go topTy where
+  go (ForallT _ _ ty) = go ty
+  go ty = ty
+
 className :: Type -> Name
 className topTy = go topTy where
-  go (AppT ty _) = className ty
-  go (ConT name) = name
+  go (ForallT _ _ ty)  = className ty
+  go (ForallVisT _ ty) = className ty
+  go (AppT ty _)       = className ty
+  go (AppKindT ty _)   = className ty
+  go (SigT ty _)       = className ty
+  go (ConT name)       = name
+  go (ParensT ty)      = className ty
   go _ = error $ "Cannot determine class name for type: " ++ pprint topTy
 
 convertClassDecs :: [Dec] -> [DecQ]

test/Spec.hs

@@ -2,6 +2,7 @@
 
 {-# LANGUAGE DataKinds              #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE ImpredicativeTypes     #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
@@ -23,5 +24,10 @@ $(banInstance [t|TestClass Char Int|] "because it's really bad")
 instance TestClass Int Int where
   testFunction = const 0
 
+class TestClass2 a where
+  testFunction2 :: a
+
+$(banInstance [t|forall a. TestClass2 (Maybe a)|] "no instances allowed")
+
 main :: IO ()
 main = pure ()