From 4908d7987c593a6b66a60d42a66b083228d8c623 Mon Sep 17 00:00:00 2001 From: Ben Gamari <ben@smart-cactus.org> Date: Wed, 10 May 2023 16:11:01 -0400 Subject: [PATCH] base: Introduce Data.Enum --- libraries/base/Data/Enum.hs | 22 +++++ libraries/base/base.cabal | 1 + .../interface-stability/base-exports.stdout | 91 +++++++++++-------- ...se-exports.stdout-javascript-unknown-ghcjs | 91 +++++++++++-------- .../base-exports.stdout-mingw32 | 91 +++++++++++-------- .../base-exports.stdout-ws-32 | 91 +++++++++++-------- 6 files changed, 243 insertions(+), 144 deletions(-) create mode 100644 libraries/base/Data/Enum.hs diff --git a/libraries/base/Data/Enum.hs b/libraries/base/Data/Enum.hs new file mode 100644 index 000000000000..3ec83b5e5632 --- /dev/null +++ b/libraries/base/Data/Enum.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index cb25aefd4fb4..661c5d1b0c39 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -128,6 +128,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout index 26550cb1edc8..9d044ee0f699 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout +++ b/testsuite/tests/interface-stability/base-exports.stdout @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -11311,6 +11330,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11336,30 +11379,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11373,6 +11392,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11397,18 +11428,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs index 879c391e34d5..db022a72e641 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs +++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -14082,6 +14101,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -14107,30 +14150,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -14144,6 +14163,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -14168,18 +14199,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32 index 88b5d354ea1a..92785aaa6ab6 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 +++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32 @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -11579,6 +11598,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11604,30 +11647,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11641,6 +11660,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11666,18 +11697,6 @@ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance GHC.Enum.Enum GHC.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Event.Windows.ConsoleEvent’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32 index 8a5a5c9964b3..6ea64b7e2958 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 +++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32 @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -11315,6 +11334,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11340,30 +11383,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11377,6 +11396,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11401,18 +11432,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ -- GitLab