diff options
29 files changed, 128 insertions, 113 deletions
diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index c8a9ddab58..568568af84 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -29,7 +29,7 @@ import Data.Function ( fix ) import Data.Maybe import Data.Monoid ( Dual(..), Sum(..), Product(..) , First(..), Last(..), Alt(..) ) -import GHC.Base ( Monad, errorWithoutStackTrace, (.) ) +import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail ) import GHC.ST @@ -74,6 +74,14 @@ instance MonadFix [] where [] -> [] (x:_) -> x : mfix (tail . f) +-- | @since 4.9.0.0 +instance MonadFix NonEmpty where + mfix f = case fix (f . neHead) of + ~(x :| _) -> x :| mfix (neTail . f) + where + neHead ~(a :| _) = a + neTail ~(_ :| as) = as + -- | @since 2.01 instance MonadFix IO where mfix = fixIO diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs index 5b670085d4..d484d1fa83 100644 --- a/libraries/base/Control/Monad/Zip.hs +++ b/libraries/base/Control/Monad/Zip.hs @@ -22,6 +22,7 @@ import Control.Monad (liftM, liftM2) import Data.Functor.Identity import Data.Monoid import Data.Proxy +import qualified Data.List.NonEmpty as NE import GHC.Generics -- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` @@ -59,6 +60,12 @@ instance MonadZip [] where mzipWith = zipWith munzip = unzip +-- | @since 4.9.0.0 +instance MonadZip NE.NonEmpty where + mzip = NE.zip + mzipWith = NE.zipWith + munzip = NE.unzip + -- | @since 4.8.0.0 instance MonadZip Identity where mzipWith = liftM2 diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 1b55f59b10..33e8c86fe4 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -1137,6 +1137,9 @@ instance Data a => Data [a] where ------------------------------------------------------------------------------ +-- | @since 4.9.0.0 +deriving instance Data a => Data (NonEmpty a) + -- | @since 4.0.0.0 deriving instance Data a => Data (Maybe a) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 08ba9d49ed..2656efa103 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -296,6 +296,16 @@ instance Foldable [] where sum = List.sum toList = id +-- | @since 4.9.0.0 +instance Foldable NonEmpty where + foldr f z ~(a :| as) = f a (List.foldr f z as) + foldl f z ~(a :| as) = List.foldl f (f z a) as + foldl1 f ~(a :| as) = List.foldl f a as + foldMap f ~(a :| as) = f a `mappend` foldMap f as + fold ~(m :| ms) = m `mappend` fold ms + length (_ :| as) = 1 + List.length as + toList ~(a :| as) = a : as + -- | @since 4.7.0.0 instance Foldable (Either a) where foldMap _ (Left _) = mempty diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs index 2510da911f..32d9929e32 100644 --- a/libraries/base/Data/Functor/Classes.hs +++ b/libraries/base/Data/Functor/Classes.hs @@ -68,6 +68,7 @@ import Control.Applicative (Alternative((<|>)), Const(Const)) import Data.Functor.Identity (Identity(Identity)) import Data.Proxy (Proxy(Proxy)) +import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid (mappend) import GHC.Read (expectP, list, paren) @@ -452,6 +453,27 @@ instance Read1 [] where instance Show1 [] where liftShowsPrec _ sl _ = sl +-- | @since 4.10.0.0 +instance Eq1 NonEmpty where + liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs + +-- | @since 4.10.0.0 +instance Ord1 NonEmpty where + liftCompare cmp (a :| as) (b :| bs) = cmp a b `mappend` liftCompare cmp as bs + +-- | @since 4.10.0.0 +instance Read1 NonEmpty where + liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do + (a, s'') <- rdP 6 s' + (":|", s''') <- lex s'' + (as, s'''') <- rdL s''' + return (a :| as, s'''')) s + +-- | @since 4.10.0.0 +instance Show1 NonEmpty where + liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $ + shwP 6 a . showString " :| " . shwL as + -- | @since 4.9.0.0 instance Eq2 (,) where liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2 diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs index d1cc28c91f..858a1b063c 100644 --- a/libraries/base/Data/List/NonEmpty.hs +++ b/libraries/base/Data/List/NonEmpty.hs @@ -102,65 +102,14 @@ import Prelude hiding (break, cycle, drop, dropWhile, import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many)) -import Control.Monad (ap, liftM2) -import Control.Monad.Fix -import Control.Monad.Zip (MonadZip(..)) -import Data.Data (Data) import Data.Foldable hiding (length, toList) import qualified Data.Foldable as Foldable import Data.Function (on) -import Data.Functor.Classes (Eq1(..), Ord1(..), Read1(..), Show1(..)) import qualified Data.List as List -import Data.Monoid ((<>)) import Data.Ord (comparing) -import qualified GHC.Exts as Exts (IsList(..)) -import GHC.Generics (Generic, Generic1) +import GHC.Base (NonEmpty(..)) -infixr 5 :|, <| - --- | Non-empty (and non-strict) list type. --- --- @since 4.9.0.0 -data NonEmpty a = a :| [a] - deriving ( Eq, Ord, Show, Read, Data, Generic, Generic1 ) - --- | @since 4.10.0.0 -instance Eq1 NonEmpty where - liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs - --- | @since 4.10.0.0 -instance Ord1 NonEmpty where - liftCompare cmp (a :| as) (b :| bs) = cmp a b <> liftCompare cmp as bs - --- | @since 4.10.0.0 -instance Read1 NonEmpty where - liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do - (a, s'') <- rdP 6 s' - (":|", s''') <- lex s'' - (as, s'''') <- rdL s''' - return (a :| as, s'''')) s - --- | @since 4.10.0.0 -instance Show1 NonEmpty where - liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $ - shwP 6 a . showString " :| " . shwL as - --- | @since 4.9.0.0 -instance Exts.IsList (NonEmpty a) where - type Item (NonEmpty a) = a - fromList = fromList - toList = toList - --- | @since 4.9.0.0 -instance MonadFix NonEmpty where - mfix f = case fix (f . head) of - ~(x :| _) -> x :| mfix (tail . f) - --- | @since 4.9.0.0 -instance MonadZip NonEmpty where - mzip = zip - mzipWith = zipWith - munzip = unzip +infixr 5 <| -- | Number of elements in 'NonEmpty' list. length :: NonEmpty a -> Int @@ -203,37 +152,6 @@ unfoldr f a = case f a of go c = case f c of (d, me) -> d : maybe [] go me --- | @since 4.9.0.0 -instance Functor NonEmpty where - fmap f ~(a :| as) = f a :| fmap f as - b <$ ~(_ :| as) = b :| (b <$ as) - --- | @since 4.9.0.0 -instance Applicative NonEmpty where - pure a = a :| [] - (<*>) = ap - liftA2 = liftM2 - --- | @since 4.9.0.0 -instance Monad NonEmpty where - ~(a :| as) >>= f = b :| (bs ++ bs') - where b :| bs = f a - bs' = as >>= toList . f - --- | @since 4.9.0.0 -instance Traversable NonEmpty where - traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as) - --- | @since 4.9.0.0 -instance Foldable NonEmpty where - foldr f z ~(a :| as) = f a (foldr f z as) - foldl f z ~(a :| as) = foldl f (f z a) as - foldl1 f ~(a :| as) = foldl f a as - foldMap f ~(a :| as) = f a `mappend` foldMap f as - fold ~(m :| ms) = m `mappend` fold ms - length = length - toList = toList - -- | Extract the first element of the stream. head :: NonEmpty a -> a head ~(a :| _) = a diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 5c2745edeb..71a4420341 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -64,7 +64,7 @@ import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) ) import Data.Proxy ( Proxy(..) ) import GHC.Arr -import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), +import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), NonEmpty(..), ($), (.), id, flip ) import GHC.Generics import qualified GHC.List as List ( foldr ) @@ -237,6 +237,10 @@ instance Traversable [] where traverse f = List.foldr cons_f (pure []) where cons_f x ys = liftA2 (:) (f x) ys +-- | @since 4.9.0.0 +instance Traversable NonEmpty where + traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as) + -- | @since 4.7.0.0 instance Traversable (Either a) where traverse _ (Left x) = pure (Left x) diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index b880ccb12f..96f2d641bd 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -797,6 +797,35 @@ class (Alternative m, Monad m) => MonadPlus m where -- | @since 2.01 instance MonadPlus Maybe +--------------------------------------------- +-- The non-empty list type + +infixr 5 :| + +-- | Non-empty (and non-strict) list type. +-- +-- @since 4.9.0.0 +data NonEmpty a = a :| [a] + deriving (Eq, Ord) + +-- | @since 4.9.0.0 +instance Functor NonEmpty where + fmap f ~(a :| as) = f a :| fmap f as + b <$ ~(_ :| as) = b :| (b <$ as) + +-- | @since 4.9.0.0 +instance Applicative NonEmpty where + pure a = a :| [] + (<*>) = ap + liftA2 = liftM2 + +-- | @since 4.9.0.0 +instance Monad NonEmpty where + ~(a :| as) >>= f = b :| (bs ++ bs') + where b :| bs = f a + bs' = as >>= toList . f + toList ~(c :| cs) = c : cs + ---------------------------------------------- -- The list type diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index f6204aabd4..a306437cea 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -194,6 +194,15 @@ instance IsList [a] where fromList = id toList = id +-- | @since 4.9.0.0 +instance IsList (NonEmpty a) where + type Item (NonEmpty a) = a + + fromList (a:as) = a :| as + fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list" + + toList ~(a :| as) = a : as + -- | @since 4.8.0.0 instance IsList Version where type (Item Version) = Int diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 5bc9c55059..3bb2299f32 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -739,7 +739,7 @@ import GHC.Types -- Needed for instances import GHC.Arr ( Ix ) import GHC.Base ( Alternative(..), Applicative(..), Functor(..) - , Monad(..), MonadPlus(..), String, coerce ) + , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce ) import GHC.Classes ( Eq(..), Ord(..) ) import GHC.Enum ( Bounded, Enum ) import GHC.Read ( Read(..) ) @@ -1213,6 +1213,7 @@ data Meta = MetaData Symbol Symbol Symbol Bool -------------------------------------------------------------------------------- deriving instance Generic [a] +deriving instance Generic (NonEmpty a) deriving instance Generic (Maybe a) deriving instance Generic (Either a b) deriving instance Generic Bool @@ -1227,6 +1228,7 @@ deriving instance Generic ((,,,,,) a b c d e f) deriving instance Generic ((,,,,,,) a b c d e f g) deriving instance Generic1 [] +deriving instance Generic1 NonEmpty deriving instance Generic1 Maybe deriving instance Generic1 (Either a) deriving instance Generic1 Proxy diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index 49c0606878..ad29cc5c40 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -412,6 +412,8 @@ instance Read Ordering where readListPrec = readListPrecDefault readList = readListDefault +deriving instance Read a => Read (NonEmpty a) + -------------------------------------------------------------- -- Structure instances of Read: Maybe, List etc -------------------------------------------------------------- diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index 6965335e64..75080b3c90 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -198,6 +198,7 @@ showWord w# cs showWord (w# `quotWord#` 10##) (C# c# : cs) deriving instance Show a => Show (Maybe a) +deriving instance Show a => Show (NonEmpty a) -- | @since 2.01 instance Show TyCon where diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr index dc4564f168..c3dbbba970 100644 --- a/testsuite/tests/ado/T13242a.stderr +++ b/testsuite/tests/ado/T13242a.stderr @@ -28,10 +28,10 @@ T13242a.hs:13:11: error: These potential instances exist: instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’ ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: return (x == x) In the expression: diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr index 6329c38e6d..ee9fbe112c 100644 --- a/testsuite/tests/annotations/should_fail/annfail10.stderr +++ b/testsuite/tests/annotations/should_fail/annfail10.stderr @@ -10,7 +10,7 @@ annfail10.hs:9:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 42 instances involving out-of-scope types + ...plus 43 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN f 1 #-} diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index f19a5b3896..8bd838dffe 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -9,7 +9,7 @@ instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus 11 instances involving out-of-scope types + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it @@ -23,6 +23,6 @@ instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus 11 instances involving out-of-scope types + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index c266bc8d1a..29d5317b97 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -9,6 +9,6 @@ instance Show TyCon -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ ...plus 29 others - ...plus 12 instances involving out-of-scope types + ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr index 7356791a97..94ef226601 100644 --- a/testsuite/tests/indexed-types/should_fail/T12522a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr @@ -11,7 +11,7 @@ T12522a.hs:20:26: error: instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the first argument of ‘(++)’, namely ‘show n’ In the second argument of ‘($)’, namely ‘show n ++ s’ diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr index 0faaaec792..1c5ab2ee61 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr @@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error: instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus six instances involving out-of-scope types + ...plus 7 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: print [1] In an equation for ‘main’: main = print [1] @@ -19,7 +19,7 @@ overloadedlistsfail01.hs:5:14: error: Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance GHC.Exts.IsList [a] -- Defined in ‘GHC.Exts’ - ...plus two instances involving out-of-scope types + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the first argument of ‘print’, namely ‘[1]’ In the expression: print [1] diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr index d397e1f6ba..6ebd844bff 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -42,7 +42,7 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Functor (B t) -- Defined at T10403.hs:10:10 instance Functor I -- Defined at T10403.hs:6:10 ...plus three others - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘(.)’, namely ‘fmap (const ())’ In the expression: H . fmap (const ()) diff --git a/testsuite/tests/partial-sigs/should_fail/T10999.stderr b/testsuite/tests/partial-sigs/should_fail/T10999.stderr index 0b534b9480..88652a7831 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10999.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10999.stderr @@ -24,9 +24,9 @@ T10999.hs:8:28: error: instance Ord a => Ord (Set.Set a) -- Defined in ‘Data.Set.Internal’ instance Ord Ordering -- Defined in ‘GHC.Classes’ instance Ord Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ ...plus 23 others - ...plus two instances involving out-of-scope types + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘($)’, namely ‘f ()’ In the second argument of ‘($)’, namely ‘Set.toList $ f ()’ diff --git a/testsuite/tests/polykinds/T13393.stderr b/testsuite/tests/polykinds/T13393.stderr index 39ea640633..26aa577987 100644 --- a/testsuite/tests/polykinds/T13393.stderr +++ b/testsuite/tests/polykinds/T13393.stderr @@ -8,7 +8,7 @@ T13393.hs:61:3: error: instance Traversable Identity -- Defined in ‘Data.Traversable’ instance Traversable Maybe -- Defined in ‘Data.Traversable’ ...plus two others - ...plus 24 instances involving out-of-scope types + ...plus 25 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: mapM putBackLeftOverInputAndReturnOutput undefined diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index eb8d56f1e3..3744ef74f8 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -8,7 +8,7 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: show _ In an equation for ‘f’: f = show _ diff --git a/testsuite/tests/typecheck/should_fail/T10971b.stderr b/testsuite/tests/typecheck/should_fail/T10971b.stderr index 2e63617464..2754a3f11c 100644 --- a/testsuite/tests/typecheck/should_fail/T10971b.stderr +++ b/testsuite/tests/typecheck/should_fail/T10971b.stderr @@ -11,7 +11,7 @@ T10971b.hs:4:11: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 26 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: \ x -> length x @@ -29,7 +29,7 @@ T10971b.hs:5:13: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 26 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: \ f x -> fmapDefault f x @@ -47,7 +47,7 @@ T10971b.hs:6:14: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 26 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: (fmapDefault f x, length x) @@ -65,7 +65,7 @@ T10971b.hs:6:31: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 26 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: (fmapDefault f x, length x) diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr index bd0ba8e43d..2c0453127d 100644 --- a/testsuite/tests/typecheck/should_fail/T12921.stderr +++ b/testsuite/tests/typecheck/should_fail/T12921.stderr @@ -10,7 +10,7 @@ T12921.hs:4:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 42 instances involving out-of-scope types + ...plus 43 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN module "HLint: ignore Reduce duplication" #-} diff --git a/testsuite/tests/typecheck/should_fail/T13292.stderr b/testsuite/tests/typecheck/should_fail/T13292.stderr index 5d8ccd117f..9f70b1df27 100644 --- a/testsuite/tests/typecheck/should_fail/T13292.stderr +++ b/testsuite/tests/typecheck/should_fail/T13292.stderr @@ -10,7 +10,7 @@ T13292a.hs:4:12: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Monad Maybe -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ ...plus one other - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: return () In an equation for ‘someFunc’: someFunc = return () diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index 14d864a592..accc6b69f3 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -5,9 +5,9 @@ T5095.hs:9:9: error: instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31 instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ ...plus 23 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) (The choice depends on the instantiation of ‘a’ To pick the first instance above, use IncoherentInstances diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr index 15c4556480..89f1e8323c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr @@ -9,10 +9,10 @@ tcfail072.hs:23:13: error: These potential instances exist: instance Ord Ordering -- Defined in ‘GHC.Classes’ instance Ord Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’ ...plus 22 others - ...plus two instances involving out-of-scope types + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: g A In an equation for ‘g’: g (B _ _) = g A diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index a2b602cb98..5ec1212d30 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -12,7 +12,7 @@ tcfail133.hs:68:7: error: instance (Show b, Show a, Digit b, Number a) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others - ...plus five instances involving out-of-scope types + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: show $ add (One :@ Zero) (One :@ One) In an equation for ‘foo’: diff --git a/testsuite/tests/typecheck/should_fail/tcfail181.stderr b/testsuite/tests/typecheck/should_fail/tcfail181.stderr index 3ab08676b5..9cbc04b3d0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail181.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail181.stderr @@ -11,7 +11,7 @@ tcfail181.hs:17:9: error: instance Monad Maybe -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ ...plus one other - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: foo In the expression: foo {bar = return True} |