From cf7d06b8ac0f47d6ff1c2d3decdb6a50a0fd7502 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 9 Feb 2021 12:42:30 +0100 Subject: Stable sort for (data/newtype) instances --- .../src/Haddock/Interface/AttachInstances.hs | 25 +- html-test/ref/Bug1004.html | 1064 ++++++++++---------- html-test/ref/Bug1103.html | 8 +- html-test/ref/Bug548.html | 96 +- html-test/ref/HiddenInstances.html | 8 +- html-test/ref/Instances.html | 354 +++---- html-test/ref/SpuriousSuperclassConstraints.html | 108 +- html-test/ref/TypeFamilies.html | 196 ++-- html-test/ref/TypeFamilies2.html | 68 +- html-test/ref/TypeFamilies3.html | 64 +- hypsrc-test/ref/src/Classes.html | 14 +- hypsrc-test/ref/src/Records.html | 16 +- latex-test/ref/TypeFamilies3/TypeFamilies3.tex | 4 +- 13 files changed, 1017 insertions(+), 1008 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 6ef0ed19..d5b80888 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -179,19 +179,28 @@ findFixity iface ifaceMap instIfaceMap = \name -> -- Collecting and sorting instances -------------------------------------------------------------------------------- +-- | Stable name for stable comparisons. GHC's `Name` uses unstable +-- ordering based on their `Unique`'s. +newtype SName = SName Name + +instance Eq SName where + SName n1 == SName n2 = n1 `stableNameCmp` n2 == EQ + +instance Ord SName where + SName n1 `compare` SName n2 = n1 `stableNameCmp` n2 -- | Simplified type for sorting types, ignoring qualification (not visible -- in Haddock output) and unifying special tycons with normal ones. -- For the benefit of the user (looks nice and predictable) and the -- tests (which prefer output to be deterministic). -data SimpleType = SimpleType Name [SimpleType] +data SimpleType = SimpleType SName [SimpleType] | SimpleTyLit TyLit deriving (Eq,Ord) -instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType]) +instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], SName, [SimpleType]) instHead (_, _, cls, args) - = (map argCount args, className cls, map simplify args) + = (map argCount args, SName (className cls), map simplify args) argCount :: Type -> Int argCount (AppTy t _) = argCount t + 1 @@ -202,12 +211,12 @@ argCount (CastTy t _) = argCount t argCount _ = 0 simplify :: Type -> SimpleType -simplify (FunTy _ _ t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] +simplify (FunTy _ _ t1 t2) = SimpleType (SName funTyConName) [simplify t1, simplify t2] simplify (ForAllTy _ t) = simplify t simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) where (SimpleType s ts) = simplify t1 -simplify (TyVarTy v) = SimpleType (tyVarName v) [] -simplify (TyConApp tc ts) = SimpleType (tyConName tc) +simplify (TyVarTy v) = SimpleType (SName (tyVarName v)) [] +simplify (TyConApp tc ts) = SimpleType (SName (tyConName tc)) (mapMaybe simplify_maybe ts) simplify (LitTy l) = SimpleTyLit l simplify (CastTy ty _) = simplify ty @@ -218,9 +227,9 @@ simplify_maybe (CoercionTy {}) = Nothing simplify_maybe ty = Just (simplify ty) -- Used for sorting -instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType) +instFam :: FamInst -> ([Int], SName, [SimpleType], Int, SimpleType) instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } - = (map argCount ts, n, map simplify ts, argCount t, simplify t) + = (map argCount ts, SName n, map simplify ts, argCount t, simplify t) -------------------------------------------------------------------------------- diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html index b4ce3c88..cd959f7f 100644 --- a/html-test/ref/Bug1004.html +++ b/html-test/ref/Bug1004.html @@ -182,135 +182,7 @@ > (Monad f, Monad g) => Monad (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

(>>=) :: Product f g a -> (a -> Product f g b) -> Product f g b #

(>>) :: Product f g a -> Product f g b -> Product f g b #

return :: a -> Product f g a #

(Functor f, Functor g) => Functor (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

fmap :: (a -> b) -> Product f g a -> Product f g b #

(<$) :: a -> Product f g b -> Product f g a #

(MonadFix
Instance details

(Applicative f, Applicative g) => Applicative (MonadZip f, MonadZip g) => MonadZip (Product f g)

Instance details

Methods

pure :: a -> Product f g a #

(<*>)mzip :: Product f g (a -> b) -> Product f g a -> Product f g b #

liftA2 :: (a -> b -> c) -> Product f g a -> Product f g b -> Product f g c f g (a, b) #

(*>) :: mzipWith :: (a -> b -> c) -> Product f g a -> Product f g b -> Product f g b f g c #

(<*)munzip :: Product f g a -> f g (a, b) -> (Product f g b -> f g a, Product f g a f g b) #

(Foldable
Instance details

(Traversable f, Traversable g) => Traversable (Eq1 f, Eq1 g) => Eq1 (Product f g)

Instance details

Methods

traverse :: Applicative f0 => (a -> f0 b) -> Product f g a -> f0 (Product f g b) #

sequenceA :: Applicative f0 => Product f g (f0 a) -> f0 (Product f g a) #

mapM :: Monad m => (a -> m b) -> Product f g a -> m (Product f g b) #

sequence :: Monad m => liftEq :: (a -> b -> Bool) -> Product f g (m a) -> m ( f g a -> Product f g a) f g b -> Bool #

(Show1Ord1 f, Show1Ord1 g) => Show1Ord1 (Product f g)
Instance details

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Product f g a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [liftCompare :: (a -> b -> Ordering) -> Product f g a] -> ShowS f g a -> Product f g b -> Ordering #

(Read1
Instance details

(Ord1Show1 f, Ord1Show1 g) => Ord1Show1 (Product f g)

Instance details

Methods

liftCompare :: (a -> b -> Ordering) -> Product f g a -> liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Product f g b -> Ordering f g a -> ShowS #

(Eq1 f, Eq1 g) => Eq1 (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

liftEq :: (a -> b -> Bool) -> Product f g a -> liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Product f g b -> Bool f g a] -> ShowS #

(MonadZip f, MonadZip g) => MonadZip (Traversable f, Traversable g) => Traversable (Product f g)
Instance details

Methods

mzip :: Product f g a -> traverse :: Applicative f0 => (a -> f0 b) -> Product f g b -> f g a -> f0 (Product f g (a, b) f g b) #

mzipWith :: (a -> b -> c) -> Product f g a -> sequenceA :: Applicative f0 => Product f g b -> f g (f0 a) -> f0 (Product f g c f g a) #

munzip :: Product f g (a, b) -> (mapM :: Monad m => (a -> m b) -> Product f g a, f g a -> m (Product f g b) #

sequence :: Monad m => Product f g (m a) -> m (Product f g a) #

(MonadPlus f, MonadPlus g) => MonadPlus (Alternative f, Alternative g) => Alternative (Product f g)
Instance details

Methods

mzeroempty :: Product f g a

mplus(<|>) :: Product f g a -> f g a #

some :: Product f g a -> Product f g [a] #

many :: Product f g a -> Product f g [a] #

(AlternativeApplicative f, AlternativeApplicative g) => AlternativeApplicative (Product f g)
Instance details

Methods

empty :: pure :: a -> Product f g a #

(<|>)(<*>) :: Product f g (a -> b) -> Product f g a -> Product f g b #

liftA2 :: (a -> b -> c) -> Product f g a -> Product f g a f g b -> Product f g c #

some(*>) :: Product f g a -> Product f g [a] f g b -> Product f g b #

many(<*) :: Product f g a -> Product f g [a] f g b -> Product f g a #

(Eq1 f, Eq1 g, Eq a) => Eq (Functor f, Functor g) => Functor (Product f g a) f g)

Instance details

Methods

(==) :: fmap :: (a -> b) -> Product f g a -> Product f g a -> Bool f g b #

(/=)(<$) :: a -> Product f g b -> Product f g a #

(Monad f, Monad g) => Monad (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

(>>=) :: Product f g a -> (a -> Product f g b) -> Product f g b #

(>>) :: Product f g a -> Product f g a -> Bool f g b -> Product f g b #

return :: a -> Product f g a #

(MonadPlus f, MonadPlus g) => MonadPlus (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

mzero :: Product f g a #

mplus :: Product f g a -> Product f g a -> Product f g a #

(Typeable
Instance details

(Ord1 f, Ord1 g, Ord a) => Ord (Monoid (f a), Monoid (g a)) => Monoid (Product f g a)

Since: base-4.9.0.0Since: base-4.16.0.0

Instance details

Methods

comparemempty :: Product f g a -> Product f g a -> Ordering f g a #

(<)mappend :: Product f g a -> Product f g a -> Bool f g a -> Product f g a #

(<=) :: mconcat :: [Product f g a -> f g a] -> Product f g a -> Bool f g a #

(Semigroup (f a), Semigroup (g a)) => Semigroup (Product f g a)

Since: base-4.16.0.0

Instance details

Defined in Data.Functor.Product

Methods

(>)(<>) :: Product f g a -> Product f g a -> Bool f g a -> Product f g a #

(>=) :: sconcat :: NonEmpty (Product f g a -> f g a) -> Product f g a -> Bool f g a #

max :: Product f g a -> stimes :: Integral b => b -> Product f g a -> Product f g a #

Generic (Product f g a) 
Instance details

Defined in Data.Functor.Product

Associated Types

type Rep (Product f g a) :: Type -> Type #

Methods

minfrom :: Product f g a -> f g a -> Rep (Product f g a -> f g a) x #

to :: Rep (Product f g a) x -> Product f g a # (Read1

Instance details

(Show1

Instance details

Generic (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) 

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Associated Types

type Rep (Product f g a) :: Type -> Type #

Methods

from(==) :: Product f g a -> Rep ( f g a -> Product f g a) x f g a -> Bool #

to :: Rep ((/=) :: Product f g a) x -> f g a -> Product f g a f g a -> Bool #

(Semigroup (f a), Semigroup (g a)) => Semigroup (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a)

Since: base-4.16.0.0Since: base-4.9.0.0

Instance details

Methods

(<>)compare :: Product f g a -> Product f g a -> Ordering #

(<) :: Product f g a -> Product f g a f g a -> Bool #

sconcat :: NonEmpty ((<=) :: Product f g a) -> f g a -> Product f g a f g a -> Bool #

stimes :: Integral b => b -> (>) :: Product f g a -> Product f g a f g a -> Bool #

(Monoid (f a), Monoid (g a)) => Monoid (Product f g a)

Since: base-4.16.0.0

Instance details

Defined in Data.Functor.Product

Methods

mempty(>=) :: Product f g a f g a -> Product f g a -> Bool #

mappendmax :: Product f g a ->

mconcat :: [min :: Product f g a] -> f g a -> Product f g a -> Product f g a #Foo3 (a :: Char -> Char) #Foo3 (a :: Char -> Char)

Foo3 (a :: Char -> Char) #Foo3 (a :: Char -> Char)
Arrow a => Functor (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b)
Instance details

Methods

fmap :: (a0 -> b0) -> empty :: WrappedArrow a b a0 #

(<|>) :: WrappedArrow a b a0 -> WrappedArrow a b b0 a b a0 -> WrappedArrow a b a0 #

(<$) :: a0 -> some :: WrappedArrow a b b0 -> a b a0 -> WrappedArrow a b a0 a b [a0] #

many :: WrappedArrow a b a0 -> WrappedArrow a b [a0] #

(ArrowZero a, ArrowPlus a) => Alternative Arrow a => Functor (WrappedArrow a b)
Instance details

Methods

empty :: WrappedArrow a b a0 #

(<|>) :: WrappedArrow a b a0 -> WrappedArrow a b a0 -> WrappedArrow a b a0 #

some :: fmap :: (a0 -> b0) -> WrappedArrow a b a0 -> WrappedArrow a b [a0] a b b0 #

many :: (<$) :: a0 -> WrappedArrow a b a0 -> a b b0 -> WrappedArrow a b [a0] a b a0 #

VisibleClass Int VisibleData # VisibleClass VisibleData Int # Foo [] Maybe #

foo :: [ :: Maybe Int] -> a -> [a] -> a -> Maybe a #

foo' :: [[a]] -> :: Maybe (Maybe a) -> Int -> [[ -> Maybe (Maybe Int]] ) #

Foo Maybe [] #

foo :: Maybe :: [Int -> a -> Maybe a ] -> a -> [a] #

foo' :: Maybe (Maybe a) -> :: [[a]] -> Int -> Maybe (Maybe -> [[Int) ]] #

(Eq a, Foo f) => Foo ((,) (f a)) ((<~~) a) #

foo :: (f a, :: (a <~~ Int) -> a0 -> (f a, a0) ) -> a0 -> a <~~ a0 #

foo' :: (f a, (f a, a0)) -> :: (a <~~ (a <~~ a0)) -> Int -> (f a, (f a, -> a <~~ (a <~~ Int)) ) #

(Eq a, Foo ((<~~) a) f) => Foo ((,) (f a)) #

foo :: (a <~~ :: (f a, Int) -> a0 -> a <~~ a0 ) -> a0 -> (f a, a0) #

foo' :: (a <~~ (a <~~ a0)) -> :: (f a, (f a, a0)) -> Int -> a <~~ (a <~~ -> (f a, (f a, Int) )) #

Foo ((,,) a a) (Quux a b) #

foo :: (a, a, :: Quux a b Int) -> a0 -> (a, a, a0) -> a0 -> Quux a b a0 #

foo' :: (a, a, (a, a, a0)) -> :: Quux a b (Quux a b a0) -> Int -> (a, a, (a, a, -> Quux a b (Quux a b Int)) ) #

Foo (Quux a b) ((,,) a a) #

foo :: Quux a b :: (a, a, Int -> a0 -> Quux a b a0 ) -> a0 -> (a, a, a0) #

foo' :: Quux a b (Quux a b a0) -> :: (a, a, (a, a, a0)) -> Int -> Quux a b (Quux a b -> (a, a, (a, a, Int) )) #

Foo ((,,) a b) => Bar ((,,) a b) (a, b, a) # 
Instance details

Defined in Instances

Methods

bar :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a) #

bar' :: (a, b, (a, b, (a, b, a))) -> (a, b, (a, b, (a, b, b0))) #

bar0 :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) #

bar1 :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) #

Bar
Instance details

Foo ((,,) a b) => Bar ((,,) a b) (a, b, a) # 
Instance details

Defined in Instances

Methods

bar :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a) #

bar' :: (a, b, (a, b, (a, b, a))) -> (a, b, (a, b, (a, b, b0))) #

bar0 :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) #

bar1 :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) #

 Baz (a, b, c) (Quux a b c) #

baz :: (a, b, c) -> ( :: Quux a b c -> (forall a0. a0 -> a0) -> (b0, forall c0. c0 -> (a, b, c)) -> (b0, c1) c0. c0 -> Quux a b c) -> (b0, c1) #

baz' :: b0 -> (forall b1. b1 -> (a, b, c)) -> ( b1. b1 -> Quux a b c) -> (forall b2. b2 -> (a, b, c)) -> [(b0, (a, b, c))] b2. b2 -> Quux a b c) -> [(b0, Quux a b c)] #

forall b1. (forall b2. b2 -> (a, b, c)) -> c0) -> b2. b2 -> Quux a b c) -> c0) -> forall c1. c1 -> b0 # Baz (Quux a b c) (a, b, c) #

