aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs1
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Names.hs2
-rw-r--r--haddock-api/src/Haddock/Convert.hs1
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs37
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs10
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs2
-rw-r--r--haddock-api/src/Haddock/Types.hs6
10 files changed, 48 insertions, 20 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 9a15c7b3..1c3dea7c 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Backends.Hoogle
@@ -84,7 +85,8 @@ dropHsDocTy = f
f (HsDocTy a _) = f $ unL a
f x = x
-outHsType :: OutputableBndr a => DynFlags -> HsType a -> String
+outHsType :: (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+ => DynFlags -> HsType a -> String
outHsType dflags = out dflags . dropHsDocTy
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 81a23a1b..85716f33 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -300,6 +300,7 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
ForD d -> ppFor loc (doc, fnArgsDoc) d unicode
InstD _ -> empty
+ DerivD _ -> empty
_ -> error "declaration not supported by ppDecl"
where
unicode = False
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index f7284062..8e9fd7ae 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -47,7 +47,7 @@ import Data.Function
import Data.Ord ( comparing )
import DynFlags (Language(..))
-import GHC hiding ( NoLink, moduleInfo )
+import GHC hiding ( NoLink, moduleInfo,FunctionFixity(..) )
import Name
import Module
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index fab6bf8d..e6dfce67 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -34,7 +34,7 @@ import qualified Data.Map as Map
import Data.Maybe
import Text.XHtml hiding ( name, title, p, quote )
-import GHC
+import GHC hiding (FunctionFixity(..))
import GHC.Exts
import Name
import BooleanFormula
@@ -54,6 +54,7 @@ ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs spl
ty fixities splice unicode qual
ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
InstD _ -> noHtml
+ DerivD _ -> noHtml
_ -> error "declaration not supported by ppDecl"
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index 5492178b..0f4dd51a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -26,7 +26,7 @@ import Text.XHtml hiding ( name, title, p, quote )
import qualified Data.Map as M
import qualified Data.List as List
-import GHC
+import GHC hiding (FunctionFixity(..))
import Name
import RdrName
import FastString (unpackFS)
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 660be723..71a81190 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -1,4 +1,3 @@
-
{-# LANGUAGE CPP, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 007038cb..2c8b0b7e 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -306,16 +306,16 @@ mkMaps dflags gre instances decls =
where loc = case d of
TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
_ -> getInstLoc d
+ names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
names _ decl = getMainDeclBinder decl
-- Note [2]:
------------
--- We relate ClsInsts to InstDecls using the SrcSpans buried inside them.
--- That should work for normal user-written instances (from looking at GHC
--- sources). We can assume that commented instances are user-written.
--- This lets us relate Names (from ClsInsts) to comments (associated
--- with InstDecls).
-
+-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried
+-- inside them. That should work for normal user-written instances (from
+-- looking at GHC sources). We can assume that commented instances are
+-- user-written. This lets us relate Names (from ClsInsts) to comments
+-- (associated with InstDecls and DerivDecls).
--------------------------------------------------------------------------------
-- Declarations
@@ -339,7 +339,7 @@ subordinates instMap decl = case decl of
, name <- getMainDeclBinder d, not (isValD d)
]
dataSubs :: HsDataDefn Name -> [(Name, [HsDocString], Map Int HsDocString)]
- dataSubs dd = constrs ++ fields
+ dataSubs dd = constrs ++ fields ++ derivs
where
cons = map unL $ (dd_cons dd)
constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
@@ -348,6 +348,10 @@ subordinates instMap decl = case decl of
| RecCon flds <- map getConDetails cons
, L _ (ConDeclField ns _ doc) <- (unLoc flds)
, L _ n <- ns ]
+ derivs = [ (instName, [unL doc], M.empty)
+ | Just (L _ tys) <- [dd_derivs dd]
+ , HsIB { hsib_body = L l (HsDocTy _ doc) } <- tys
+ , Just instName <- [M.lookup l instMap] ]
-- | Extract function argument docs from inside types.
typeDocs :: HsDecl Name -> Map Int HsDocString
@@ -395,12 +399,12 @@ mkFixMap group_ = M.fromList [ (n,f)
-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
ungroup :: HsGroup Name -> [LHsDecl Name]
ungroup group_ =
- mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++
+ mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++
mkDecls hs_derivds DerivD group_ ++
mkDecls hs_defds DefD group_ ++
mkDecls hs_fords ForD group_ ++
mkDecls hs_docs DocD group_ ++
- mkDecls hs_instds InstD group_ ++
+ mkDecls (tyClGroupInstDecls . hs_tyclds) InstD group_ ++
mkDecls (typesigs . hs_valds) SigD group_ ++
mkDecls (valbinds . hs_valds) ValD group_
where
@@ -434,8 +438,9 @@ filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
filterDecls = filter (isHandled . unL . fst)
where
isHandled (ForD (ForeignImport {})) = True
- isHandled (TyClD {}) = True
- isHandled (InstD {}) = True
+ isHandled (TyClD {}) = True
+ isHandled (InstD {}) = True
+ isHandled (DerivD {}) = True
isHandled (SigD d) = isUserLSig (reL d)
isHandled (ValD _) = True
-- we keep doc declarations to be able to get at named docs
@@ -757,8 +762,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
| otherwise = return Nothing
mkExportItem decl@(L l (InstD d))
| Just name <- M.lookup (getInstLoc d) instMap =
- let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
- return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ expInst decl l name
+ mkExportItem decl@(L l (DerivD {}))
+ | Just name <- M.lookup l instMap =
+ expInst decl l name
mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
mdef <- liftGhcToErrMsgGhc $ minimalDef name
let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
@@ -773,6 +780,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
where (doc, subs) = lookupDocs name warnings docMap argMap subMap
+ expInst decl l name =
+ let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
+ return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+
-- | Sometimes the declaration we want to export is not the "main" declaration:
-- it might be an individual record selector or a class method. In these
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 3054e2f9..1f3f2aab 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -328,6 +328,9 @@ renameDecl decl = case decl of
InstD d -> do
d' <- renameInstD d
return (InstD d')
+ DerivD d -> do
+ d' <- renameDerivD d
+ return (DerivD d')
_ -> error "renameDecl"
renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName))
@@ -503,6 +506,13 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do
d' <- renameDataFamInstD d
return (DataFamInstD { dfid_inst = d' })
+renameDerivD :: DerivDecl Name -> RnM (DerivDecl DocName)
+renameDerivD (DerivDecl { deriv_type = ty
+ , deriv_overlap_mode = omode }) = do
+ ty' <- renameLSigType ty
+ return (DerivDecl { deriv_type = ty'
+ , deriv_overlap_mode = omode })
+
renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
, cid_poly_ty =ltype, cid_tyfam_insts = lATs
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index f45589a0..770b9977 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -81,7 +81,7 @@ binaryInterfaceMagic = 0xD0Cface
-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
--
binaryInterfaceVersion :: Word16
-#if (__GLASGOW_HASKELL__ >= 711) && (__GLASGOW_HASKELL__ < 801)
+#if (__GLASGOW_HASKELL__ >= 801) && (__GLASGOW_HASKELL__ < 803)
binaryInterfaceVersion = 28
binaryInterfaceVersionCompatibility :: [Word16]
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index eacf4473..1a7a0b6f 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
+ -- in module GHC.PlaceHolder
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
@@ -341,7 +344,8 @@ data InstType name
| TypeInst (Maybe (HsType name)) -- ^ Body (right-hand side)
| DataInst (TyClDecl name) -- ^ Data constructors
-instance OutputableBndr a => Outputable (InstType a) where
+instance (OutputableBndr a, OutputableBndr (NameOrRdrName a))
+ => Outputable (InstType a) where
ppr (ClassInst { .. }) = text "ClassInst"
<+> ppr clsiCtx
<+> ppr clsiTyVars
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 10:26:55 +0000