Make GHC.Utils.Error.Validity type polymorphic

This commit makes the `Validity` type polymorphic:

```
data Validity' a
  = IsValid      -- ^ Everything is fine
  | NotValid a   -- ^ A problem, and some indication of why

-- | Monomorphic version of @Validity'@ specialised for 'SDoc's.
type Validity = Validity' SDoc
```

The type has been (provisionally) renamed to Validity' to not break
existing code, as the monomorphic `Validity` type is quite pervasive
in a lot of signatures in GHC.

Why having a polymorphic Validity? Because it carries the evidence of
"what went wrong", but the old type carried an `SDoc`, which clashed
with the new GHC diagnostic infrastructure (#18516). Having it
polymorphic it means we can carry an arbitrary, richer diagnostic type,
and this is very important for things like the
`checkOriginativeSideConditions` function, which needs to report the
actual diagnostic error back to `GHC.Tc.Deriv`.

It also generalises Validity-related functions to be polymorphic in @a@.

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