baz :: Quux a b c -> ( :: (a, b, c) -> (forall a0. a0 -> a0) -> (b0, forall c0. c0 -> Quux a b c) -> (b0, c1) c0. c0 -> (a, b, c)) -> (b0, c1) #

baz' :: b0 -> (forall b1. b1 -> Quux a b c) -> ( b1. b1 -> (a, b, c)) -> (forall b2. b2 -> Quux a b c) -> [(b0, Quux a b c)] b2. b2 -> (a, b, c)) -> [(b0, (a, b, c))] #

forall b1. (forall b2. b2 -> Quux a b c) -> c0) -> b2. b2 -> (a, b, c)) -> c0) -> forall c1. c1 -> b0 # Functor (SomeType f) # 

Instance details

Defined in SpuriousSuperclassConstraints

Methods

fmap :: (a -> b) -> SomeType f a -> SomeType f b #

(<$) :: a -> SomeType f b -> SomeType f a #

Applicative
Instance details

Functor (SomeType f) # 
Instance details

Defined in SpuriousSuperclassConstraints

Methods

fmap :: (a -> b) -> SomeType f a -> SomeType f b #

(<$) :: a -> SomeType f b -> SomeType f a #

 type X 'XXX <> (a :: Type) 'XX #
type X 'XXX <> (a :: Type) = 'XX = 'X
type 'XXX X <> 'XX (a :: Type) #
type 'XXX X <> 'XX = ' (a :: Type) = X
Test YX #

