From a36ab92b289b4d6b707696eef49145bc7ced4957 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 25 Nov 2018 10:32:22 -0800 Subject: More uniform handling of `forall`'s in HTML/LaTeX * don't forget to print explicit `forall`'s when there are arg docs * when printing an explicit `forall`, print all tyvars Fixes #973 --- html-test/src/Bug975.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 html-test/src/Bug975.hs (limited to 'html-test/src') diff --git a/html-test/src/Bug975.hs b/html-test/src/Bug975.hs new file mode 100644 index 00000000..97ebabda --- /dev/null +++ b/html-test/src/Bug975.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ExplicitForAll #-} +module Bug973 where + +showRead + :: forall a b. (Show a, Read b) + => a -- ^ this gets turned into a string... + -> b -- ^ ...from which this is read +showRead = read . show + +-- | Same as 'showRead', but with type variable order flipped +showRead' + :: forall b a. (Show a, Read b) + => a -- ^ this gets turned into a string... + -> b -- ^ ...from which this is read +showRead' = read . show -- cgit v1.2.3 From fd56ac4d031963ecc137a5027d800bd8ed588264 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 25 Jan 2019 10:26:16 -0500 Subject: Fix #1004 with a pinch of dropForAlls --- haddock-api/src/Haddock/Convert.hs | 2 +- html-test/ref/Bug1004.html | 2072 ++++++++++++++++++++++++++++++++++++ html-test/src/Bug1004.hs | 3 + 3 files changed, 2076 insertions(+), 1 deletion(-) create mode 100644 html-test/ref/Bug1004.html create mode 100644 html-test/src/Bug1004.hs (limited to 'html-test/src') diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 6eee353b..7735ed0d 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -274,7 +274,7 @@ synifyTyCon coax tc -- which this function obtains. synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind GhcRn) synifyDataTyConReturnKind tc - = case splitFunTys (tyConKind tc) of + = case splitFunTys (dropForAlls (tyConKind tc)) of (_, ret_kind) | isLiftedTypeKind ret_kind -> Nothing -- Don't bother displaying :: * | otherwise -> Just (synifyKindSig ret_kind) diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html new file mode 100644 index 00000000..9179e252 --- /dev/null +++ b/html-test/ref/Bug1004.html @@ -0,0 +1,2072 @@ +Bug1004
Safe HaskellSafe

Bug1004

Synopsis

Documentation

data Product (f :: k -> Type) (g :: k -> Type) (a :: k) #

Lifted product of functors.

Constructors

Pair (f a) (g a)

Instances

Instances details
Generic1 (Product f g :: k -> Type)
Instance details

Defined in Data.Functor.Product

Associated Types

type Rep1 (Product f g) :: k -> Type #

Methods

from1 :: Product f g a -> Rep1 (Product f g) a #

to1 :: Rep1 (Product f g) a -> 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 b -> Product f g b #

return :: a -> Product f g a #

fail :: String -> 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 f, MonadFix g) => MonadFix (Product f g)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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 b -> Product f g c #

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

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

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

fold :: Monoid m => Product f g m -> m #

foldMap :: Monoid m => (a -> m) -> Product f g a -> m #

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

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

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

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

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

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

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

null :: Product f g a -> Bool #

length :: Product f g a -> Int #

elem :: Eq a => a -> Product f g a -> Bool #

maximum :: Ord a => Product f g a -> a #

minimum :: Ord a => Product f g a -> a #

sum :: Num a => Product f g a -> a #

product :: Num a => Product f g a -> a #

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

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 => Product f g (m a) -> m (Product f g a) #

(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 -> Product f g b -> Bool #

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Product f g a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Product f g a] #

liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Product f g a) #

liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Product f g a] #

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

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

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

empty :: Product f g a #

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

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

many :: Product f g 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 #

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a), Data (g a)) => Data (Product f g a)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g0. g0 -> c g0) -> Product f g a -> c (Product f g a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Product f g a) #

toConstr :: Product f g a -> Constr #

