diff --git a/ChangeLog.md b/ChangeLog.md index 9a02bc8..d78e7c2 100644 --- a/ChangeLog.md +++ b/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. diff --git a/README.md b/README.md index f3bd256..8e72506 100644 --- a/README.md +++ b/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") + ``` diff --git a/ban-instance.cabal b/ban-instance.cabal index c001313..c5a78c4 100644 --- a/ban-instance.cabal +++ b/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: <> @@ -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 diff --git a/src/Language/Haskell/Instance/Ban.hs b/src/Language/Haskell/Instance/Ban.hs index 739be2d..386fa52 100644 --- a/src/Language/Haskell/Instance/Ban.hs +++ b/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,7 +59,7 @@ 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 @@ -61,10 +67,20 @@ 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] diff --git a/test/Spec.hs b/test/Spec.hs index 79546ec..c650f78 100644 --- a/test/Spec.hs +++ b/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 ()