Doc for: instance Test Y

Doc for: instance Test X

Test XY #

Doc for: instance Test X

Doc for: instance Test Y

Foo YX #

Doc for: type instance Foo Y = X

Doc for: type instance Foo X = Y

Foo Y = X = Y
Foo XY #

Doc for: type instance Foo X = Y

Doc for: type instance Foo Y = X

Foo X = Y = X
Bat YX #

Doc for: data instance Bat Y

Doc for: data instance Bat X

Bat Y = BatY YX
Bat XY #

Doc for: data instance Bat X

Doc for: data instance Bat Y

Bat X Y = BatY Y
Assoc YX #

Doc for: instance Assoc Y

Doc for: instance Assoc X

AssocD YX #

AssocT YX #

Assoc XY #

Doc for: instance Assoc X

Doc for: instance Assoc Y

AssocD XY #

AssocT XY #

type Y 'XXX <> (a :: Type) 'XX #
type Y 'XXX <> (a :: Type) = a
'XX = 'X
type 'XXX Y <> 'XX (a :: Type) #
type 'XXX Y <> 'XX = 'X
(a :: Type) = a
type Foo W X #

Should be visible, but with a hidden right hand side

External instance

Instance details

Defined in TypeFamilies2TypeFamilies

type Foo W X = Y
type Foo X W #

