diff options
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Generics.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Instance/FunDeps.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/TcType.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Error.hs | 21 |
4 files changed, 15 insertions, 12 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs index 4aeac0ceae..4ad9c8b849 100644 --- a/compiler/GHC/Tc/Deriv/Generics.hs +++ b/compiler/GHC/Tc/Deriv/Generics.hs @@ -47,7 +47,7 @@ import GHC.Builtin.Names import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad import GHC.Driver.Session -import GHC.Utils.Error( Validity(..), andValid ) +import GHC.Utils.Error( Validity'(..), Validity, andValid ) import GHC.Types.SrcLoc import GHC.Data.Bag import GHC.Types.Var.Env diff --git a/compiler/GHC/Tc/Instance/FunDeps.hs b/compiler/GHC/Tc/Instance/FunDeps.hs index 8a54e03b7e..9abfc31f0b 100644 --- a/compiler/GHC/Tc/Instance/FunDeps.hs +++ b/compiler/GHC/Tc/Instance/FunDeps.hs @@ -40,7 +40,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.FV -import GHC.Utils.Error( Validity(..), allValid ) +import GHC.Utils.Error( Validity'(..), Validity, allValid ) import GHC.Utils.Misc import GHC.Utils.Panic diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index d878ccc75a..5313ef39d4 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -228,7 +228,7 @@ import GHC.Data.List.SetOps ( getNth, findDupsEq ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Utils.Error( Validity(..), isValid ) +import GHC.Utils.Error( Validity'(..), Validity, isValid ) import qualified GHC.LanguageExtensions as LangExt import Data.List ( mapAccumL ) diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 49dc9d6fdd..c2b708b56a 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -10,7 +10,7 @@ module GHC.Utils.Error ( -- * Basic types - Validity(..), andValid, allValid, isValid, getInvalids, orValid, + Validity'(..), Validity, andValid, allValid, isValid, getInvalids, orValid, Severity(..), -- * Messages @@ -191,27 +191,30 @@ mkPlainErrorMsgEnvelope locn msg = mk_msg_envelope SevError locn alwaysQualify msg ------------------------- -data Validity - = IsValid -- ^ Everything is fine - | NotValid SDoc -- ^ A problem, and some indication of why +data Validity' a + = IsValid -- ^ Everything is fine + | NotValid a -- ^ A problem, and some indication of why -isValid :: Validity -> Bool +-- | Monomorphic version of @Validity'@ specialised for 'SDoc's. +type Validity = Validity' SDoc + +isValid :: Validity' a -> Bool isValid IsValid = True isValid (NotValid {}) = False -andValid :: Validity -> Validity -> Validity +andValid :: Validity' a -> Validity' a -> Validity' a andValid IsValid v = v andValid v _ = v -- | If they aren't all valid, return the first -allValid :: [Validity] -> Validity +allValid :: [Validity' a] -> Validity' a allValid [] = IsValid allValid (v : vs) = v `andValid` allValid vs -getInvalids :: [Validity] -> [SDoc] +getInvalids :: [Validity' a] -> [a] getInvalids vs = [d | NotValid d <- vs] -orValid :: Validity -> Validity -> Validity +orValid :: Validity' a -> Validity' a -> Validity' a orValid IsValid _ = IsValid orValid _ v = v |