dataTypeOf :: Product f g a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Product f g a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Product f g a)) #

gmapT :: (forall b. Data b => b -> b) -> Product f g a -> Product f g a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Product f g a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Product f g a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Product f g a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Product f g a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Product f g a -> m (Product f g a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Product f g a -> m (Product f g a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Product f g a -> m (Product f g a) #

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

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

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

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

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

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

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

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

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

(Read1 f, Read1 g, Read a) => Read (Product f g a)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

readsPrec :: Int -> ReadS (Product f g a) #

readList :: ReadS [Product f g a] #

readPrec :: ReadPrec (Product f g a) #

readListPrec :: ReadPrec [Product f g a] #

(Show1 f, Show1 g, Show a) => Show (Product f g a)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

Methods

showsPrec :: Int -> Product f g a -> ShowS #

show :: Product f g a -> String #

showList :: [Product f g a] -> ShowS #

Generic (Product f g a)
Instance details

Defined in Data.Functor.Product

Associated Types

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

Methods

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

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

type Rep1 (Product f g :: k -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

type Rep (Product f g a)

Since: base-4.9.0.0

Instance details

Defined in Data.Functor.Product

\ No newline at end of file diff --git a/html-test/src/Bug1004.hs b/html-test/src/Bug1004.hs new file mode 100644 index 00000000..d789e77f --- /dev/null +++ b/html-test/src/Bug1004.hs @@ -0,0 +1,3 @@ +module Bug1004 (Product(..)) where + +import Data.Functor.Product -- cgit v1.2.3 From 5d45da4898f7e8e7a1637b4cd473c393063034a0 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 25 Feb 2019 21:53:56 -0800 Subject: Fix standalone deriving docs Docs on standalone deriving decls for classes with associated types should be associated with the class instance, not the associated type instance. Fixes #1033 --- haddock-api/src/Haddock/Interface/Create.hs | 4 +- html-test/ref/Bug1033.html | 222 ++++++++++++++++++++++++++++ html-test/src/Bug1033.hs | 11 ++ 3 files changed, 235 insertions(+), 2 deletions(-) create mode 100644 html-test/ref/Bug1033.html create mode 100644 html-test/src/Bug1033.hs (limited to 'html-test/src') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a4408434..146c3cc8 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -132,8 +132,8 @@ createInterface tm flags modMap instIfaceMap = do fixMap = mkFixMap group_ (decls, _) = unzip declsWithDocs localInsts = filter (nameIsLocalOrFrom sem_mdl) - $ map getName instances - ++ map getName fam_instances + $ map getName fam_instances + ++ map getName instances -- Locations of all TH splices splices = [ l | L l (SpliceD _ _) <- hsmodDecls hsm ] diff --git a/html-test/ref/Bug1033.html b/html-test/ref/Bug1033.html new file mode 100644 index 00000000..32a9f6d3 --- /dev/null +++ b/html-test/ref/Bug1033.html @@ -0,0 +1,222 @@ +Bug1033
Safe HaskellSafe

Bug1033

Documentation

data Foo #

Constructors

Foo

Instances

Instances details
Generic Foo #

This does some generic foos.

Instance details

Defined in Bug1033

Associated Types

type Rep Foo :: Type -> Type #

Methods

from :: Foo -> Rep Foo x #

to :: Rep Foo x -> Foo #

type Rep Foo #
Instance details

Defined in Bug1033

type Rep Foo = D1 (MetaData "Foo" "Bug1033" "main" False) (C1 (MetaCons "Foo" PrefixI False) (U1 :: Type -> Type))
\ No newline at end of file diff --git a/html-test/src/Bug1033.hs b/html-test/src/Bug1033.hs new file mode 100644 index 00000000..fdf5a57e --- /dev/null +++ b/html-test/src/Bug1033.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Bug1033 where + +import GHC.Generics + +data Foo = Foo + +-- | This does some generic foos. +deriving instance Generic Foo -- cgit v1.2.3