External instance

Should be visible, but with a hidden right hand side

Instance details

Defined in TypeFamiliesTypeFamilies2

type Foo X = Y W
data Bar W Y #

Shown because BarX is still exported despite Z being hidden

 Instance details

Defined in TypeFamilies2TypeFamilies

data Bar W = BarX Z
Y
data Bar Y W # 

Shown because BarX is still exported despite Z being hidden

Instance details

Defined in TypeFamiliesTypeFamilies2

data Bar Y
W = BarX Z
type Bar Int () #type Bar () = Int = ()
type Bar () Int #type Bar () = Int = ()
newtypedata Baz Double () #

newtypedata Baz Double = Baz3 Float () = Baz1
datanewtype Baz Int Double #

datanewtype Baz Int = Baz2 Bool Double = Baz3 Float
data Baz () Int #data Baz () = Baz1 Int = Baz2 Bool
bar :: Int -> Int barbaz :: Int -> (Int, Int) bazbar :: [a] -> Int barbaz :: Int -> ([a], [a]) baznorf :: [Int] -> Int norfquux :: ([a], [a]) -> [a] quuxplugh :: forall a b. Either a a -> Either b b -> Either (a -> b) (b -> a) plughInt -x :: Int x :: Point -> Int +x :: Int xInt -y :: Int y :: Point -> Int +y :: Int yInt -y :: Int -x :: Int -y :: Point -> Int x :: Point -> Int +y :: Point -> Int +x :: Int +y :: Int .. Date: Tue, 9 Feb 2021 12:56:15 +0100 Subject: Also make TyLit deterministic --- haddock-api/src/Haddock/Interface/AttachInstances.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index d5b80888..530c5690 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -28,6 +28,7 @@ import Data.Maybe ( maybeToList, mapMaybe, fromMaybe ) import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Data.FastString (unpackFS) import GHC.Core.Class import GHC.Driver.Session import GHC.Core (isOrphan) @@ -194,7 +195,9 @@ instance Ord SName where -- For the benefit of the user (looks nice and predictable) and the -- tests (which prefer output to be deterministic). data SimpleType = SimpleType SName [SimpleType] - | SimpleTyLit TyLit + | SimpleIntTyLit Integer + | SimpleStringTyLit String + | SimpleCharTyLit Char deriving (Eq,Ord) @@ -218,7 +221,9 @@ simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) simplify (TyVarTy v) = SimpleType (SName (tyVarName v)) [] simplify (TyConApp tc ts) = SimpleType (SName (tyConName tc)) (mapMaybe simplify_maybe ts) -simplify (LitTy l) = SimpleTyLit l +simplify (LitTy (NumTyLit n)) = SimpleIntTyLit n +simplify (LitTy (StrTyLit s)) = SimpleStringTyLit (unpackFS s) +simplify (LitTy (CharTyLit c)) = SimpleCharTyLit c simplify (CastTy ty _) = simplify ty simplify (CoercionTy _) = error "simplify:Coercion" -- cgit v1.2.3