From 41ed9c36c1ebcef66501c547b60fbc382f08dd24 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Thu, 21 Mar 2019 15:36:51 +0100
Subject: [PATCH] Haddock interfaces produced from `.hi` files
= Summary
This is a large architectural change to how Haddock interfaces are
computed. This is a rebased variant of the second half of Simon Jakobi's
(@sjakobi) Hi Haddock GSOC project.
The idea is to work over top of the contents of `.hi` files
instead of over the internal compiler representations of ASTs.
This has a wide array of benefits, but two main ones are:
* Haddock doesn't necessarily need to recompile modules to generate
docs - if the right `.hi` files already exist, it'll automatically
load them. Even better: this is nothing more that the existing
recompilation avoidance logic in GHC.
* Haddock no longer operates over concrete syntax - all declarations
in the final docs are the result of reifying a `TyThing`. This means
that the docs can be somewhat agnostic of users' particular choice
to add certain kind annotations, use certain special syntax, etc.
== Before
Very roughly the previous way this worked was:
1. `depanal` is used to figure out the dependency order in which
modules should be loaded
2. `parseModule` and `typecheckModule` are used to get a
`TypecheckedModule` for every input module
3. The parsed and renamed sources in the typechecked module are
traversed in various ways accumulating all the right info
== After
Now, the process
1. `GhcMake.load'` is used to load `.hi`-files into GHC
2. `loadSysInterface` is used to lookup the `ModIface` associated with
each module
---
.gitignore | 4 +
doc/cheatsheet/haddocks.md | 5 +-
doc/invoking.rst | 19 -
doc/markup.rst | 13 +-
haddock-api/src/Documentation/Haddock.hs | 1 -
haddock-api/src/Haddock.hs | 15 +-
.../src/Haddock/Backends/Hyperlinker.hs | 5 +-
.../Haddock/Backends/Hyperlinker/Parser.hs | 2 +-
.../Haddock/Backends/Hyperlinker/Renderer.hs | 4 +-
.../src/Haddock/Backends/Hyperlinker/Utils.hs | 2 +-
haddock-api/src/Haddock/Backends/LaTeX.hs | 76 +-
haddock-api/src/Haddock/Backends/Xhtml.hs | 11 +-
.../src/Haddock/Backends/Xhtml/Decl.hs | 99 +-
.../src/Haddock/Backends/Xhtml/Layout.hs | 16 +-
.../src/Haddock/Backends/Xhtml/Names.hs | 18 +-
.../src/Haddock/Backends/Xhtml/Utils.hs | 18 +-
haddock-api/src/Haddock/GhcUtils.hs | 6 +
haddock-api/src/Haddock/Interface.hs | 69 +-
.../src/Haddock/Interface/AttachInstances.hs | 28 +-
haddock-api/src/Haddock/Interface/Create.hs | 1105 +++++------------
.../src/Haddock/Interface/LexParseRn.hs | 183 +--
.../Haddock/Interface/ParseModuleHeader.hs | 12 +-
haddock-api/src/Haddock/Interface/Rename.hs | 18 +-
haddock-api/src/Haddock/InterfaceFile.hs | 24 +-
haddock-api/src/Haddock/Options.hs | 12 +-
haddock-api/src/Haddock/Types.hs | 66 +-
haddock-api/src/Haddock/Utils.hs | 13 +-
hoogle-test/ref/Bug722/test.txt | 2 +-
hoogle-test/ref/Bug806/test.txt | 8 +-
hoogle-test/ref/Bug825/test.txt | 2 +-
hoogle-test/ref/Bug873/test.txt | 2 +-
hoogle-test/ref/classes/test.txt | 2 +-
hoogle-test/ref/type-sigs/test.txt | 12 +-
html-test/Main.hs | 6 -
html-test/ref/Bug294.html | 6 +-
html-test/ref/Bug613.html | 12 +-
html-test/ref/Bug85.html | 16 +-
html-test/ref/Bug923.html | 54 +-
html-test/ref/BundledPatterns.html | 24 +-
html-test/ref/BundledPatterns2.html | 16 +-
html-test/ref/DefaultAssociatedTypes.html | 160 +++
html-test/ref/DefaultSignatures.html | 184 +++
html-test/ref/DeprecatedTypeFamily.html | 24 +-
html-test/ref/FunArgs.html | 6 +-
html-test/ref/GADTRecords.html | 20 +-
html-test/ref/HideRuntimeReps.html | 165 +++
html-test/ref/Instances.html | 206 ++-
html-test/ref/Operators.html | 28 +-
html-test/ref/PatternSyns.html | 8 +-
...reExports.html => PrefixStarOperator.html} | 64 +-
html-test/ref/PrintRuntimeReps.html | 189 +++
html-test/ref/PromotedTypes.html | 50 +-
.../ref/SpuriousSuperclassConstraints.html | 6 +-
html-test/ref/Test.html | 102 +-
html-test/ref/TypeFamilies.html | 130 +-
html-test/ref/TypeFamilies3.html | 2 +-
html-test/ref/TypeOperators.html | 48 +-
html-test/ref/mini_IgnoreExports.html | 39 -
html-test/src/DefaultAssociatedTypes.hs | 14 +
html-test/src/DefaultSignatures.hs | 19 +
html-test/src/HideRuntimeReps.hs | 2 +
html-test/src/IgnoreExports.hs | 10 -
html-test/src/PrefixStarOperator.hs | 3 +
html-test/src/PrintRuntimeReps.hs | 2 +
.../DefaultSignatures/DefaultSignatures.tex | 48 +
latex-test/ref/DefaultSignatures/haddock.sty | 57 +
latex-test/ref/DefaultSignatures/main.tex | 11 +
latex-test/ref/Deprecated/Deprecated.tex | 17 +
latex-test/ref/Deprecated/haddock.sty | 57 +
latex-test/ref/Deprecated/main.tex | 11 +
latex-test/ref/Example/Example.tex | 30 +
latex-test/ref/Example/haddock.sty | 57 +
latex-test/ref/Example/main.tex | 11 +
.../ref/TypeFamilies3/TypeFamilies3.tex | 2 +-
.../DefaultSignatures/DefaultSignatures.hs | 19 +
latex-test/src/Deprecated/Deprecated.hs | 7 +
latex-test/src/Example/Example.hs | 11 +
77 files changed, 2436 insertions(+), 1389 deletions(-)
create mode 100644 html-test/ref/DefaultAssociatedTypes.html
create mode 100644 html-test/ref/DefaultSignatures.html
create mode 100644 html-test/ref/HideRuntimeReps.html
rename html-test/ref/{IgnoreExports.html => PrefixStarOperator.html} (50%)
create mode 100644 html-test/ref/PrintRuntimeReps.html
delete mode 100644 html-test/ref/mini_IgnoreExports.html
create mode 100644 html-test/src/DefaultAssociatedTypes.hs
create mode 100644 html-test/src/DefaultSignatures.hs
create mode 100644 html-test/src/HideRuntimeReps.hs
delete mode 100644 html-test/src/IgnoreExports.hs
create mode 100644 html-test/src/PrefixStarOperator.hs
create mode 100644 html-test/src/PrintRuntimeReps.hs
create mode 100644 latex-test/ref/DefaultSignatures/DefaultSignatures.tex
create mode 100644 latex-test/ref/DefaultSignatures/haddock.sty
create mode 100644 latex-test/ref/DefaultSignatures/main.tex
create mode 100644 latex-test/ref/Deprecated/Deprecated.tex
create mode 100644 latex-test/ref/Deprecated/haddock.sty
create mode 100644 latex-test/ref/Deprecated/main.tex
create mode 100644 latex-test/ref/Example/Example.tex
create mode 100644 latex-test/ref/Example/haddock.sty
create mode 100644 latex-test/ref/Example/main.tex
create mode 100644 latex-test/src/DefaultSignatures/DefaultSignatures.hs
create mode 100644 latex-test/src/Deprecated/Deprecated.hs
create mode 100644 latex-test/src/Example/Example.hs
diff --git a/.gitignore b/.gitignore
index d65138d11d..60b0ad9530 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,6 +8,10 @@
/latex-test/out/
/hoogle-test/out/
+# ignore interface files
+*.hi
+*.dyn_hi
+
/doc/haddock
/doc/haddock.ps
/doc/haddock.pdf
diff --git a/doc/cheatsheet/haddocks.md b/doc/cheatsheet/haddocks.md
index 5ee285b3ac..1b4f851808 100644
--- a/doc/cheatsheet/haddocks.md
+++ b/doc/cheatsheet/haddocks.md
@@ -109,14 +109,13 @@ definitions with "[thing]"
Omit this module from the docs
{-# OPTIONS_HADDOCK prune #-}
Omit definitions without docs
-{-# OPTIONS_HADDOCK ignore-exports #-}
- Treat this module as though all
- top-level items are exported
{-# OPTIONS_HADDOCK not-home #-}
Do not treat this module as the
"home" of identifiers it exports
{-# OPTIONS_HADDOCK show-extensions #-}
Show all enabled LANGUAGE extensions
+{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
+ Show all `RuntimeRep` type variables
```
# Grid tables
diff --git a/doc/invoking.rst b/doc/invoking.rst
index 5397dacf52..a056065610 100644
--- a/doc/invoking.rst
+++ b/doc/invoking.rst
@@ -246,10 +246,6 @@ The following options are available:
name. Note that for the per-entity URLs this is the name of the
*exporting* module.
- - The string ``%F`` or ``%{FILE}`` is replaced by the original
- source file name. Note that for the per-entity URLs this is the
- name of the *defining* module.
-
- The string ``%N`` or ``%{NAME}`` is replaced by the name of the
exported value or type. This is only valid for the
:option:`--source-entity` option.
@@ -264,9 +260,6 @@ The following options are available:
- The string ``%%`` is replaced by ``%``.
- For example, if your sources are online under some directory, you
- would say ``haddock --source-base=url/ --source-module=url/%F``
-
If you have html versions of your sources online with anchors for
each type and function name, you would say
``haddock --source-base=url/ --source-module=url/%M.html --source-entity=url/%M.html#%N``
@@ -277,11 +270,6 @@ The following options are available:
characters in a file name). To replace it with a character c use
``%{MODULE/./c}``.
- Similarly, for the ``%{FILE}`` substitution you may want to replace
- the ``/`` character in the file names with some other character
- (especially for links to colourised entity source code with a shared
- css file). To replace it with a character c use ``%{FILE///c}``/
-
One example of a tool that can generate syntax-highlighted HTML from
your source code, complete with anchors suitable for use from
haddock, is
@@ -474,13 +462,6 @@ The following options are available:
:option:`-i` or :option:`--read-interface`). This is used to generate a single
contents and/or index for multiple sets of Haddock documentation.
-.. option:: --ignore-all-exports
-
- Causes Haddock to behave as if every module has the
- ``ignore-exports`` attribute (:ref:`module-attrs`). This might be useful for
- generating implementation documentation rather than interface
- documentation, for example.
-
.. option:: --hide <module>
Causes Haddock to behave as if module module has the ``hide``
diff --git a/doc/markup.rst b/doc/markup.rst
index 9fb0209aac..f6a12496b1 100644
--- a/doc/markup.rst
+++ b/doc/markup.rst
@@ -749,7 +749,7 @@ specified in a comma-separated list in an
``{-# OPTIONS_HADDOCK ... #-}`` pragma at the top of the module, either
before or after the module description. For example: ::
- {-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}
+ {-# OPTIONS_HADDOCK hide, prune #-}
-- |Module description
module A where
@@ -768,11 +768,6 @@ The following attributes are currently understood by Haddock:
Omit definitions that have no documentation annotations from the
generated documentation.
-``ignore-exports``
- Ignore the export list. Generate documentation as if the module had
- no export list - i.e. all the top-level declarations are exported,
- and section headings may be given in the body of the module.
-
``not-home``
Indicates that the current module should not be considered to be the
home module for each entity it exports, unless that entity is not
@@ -787,6 +782,12 @@ The following attributes are currently understood by Haddock:
be rendered, including those implied by their more powerful
versions.
+``print-explicit-runtime-reps``
+ Print type variables that have kind ``RuntimeRep``. By default, these
+ are defaulted to ``LiftedRep`` so that end users don't have to see the
+ underlying levity polymorphism. This flag is analogous to GHC's
+ ``-fprint-explicit-runtime-reps`` flag.
+
.. _markup:
Markup
diff --git a/haddock-api/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs
index 10d6849ae6..314c5d0f9c 100644
--- a/haddock-api/src/Documentation/Haddock.hs
+++ b/haddock-api/src/Documentation/Haddock.hs
@@ -43,7 +43,6 @@ module Documentation.Haddock (
DocMarkupH(..),
Documentation(..),
ArgMap,
- AliasMap,
WarningMap,
DocMap,
HaddockModInfo(..),
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index c83908940a..5e38aff854 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -493,8 +493,19 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do
parseGhcFlags dynflags = do
-- TODO: handle warnings?
- let extra_opts | needHieFiles = [Opt_WriteHie, Opt_Haddock]
- | otherwise = [Opt_Haddock]
+ let extra_opts =
+ [ Opt_Haddock
+ -- Include docstrings in .hi-files.
+
+ , Opt_SkipIfaceVersionCheck
+ -- Ignore any aspects of .hi-files except docs.
+
+ , Opt_WriteInterface
+ -- If we can't use an old .hi-file, save the new one.
+ ] ++
+ [ Opt_WriteHie | needHieFiles
+ -- Generate .hie-files
+ ]
dynflags' = (foldl' gopt_set dynflags extra_opts)
{ hscTarget = HscNothing
, ghcMode = CompManager
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 251c886b0e..4ee45fbedc 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -52,8 +52,7 @@ ppHyperlinkedSource outdir libdir mstyle pretty srcs' ifaces = do
-- | Generate hyperlinked source for particular interface.
ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMaps -> Interface -> IO ()
-ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
- Just hfp -> do
+ppHyperlinkedModuleSource srcdir pretty srcs iface = do
-- Parse the GHC-produced HIE file
u <- mkSplitUniqSupply 'a'
HieFile { hie_hs_file = file
@@ -76,8 +75,8 @@ ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of
| M.size asts == 0 -> return ()
| otherwise -> error $ unwords [ "couldn't find ast for"
, file, show (M.keys asts) ]
- Nothing -> return ()
where
+ hfp = ifaceHieFile iface
df = ifaceDynFlags iface
render' = render (Just srcCssFile) (Just highlightScript) srcs
path = srcdir </> hypSrcModuleFile (ifaceMod iface)
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 5991db5a55..2f10567481 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -9,7 +9,7 @@ import qualified Data.ByteString as BS
import BasicTypes ( IntegralLit(..) )
import DynFlags
-import ErrUtils ( emptyMessages, pprLocErrMsg )
+import ErrUtils ( pprLocErrMsg )
import FastString ( mkFastString )
import Lexer ( P(..), ParseResult(..), PState(..), Token(..)
, mkPStatePure, lexer, mkParserFlags', getErrorMessages, addFatalError )
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index a4dcb77b68..a7cc7e3ed8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -250,7 +250,7 @@ hyperlink (srcs, srcs') ident = case ident of
Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleNameUrl mdl name ]
Just (SrcExternal path) -> Html.anchor content !
- [ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing (".." </> path) ]
+ [ Html.href $ spliceURL (Just mdl) (Just name) Nothing (".." </> path) ]
Nothing -> content
where
mdl = nameModule name
@@ -260,7 +260,7 @@ hyperlink (srcs, srcs') ident = case ident of
Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleUrl' moduleName ]
Just (SrcExternal path) -> Html.anchor content !
- [ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing (".." </> path) ]
+ [ Html.href $ spliceURL' (Just moduleName) Nothing Nothing (".." </> path) ]
Nothing -> content
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 67eb10b5cf..24f5a52a99 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -39,7 +39,7 @@ hypSrcModuleFile m = moduleNameString (moduleName m) <.> "html"
hypSrcModuleFile' :: ModuleName -> FilePath
hypSrcModuleFile' mdl = spliceURL'
- Nothing (Just mdl) Nothing Nothing moduleFormat
+ (Just mdl) Nothing Nothing moduleFormat
hypSrcModuleUrl :: Module -> String
hypSrcModuleUrl = hypSrcModuleFile
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 9e2e52c36d..a41de4e271 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -27,7 +27,7 @@ import qualified Pretty
import BasicTypes ( PromotionFlag(..) )
import GHC
import OccName
-import Name ( nameOccName )
+import Name ( getOccString, nameOccName, tidyNameOcc )
import RdrName ( rdrNameOcc )
import FastString ( unpackFS )
import Outputable ( panic)
@@ -295,7 +295,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
-- | Just _ <- tcdTyPats d -> ppTyInst False loc doc d unicode
-- Family instances happen via FamInst now
TyClD _ d@ClassDecl{} -> ppClassDecl instances doc subdocs d unicode
- SigD _ (TypeSig _ lnames ty) -> ppFunSig (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
+ SigD _ (TypeSig _ lnames ty) -> ppFunSig Nothing (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
SigD _ (PatSynSig _ lnames ty) -> ppLPatSig (doc, fnArgsDoc) (map unLoc lnames) ty unicode
ForD _ d -> ppFor (doc, fnArgsDoc) d unicode
InstD _ _ -> empty
@@ -307,7 +307,7 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
- ppFunSig doc [name] (hsSigType typ) unicode
+ ppFunSig Nothing doc [name] (hsSigType typ) unicode
ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
-- error "foreign declarations are currently not supported by --latex"
@@ -414,17 +414,23 @@ ppTySyn _ _ _ = error "declaration not supported by ppTySyn"
-------------------------------------------------------------------------------
-ppFunSig :: DocForDecl DocName -> [DocName] -> LHsType DocNameI
- -> Bool -> LaTeX
-ppFunSig doc docnames (L _ typ) unicode =
+ppFunSig
+ :: Maybe LaTeX -- ^ a prefix to put right before the signature
+ -> DocForDecl DocName -- ^ documentation
+ -> [DocName] -- ^ pattern names in the pattern signature
+ -> LHsType DocNameI -- ^ type of the pattern synonym
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppFunSig leader doc docnames (L _ typ) unicode =
ppTypeOrFunSig typ doc
- ( ppTypeSig names typ False
- , hsep . punctuate comma $ map ppSymName names
+ ( lead $ ppTypeSig names typ False
+ , lead $ hsep . punctuate comma $ map ppSymName names
, dcolon unicode
)
unicode
where
names = map getName docnames
+ lead = maybe id (<+>) leader
-- | Pretty-print a pattern synonym
ppLPatSig :: DocForDecl DocName -- ^ documentation
@@ -433,15 +439,7 @@ ppLPatSig :: DocForDecl DocName -- ^ documentation
-> Bool -- ^ unicode
-> LaTeX
ppLPatSig doc docnames ty unicode
- = ppTypeOrFunSig typ doc
- ( keyword "pattern" <+> ppTypeSig names typ False
- , keyword "pattern" <+> (hsep . punctuate comma $ map ppSymName names)
- , dcolon unicode
- )
- unicode
- where
- typ = unLoc (hsSigType ty)
- names = map getName docnames
+ = ppFunSig (Just (keyword "pattern")) doc docnames (hsSigType ty) unicode
-- | Pretty-print a type, adding documentation to the whole type and its
-- arguments as needed.
@@ -594,6 +592,7 @@ ppFds fds unicode =
hsep (map (ppDocName . unLoc) vars2)
+-- TODO: associated types, associated type defaults, docs on default methods
ppClassDecl :: [DocInstance DocNameI]
-> Documentation DocName -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI -> Bool -> LaTeX
@@ -619,13 +618,21 @@ ppClassDecl instances doc subdocs
methodTable =
text "\\haddockpremethods{}" <> emph (text "Methods") $$
- vcat [ ppFunSig doc names (hsSigWcType typ) unicode
- | L _ (TypeSig _ lnames typ) <- lsigs
+ vcat [ ppFunSig leader doc names (hsSigType typ) unicode
+ | L _ (ClassOpSig _ is_def lnames typ) <- lsigs
, let doc = lookupAnySubdoc (head names) subdocs
- names = map unLoc lnames ]
- -- FIXME: is taking just the first name ok? Is it possible that
- -- there are different subdocs for different names in a single
- -- type signature?
+ names = map (cleanName . unLoc) lnames
+ leader = if is_def then Just (keyword "default") else Nothing
+ ]
+ -- N.B. taking just the first name is ok. Signatures with multiple
+ -- names are expanded so that each name gets its own signature.
+
+ -- Get rid of the ugly '$dm' prefix on default method names
+ cleanName n
+ | isDefaultMethodOcc (occName n)
+ , '$':'d':'m':occStr <- getOccString n
+ = setName (tidyNameOcc (getName n) (mkOccName varName occStr)) n
+ | otherwise = n
instancesBit = ppDocInstances unicode instances
@@ -1185,32 +1192,35 @@ latexMonoMunge c s = latexMunge c s
parLatexMarkup :: (a -> LaTeX) -> DocMarkup a (StringContext -> LaTeX)
parLatexMarkup ppId = Markup {
- markupParagraph = \p v -> p v <> text "\\par" $$ text "",
+ markupParagraph = \p v -> blockElem $ p v <> text "\\par",
markupEmpty = \_ -> empty,
markupString = \s v -> text (fixString v s),
markupAppend = \l r v -> l v <> r v,
markupIdentifier = markupId ppId,
markupIdentifierUnchecked = markupId (ppVerbOccName . snd),
markupModule = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl),
- markupWarning = \p v -> emph (p v),
+ markupWarning = \p v -> p v,
markupEmphasis = \p v -> emph (p v),
markupBold = \p v -> bold (p v),
markupMonospaced = \p _ -> tt (p Mono),
- markupUnorderedList = \p v -> itemizedList (map ($v) p) $$ text "",
+ markupUnorderedList = \p v -> blockElem $ itemizedList (map ($v) p),
markupPic = \p _ -> markupPic p,
markupMathInline = \p _ -> markupMathInline p,
- markupMathDisplay = \p _ -> markupMathDisplay p,
- markupOrderedList = \p v -> enumeratedList (map ($v) p) $$ text "",
- markupDefList = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
- markupCodeBlock = \p _ -> quote (verb (p Verb)) $$ text "",
- markupHyperlink = \(Hyperlink u l) p -> markupLink u (fmap ($p) l),
+ markupMathDisplay = \p _ -> blockElem $ markupMathDisplay p,
+ markupOrderedList = \p v -> blockElem $ enumeratedList (map ($v) p),
+ markupDefList = \l v -> blockElem $ descriptionList (map (\(a,b) -> (a v, b v)) l),
+ markupCodeBlock = \p _ -> blockElem $ quote (verb (p Verb)),
+ markupHyperlink = \(Hyperlink u l) v -> markupLink u (fmap ($v) l),
markupAName = \_ _ -> empty,
- markupProperty = \p _ -> quote $ verb $ text p,
- markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e,
+ markupProperty = \p _ -> blockElem $ quote $ verb $ text p,
+ markupExample = \e _ -> blockElem $ quote $ verb $ text $ unlines $ map exampleToString e,
markupHeader = \(Header l h) p -> header l (h p),
markupTable = \(Table h b) p -> table h b p
}
where
+ blockElem :: LaTeX -> LaTeX
+ blockElem = ($$ text "")
+
header 1 d = text "\\section*" <> braces d
header 2 d = text "\\subsection*" <> braces d
header l d
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 9add4cae4c..b31530ca5d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -146,8 +146,7 @@ srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just src_base_url, _, _, _) Nothing =
Just (anchor ! [href src_base_url] << "Source")
srcButton (_, Just src_module_url, _, _) (Just iface) =
- let url = spliceURL (Just $ ifaceOrigFilename iface)
- (Just $ ifaceMod iface) Nothing Nothing src_module_url
+ let url = spliceURL (Just $ ifaceMod iface) Nothing Nothing src_module_url
in Just (anchor ! [href url] << "Source")
srcButton _ _ =
Nothing
@@ -158,7 +157,7 @@ wikiButton (Just wiki_base_url, _, _) Nothing =
Just (anchor ! [href wiki_base_url] << "User Comments")
wikiButton (_, Just wiki_module_url, _) (Just mdl) =
- let url = spliceURL Nothing (Just mdl) Nothing Nothing wiki_module_url
+ let url = spliceURL (Just mdl) Nothing Nothing wiki_module_url
in Just (anchor ! [href url] << "User Comments")
wikiButton _ _ =
@@ -379,8 +378,7 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = d
goInterface iface =
concatMap (goExport mdl qual) (ifaceRnExportItems iface)
where
- aliases = ifaceModuleAliases iface
- qual = makeModuleQual qual_opt aliases mdl
+ qual = makeModuleQual qual_opt mdl
mdl = ifaceMod iface
goExport :: Module -> Qualification -> ExportItem DocNameI -> [Value]
@@ -547,7 +545,6 @@ ppHtmlModule odir doctitle themes
maybe_contents_url maybe_index_url unicode pkg qual debug iface = do
let
mdl = ifaceMod iface
- aliases = ifaceModuleAliases iface
mdl_str = moduleString mdl
mdl_str_annot = mdl_str ++ if ifaceIsSig iface
then " (signature)"
@@ -559,7 +556,7 @@ ppHtmlModule odir doctitle themes
")"
| otherwise
= toHtml mdl_str
- real_qual = makeModuleQual qual aliases mdl
+ real_qual = makeModuleQual qual mdl
html =
headHtml mdl_str_annot themes maybe_mathjax_url +++
bodyHtml doctitle (Just iface)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 1a0db1532a..79f1990112 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -36,6 +36,7 @@ import Text.XHtml hiding ( name, title, p, quote )
import BasicTypes (PromotionFlag(..), isPromoted)
import GHC hiding (LexicalFixity(..))
+import qualified GHC
import GHC.Exts
import Name
import BooleanFormula
@@ -75,14 +76,14 @@ ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
[Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppLFunSig summary links loc doc lnames lty fixities splice unicode pkg qual =
- ppFunSig summary links loc doc (map unLoc lnames) lty fixities
+ ppFunSig summary links loc noHtml doc (map unLoc lnames) lty fixities
splice unicode pkg qual
-ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
+ppFunSig :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
[DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
Splice -> Unicode -> Maybe Package -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ fixities splice unicode pkg qual =
- ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
+ppFunSig summary links loc leader doc docnames typ fixities splice unicode pkg qual =
+ ppSigLike summary links loc leader doc docnames fixities (unLoc typ, pp_typ)
splice unicode pkg qual HideEmptyContexts
where
pp_typ = ppLType unicode qual HideEmptyContexts typ
@@ -236,7 +237,7 @@ ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
-> Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppFor summary links loc doc (ForeignImport _ (L _ name) typ _) fixities
splice unicode pkg qual
- = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode pkg qual
+ = ppFunSig summary links loc noHtml doc [name] (hsSigType typ) fixities splice unicode pkg qual
ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
@@ -518,7 +519,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
-- ToDo: add associated type defaults
- [ ppFunSig summary links loc doc names (hsSigType typ)
+ [ ppFunSig summary links loc noHtml doc names (hsSigType typ)
[] splice unicode pkg qual
| L _ (ClassOpSig _ False lnames typ) <- sigs
, let doc = lookupAnySubdoc (head names) subdocs
@@ -539,8 +540,9 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)
-> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI
-> Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppClassDecl summary links instances fixities loc d subdocs
- decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
- , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
+ decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname@(L _ nm)
+ , tcdTyVars = ltyvars, tcdFDs = lfds, tcdSigs = lsigs
+ , tcdATs = ats, tcdATDefs = atsDefs })
splice unicode pkg qual
| summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual
| otherwise = classheader +++ docSection curname pkg qual d
@@ -557,28 +559,68 @@ ppClassDecl summary links instances fixities loc d subdocs
-- Only the fixity relevant to the class header
fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
- nm = tcdName decl
-
hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
- -- ToDo: add assocatied typ defaults
- atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode pkg qual
- | at <- ats
- , let n = unL . fdLName $ unL at
- doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
- subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
-
- methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ)
- subfixs splice unicode pkg qual
- | L _ (ClassOpSig _ _ lnames typ) <- lsigs
- , name <- map unLoc lnames
- , let doc = lookupAnySubdoc name subdocs
- subfixs = [ f | f@(n',_) <- fixities
- , name == n' ]
- ]
- -- N.B. taking just the first name is ok. Signatures with multiple names
- -- are expanded so that each name gets its own signature.
+ -- Associated types
+ atBit = subAssociatedTypes
+ [ ppAssocType summary links doc at subfixs splice unicode pkg qual
+ <+>
+ subDefaults (maybeToList defTys)
+ | at <- ats
+ , let name = unL . fdLName $ unL at
+ doc = lookupAnySubdoc name subdocs
+ subfixs = filter ((== name) . fst) fixities
+ defTys = ppDefaultAssocTy name <$> lookupDAT name
+ ]
+
+ -- Default associated types
+ ppDefaultAssocTy n (vs,t,d') = ppTySyn summary links [] loc d' synDecl
+ splice unicode pkg qual
+ where
+ synDecl = SynDecl { tcdSExt = noExt
+ , tcdLName = noLoc n
+ , tcdTyVars = vs
+ , tcdFixity = GHC.Prefix
+ , tcdRhs = t }
+
+ lookupDAT name = Map.lookup (getName name) defaultAssocTys
+ defaultAssocTys = Map.fromList
+ [ (getName name, (vs, typ, doc))
+ | L _ (FamEqn { feqn_rhs = typ
+ , feqn_tycon = L _ name
+ , feqn_pats = vs }) <- atsDefs
+ , let doc = noDocForDecl -- TODO: get docs for associated type defaults
+ ]
+
+ -- Methods
+ methodBit = subMethods
+ [ ppFunSig summary links loc noHtml doc [name] (hsSigType typ)
+ subfixs splice unicode pkg qual
+ <+>
+ subDefaults (maybeToList defSigs)
+ | ClassOpSig _ False lnames typ <- sigs
+ , name <- map unLoc lnames
+ , let doc = lookupAnySubdoc name subdocs
+ subfixs = filter ((== name) . fst) fixities
+ defSigs = ppDefaultFunSig name <$> lookupDM name
+ ]
+ -- N.B. taking just the first name is ok. Signatures with multiple names
+ -- are expanded so that each name gets its own signature.
+
+ -- Default methods
+ ppDefaultFunSig n (t, d') = ppFunSig summary links loc (keyword "default")
+ d' [n] (hsSigType t) [] splice unicode pkg qual
+
+ lookupDM name = Map.lookup (getOccString name) defaultMethods
+ defaultMethods = Map.fromList
+ [ (nameStr, (typ, doc))
+ | ClassOpSig _ True lnames typ <- sigs
+ , name <- map unLoc lnames
+ , let doc = lookupAnySubdoc name subdocs
+ , '$':'d':'m':nameStr <- [getOccString name]
+ ]
+ -- Minimal complete definition
minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
-- Miminal complete definition = every shown method
And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
@@ -587,7 +629,7 @@ ppClassDecl summary links instances fixities loc d subdocs
-- Minimal complete definition = the only shown method
Var (L _ n) : _ | [getName n] ==
- [getName n' | L _ (ClassOpSig _ _ ns _) <- lsigs, L _ n' <- ns]
+ [getName n' | ClassOpSig _ _ ns _ <- sigs, L _ n' <- ns]
-> noHtml
-- Minimal complete definition = nothing
@@ -602,6 +644,7 @@ ppClassDecl summary links instances fixities loc d subdocs
where wrap | p = parens | otherwise = id
ppMinimal p (Parens x) = ppMinimal p (unLoc x)
+ -- Instances
instancesBit = ppInstances links (OriginClass nm) instances
splice unicode pkg qual
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 25d8b07a30..6a54946cf4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -35,6 +35,7 @@ module Haddock.Backends.Xhtml.Layout (
subInstances, subOrphanInstances,
subInstHead, subInstDetails, subFamInstDetails,
subMethods,
+ subDefaults,
subMinimal,
topDeclElem, declElem,
@@ -49,7 +50,6 @@ import qualified Data.Map as Map
import Text.XHtml hiding ( name, title, quote )
import Data.Maybe (fromMaybe)
-import FastString ( unpackFS )
import GHC
import Name (nameOccName)
@@ -259,6 +259,9 @@ instAnchorId iid = makeAnchorId $ "i:" ++ iid
subMethods :: [Html] -> Html
subMethods = divSubDecls "methods" "Methods" . subBlock
+subDefaults :: [Html] -> Html
+subDefaults = divSubDecls "default" "" . subBlock
+
subMinimal :: Html -> Html
subMinimal = divSubDecls "minimal" "Minimal complete definition" . Just . declElem
@@ -289,15 +292,14 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(D
| otherwise = maybe lineUrl Just nameUrl in
case mUrl of
Nothing -> noHtml
- Just url -> let url' = spliceURL (Just fname) (Just origMod)
- (Just n) (Just loc) url
+ Just url -> let url' = spliceURL (Just origMod) (Just n) (Just loc)
+ url
in anchor ! [href url', theclass "link"] << "Source"
wikiLink =
case maybe_wiki_url of
Nothing -> noHtml
- Just url -> let url' = spliceURL (Just fname) (Just mdl)
- (Just n) (Just loc) url
+ Just url -> let url' = spliceURL (Just mdl) (Just n) (Just loc) url
in anchor ! [href url', theclass "link"] << "Comments"
-- For source links, we want to point to the original module,
@@ -307,8 +309,4 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(D
-- will point to the module defining the class/family, which is wrong.
origMod = fromMaybe (nameModule n) mdl'
origPkg = moduleUnitId origMod
-
- fname = case loc of
- RealSrcSpan l -> unpackFS (srcSpanFile l)
- UnhelpfulSpan _ -> error "links: UnhelpfulSpan"
links _ _ _ _ _ = noHtml
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index 574045e020..2d0499ef8a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -23,7 +23,6 @@ import Haddock.Types
import Haddock.Utils
import Text.XHtml hiding ( name, p, quote )
-import qualified Data.Map as M
import qualified Data.List as List
import GHC hiding (LexicalFixity(..))
@@ -88,11 +87,6 @@ ppQualifyName qual notation name mdl =
Just _ -> ppFullQualName notation mdl name
-- some other module, D.x -> D.x
Nothing -> ppFullQualName notation mdl name
- AliasedQual aliases localmdl ->
- case (moduleString mdl == moduleString localmdl,
- M.lookup mdl aliases) of
- (False, Just alias) -> ppQualName notation alias name
- _ -> ppName notation name
ppFullQualName :: Notation -> Module -> Name -> Html
@@ -100,11 +94,6 @@ ppFullQualName notation mdl name = wrapInfix notation (getOccName name) qname
where
qname = toHtml $ moduleString mdl ++ '.' : getOccString name
-ppQualName :: Notation -> ModuleName -> Name -> Html
-ppQualName notation mdlName name = wrapInfix notation (getOccName name) qname
- where
- qname = toHtml $ moduleNameString mdlName ++ '.' : getOccString name
-
ppName :: Notation -> Name -> Html
ppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccString name)
@@ -131,14 +120,11 @@ ppBinder' notation n = wrapInfix notation n $ ppOccName n
wrapInfix :: Notation -> OccName -> Html -> Html
wrapInfix notation n = case notation of
- Infix | is_star_kind -> id
- | not is_sym -> quote
- Prefix | is_star_kind -> id
- | is_sym -> parens
+ Infix | not is_sym -> quote
+ Prefix | is_sym -> parens
_ -> id
where
is_sym = isSymOcc n
- is_star_kind = isTcOcc n && occNameString n == "*"
linkId :: Module -> Maybe Name -> Html -> Html
linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index c3acb6dfa3..a8718c8dbd 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -33,8 +33,6 @@ module Haddock.Backends.Xhtml.Utils (
import Haddock.Utils
-import Data.Maybe
-
import Text.XHtml hiding ( name, title, p, quote )
import qualified Text.XHtml as XHtml
@@ -48,19 +46,18 @@ import Name ( getOccString, nameOccName, isValOcc )
-- Used to generate URL for customized external paths, usually provided with
-- @--source-module@, @--source-entity@ and related command-line arguments.
--
--- >>> spliceURL Nothing mmod mname Nothing "output/%{MODULE}.hs#%{NAME}"
+-- >>> spliceURL mmod mname Nothing "output/%{MODULE}.hs#%{NAME}"
-- "output/Foo.hs#foo"
-spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
+spliceURL :: Maybe Module -> Maybe GHC.Name ->
Maybe SrcSpan -> String -> String
-spliceURL mfile mmod = spliceURL' mfile (moduleName <$> mmod)
+spliceURL mmod = spliceURL' (moduleName <$> mmod)
-- | Same as 'spliceURL' but takes 'ModuleName' instead of 'Module'.
-spliceURL' :: Maybe FilePath -> Maybe ModuleName -> Maybe GHC.Name ->
+spliceURL' :: Maybe ModuleName -> Maybe GHC.Name ->
Maybe SrcSpan -> String -> String
-spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
+spliceURL' maybe_mod maybe_name maybe_loc = run
where
- file = fromMaybe "" maybe_file
mdl = case maybe_mod of
Nothing -> ""
Just m -> moduleNameString m
@@ -81,23 +78,18 @@ spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
run "" = ""
run ('%':'M':rest) = mdl ++ run rest
- run ('%':'F':rest) = file ++ run rest
run ('%':'N':rest) = name ++ run rest
run ('%':'K':rest) = kind ++ run rest
run ('%':'L':rest) = line ++ run rest
run ('%':'%':rest) = '%' : run rest
run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl ++ run rest
- run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest
run ('%':'{':'N':'A':'M':'E':'}':rest) = name ++ run rest
run ('%':'{':'K':'I':'N':'D':'}':rest) = kind ++ run rest
run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) =
map (\x -> if x == '.' then c else x) mdl ++ run rest
- run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) =
- map (\x -> if x == '/' then c else x) file ++ run rest
-
run ('%':'{':'L':'I':'N':'E':'}':rest) = line ++ run rest
run (c:rest) = c : run rest
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 1ed93b3c9b..c909801c1a 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -24,11 +24,13 @@ import Data.Char ( isSpace )
import Haddock.Types( DocNameI )
import Exception
+import FastString ( fsLit )
import FV
import Outputable ( Outputable, panic, showPpr )
import Name
import NameSet
import Module
+import PrelNames ( mkBaseModule )
import HscTypes
import GHC
import Class
@@ -48,6 +50,7 @@ import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
+
moduleString :: Module -> String
moduleString = moduleNameString . moduleName
@@ -162,6 +165,9 @@ nubByName f ns = go emptyNameSet ns
where
y = f x
+dATA_LIST :: Module
+dATA_LIST = mkBaseModule (fsLit "Data.List")
+
-- ---------------------------------------------------------------------
-- This function is duplicated as getGADTConType and getGADTConTypeG,
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index f1b2d45e89..2f390c9d94 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -48,19 +48,20 @@ import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Distribution.Verbosity
+import System.Exit (exitFailure ) -- TODO use Haddock's die
import Text.Printf
-import Module (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
import Digraph
import DynFlags hiding (verbosity)
import GHC hiding (verbosity)
+import GhcMake
import HscTypes
import FastString (unpackFS)
-import TcRnTypes (tcg_rdr_env)
-import Name (nameIsFromExternalPackage, nameOccName)
-import OccName (isTcOcc)
-import RdrName (unQualOK, gre_name, globalRdrEnvElts)
+import TcRnMonad (initIfaceCheck)
import ErrUtils (withTiming)
+import Outputable
+import LoadIface
+import GhcMonad
#if defined(mingw32_HOST_OS)
import System.IO
@@ -88,7 +89,7 @@ processModules verbosity modules flags extIfaces = do
out verbosity verbose "Creating interfaces..."
let instIfaceMap = Map.fromList [ (instMod iface, iface) | ext <- extIfaces
, iface <- ifInstalledIfaces ext ]
- (interfaces, ms) <- createIfaces verbosity modules flags instIfaceMap
+ interfaces <- createIfaces verbosity modules flags instIfaceMap
let exportedNames =
Set.unions $ map (Set.fromList . ifaceExports) $
@@ -97,7 +98,7 @@ processModules verbosity modules flags extIfaces = do
out verbosity verbose "Attaching instances..."
interfaces' <- {-# SCC attachInstances #-}
withTiming getDynFlags "attachInstances" (const ()) $ do
- attachInstances (exportedNames, mods) interfaces instIfaceMap ms
+ attachInstances (exportedNames, mods) interfaces instIfaceMap
out verbosity verbose "Building cross-linking environment..."
-- Combine the link envs of the external packages into one
@@ -121,56 +122,52 @@ processModules verbosity modules flags extIfaces = do
--------------------------------------------------------------------------------
-createIfaces :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc ([Interface], ModuleSet)
+createIfaces :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]
createIfaces verbosity modules flags instIfaceMap = do
-- Ask GHC to tell us what the module graph is
targets <- mapM (\filePath -> guessTarget filePath Nothing) modules
setTargets targets
modGraph <- depanal [] False
+ -- Create (if necessary) and load .hi-files.
+ success <- withTiming getDynFlags "load'" (const ()) $ do
+ load' LoadAllTargets Nothing modGraph
+ when (failed success) $ do
+ out verbosity normal "load' failed"
+ liftIO exitFailure
+
-- Visit modules in that order
let sortedMods = flattenSCCs $ topSortModuleGraph False modGraph Nothing
out verbosity normal "Haddock coverage:"
- (ifaces, _, !ms) <- foldM f ([], Map.empty, emptyModuleSet) sortedMods
- return (reverse ifaces, ms)
+ (ifaces, _) <- foldM f ([], Map.empty) sortedMods
+ return (reverse ifaces)
where
- f (ifaces, ifaceMap, !ms) modSummary = do
+ f (ifaces, ifaceMap) modSummary = do
x <- {-# SCC processModule #-}
withTiming getDynFlags "processModule" (const ()) $ do
processModule verbosity modSummary flags ifaceMap instIfaceMap
return $ case x of
- Just (iface, ms') -> ( iface:ifaces
- , Map.insert (ifaceMod iface) iface ifaceMap
- , unionModuleSet ms ms' )
- Nothing -> ( ifaces
- , ifaceMap
- , ms ) -- Boot modules don't generate ifaces.
+ Just iface -> ( iface:ifaces
+ , Map.insert (ifaceMod iface) iface ifaceMap )
+ Nothing -> ( ifaces
+ , ifaceMap ) -- Boot modules don't generate ifaces.
-processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe (Interface, ModuleSet))
+processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface)
processModule verbosity modsum flags modMap instIfaceMap = do
out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
- tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum
+ mod_iface <- withSession $ \hsc_env ->
+ liftIO $ initIfaceCheck (text "processModule 0") hsc_env $
+ loadSysInterface (text "processModule 1")
+ (ms_mod modsum)
+
+ let mod_loc = ms_location modsum
if not $ isBootSummary modsum then do
out verbosity verbose "Creating interface..."
(interface, msgs) <- {-# SCC createIterface #-}
- withTiming getDynFlags "createInterface" (const ()) $ do
- runWriterGhc $ createInterface tm flags modMap instIfaceMap
-
- -- We need to keep track of which modules were somehow in scope so that when
- -- Haddock later looks for instances, it also looks in these modules too.
- --
- -- See https://github.com/haskell/haddock/issues/469.
- hsc_env <- getSession
- let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm
- this_pkg = thisPackage (hsc_dflags hsc_env)
- !mods = mkModuleSet [ nameModule name
- | gre <- globalRdrEnvElts new_rdr_env
- , let name = gre_name gre
- , nameIsFromExternalPackage this_pkg name
- , isTcOcc (nameOccName name) -- Types and classes only
- , unQualOK gre ] -- In scope unqualified
+ withTiming getDynFlags "createInterface" (const ()) $
+ runWriterGhc $ createInterface mod_iface mod_loc flags modMap instIfaceMap
liftIO $ mapM_ putStrLn (nub msgs)
dflags <- getDynFlags
@@ -205,7 +202,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do
unless header $ out verbosity normal " Module header"
mapM_ (out verbosity normal . (" " ++)) undocumentedExports
interface' <- liftIO $ evaluate interface
- return (Just (interface', mods))
+ return (Just interface')
else
return Nothing
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 35f24ee5fa..0894784fd8 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -34,11 +34,12 @@ import ErrUtils
import FamInstEnv
import GHC
import InstEnv
-import Module ( ModuleSet, moduleSetElts )
+import Module ( mkModuleSet, moduleSetElts )
import MonadUtils (liftIO)
import Name
import NameEnv
import Outputable (text, sep, (<+>))
+import Packages (ModuleOrigin(..), moduleToPkgConfAll)
import SrcLoc
import TyCon
import TyCoRep
@@ -50,13 +51,30 @@ type Modules = Set.Set Module
type ExportInfo = (ExportedNames, Modules)
-- Also attaches fixities
-attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> ModuleSet -> Ghc [Interface]
-attachInstances expInfo ifaces instIfaceMap mods = do
+attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
+attachInstances expInfo ifaces instIfaceMap = do
+
+ -- We need to keep load modules in which we will look for instances. We've
+ -- somewhat arbitrarily decided to load all modules which are available -
+ -- either directly or from a re-export.
+ --
+ -- See https://github.com/haskell/haddock/issues/469.
+ dflags <- getDynFlags
+ let mod_to_pkg_conf = moduleToPkgConfAll (pkgState dflags)
+ mods = mkModuleSet [ m
+ | mod_map <- Map.elems mod_to_pkg_conf
+ , ( m
+ , ModOrigin { fromOrigPackage = fromOrig
+ , fromExposedReexport = reExp
+ }
+ ) <- Map.assocs mod_map
+ , fromOrig == Just True || not (null reExp)
+ ]
+ mods' = Just (moduleSetElts mods)
+
(_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces) mods'
mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces
where
- mods' = Just (moduleSetElts mods)
-
-- TODO: take an IfaceMap as input
ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index a63f44ce32..63a2d5deef 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -19,7 +19,6 @@
-----------------------------------------------------------------------------
module Haddock.Interface.Create (createInterface) where
-import Documentation.Haddock.Doc (metaDocAppend)
import Haddock.Types
import Haddock.Options
import Haddock.GhcUtils
@@ -27,123 +26,133 @@ import Haddock.Utils
import Haddock.Convert
import Haddock.Interface.LexParseRn
-import Data.Bifunctor
-import Data.Bitraversable
import qualified Data.Map as M
import Data.Map (Map)
import Data.List
+import qualified Data.List.NonEmpty as NE
import Data.Maybe
-import Data.Ord
-import Control.Applicative
+import Control.Arrow ((&&&))
import Control.Monad
import Data.Traversable
import Avail hiding (avail)
import qualified Avail
-import qualified Module
-import qualified SrcLoc
+import BasicTypes ( PromotionFlag(..), WarningSort(..), warningTxtContents
+ , TupleSort(..), Boxity(..) )
import ConLike (ConLike(..))
+import DynFlags (getDynFlags)
import GHC
+import GhcMonad
import HscTypes
import Name
import NameSet
-import NameEnv
-import Packages ( lookupModuleInAllPackages, PackageName(..) )
-import Bag
-import RdrName
-import TcRnTypes
-import FastString ( unpackFS, bytesFS )
-import BasicTypes ( StringLiteral(..), SourceText(..), PromotionFlag(..) )
+import Packages ( PackageName(..) )
+import PrelNames ( dATA_TUPLE, pRELUDE, gHC_PRIM, gHC_TYPES )
+import TcIface ( typecheckIface )
+import TcRnMonad ( initIfaceCheck )
+import TysPrim ( funTyConName )
+import TysWiredIn ( listTyConName, nilDataConName, consDataConName, eqTyConName
+ , tupleDataCon, tupleTyConName)
+import FastString ( unpackFS )
import qualified Outputable as O
-
--- | Use a 'TypecheckedModule' to produce an 'Interface'.
+-- | Use a 'ModIface' to produce an 'Interface'.
-- To do this, we need access to already processed modules in the topological
-- sort. That's what's in the 'IfaceMap'.
-createInterface :: TypecheckedModule
+createInterface :: ModIface
+ -> ModLocation
-> [Flag] -- Boolean flags
-> IfaceMap -- Locally processed modules
-> InstIfaceMap -- External, already installed interfaces
-> ErrMsgGhc Interface
-createInterface tm flags modMap instIfaceMap = do
-
- let ms = pm_mod_summary . tm_parsed_module $ tm
- mi = moduleInfo tm
- L _ hsm = parsedSource tm
- !safety = modInfoSafe mi
- mdl = ms_mod ms
- sem_mdl = tcg_semantic_mod (fst (tm_internals_ tm))
- is_sig = ms_hsc_src ms == HsigFile
- dflags = ms_hspp_opts ms
- !instances = modInfoInstances mi
- !fam_instances = md_fam_insts md
- !exportedNames = modInfoExportsWithSelectors mi
+createInterface mod_iface mod_loc flags modMap instIfaceMap = do
+ dflags <- getDynFlags
+
+ let mdl = mi_module mod_iface
+ sem_mdl = mi_semantic_module mod_iface
+ is_sig = isJust (mi_sig_of mod_iface)
+ safety = getSafeMode (mi_trust mod_iface)
+
+ -- Not sure whether the relevant info is in these dflags
(pkgNameFS, _) = modulePackageInfo dflags flags (Just mdl)
pkgName = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS
+ warnings = mi_warns mod_iface
+
+ -- See Note [Exporting built-in items]
+ special_exports
+ | mdl == gHC_TYPES = listAvail <> eqAvail
+ | mdl == gHC_PRIM = funAvail
+ | mdl == pRELUDE = listAvail <> funAvail
+ | mdl == dATA_TUPLE = tupsAvail
+ | mdl == dATA_LIST = listAvail
+ | otherwise = []
+ !exportedNames = concatMap availNamesWithSelectors
+ (special_exports <> mi_exports mod_iface)
+
+ fixMap = mkFixMap exportedNames (mi_fixities mod_iface)
+
+ mod_iface_docs <- case mi_docs mod_iface of
+ Just docs -> pure docs
+ Nothing -> do
+ liftErrMsg $ tell [O.showPpr dflags mdl ++ " has no docs in its .hi-file"]
+ pure emptyDocs
- (TcGblEnv { tcg_rdr_env = gre
- , tcg_warns = warnings
- , tcg_exports = all_exports
- }, md) = tm_internals_ tm
-
- -- The 'pkgName' is necessary to decide what package to mention in "@since"
- -- annotations. Not having it is not fatal though.
- --
- -- Cabal can be trusted to pass the right flags, so this warning should be
- -- mostly encountered when running Haddock outside of Cabal.
- when (isNothing pkgName) $
- liftErrMsg $ tell [ "Warning: Package name is not available." ]
-
- -- The renamed source should always be available to us, but it's best
- -- to be on the safe side.
- (group_, imports, mayExports, mayDocHeader) <-
- case renamedSource tm of
- Nothing -> do
- liftErrMsg $ tell [ "Warning: Renamed source is not available." ]
- return (emptyRnGroup, [], Nothing, Nothing)
- Just x -> return x
-
- opts <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl
+ opts <- liftErrMsg $ mkDocOpts (docs_haddock_opts mod_iface_docs) flags mdl
+ let prr | OptPrintRuntimeRep `elem` opts = ShowRuntimeRep
+ | otherwise = HideRuntimeRep
-- Process the top-level module header documentation.
- (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags pkgName gre safety mayDocHeader
+ (!info, mbDoc) <- processModuleHeader pkgName safety
+ (docs_language mod_iface_docs)
+ (docs_extensions mod_iface_docs)
+ (docs_mod_hdr mod_iface_docs)
- let declsWithDocs = topDecls group_
+ modWarn <- moduleWarning warnings
- exports0 = fmap (map (first unLoc)) mayExports
- exports
- | OptIgnoreExports `elem` opts = Nothing
- | otherwise = exports0
+ let process = processDocStringParas pkgName
+ docMap <- traverse process (docs_decls mod_iface_docs)
+ argMap <- traverse (traverse process) (docs_args mod_iface_docs)
- unrestrictedImportedMods
- -- module re-exports are only possible with
- -- explicit export list
- | Just{} <- exports
- = unrestrictedModuleImports (map unLoc imports)
- | otherwise = M.empty
+ warningMap <- mkWarningMap warnings exportedNames
- fixMap = mkFixMap group_
- (decls, _) = unzip declsWithDocs
- localInsts = filter (nameIsLocalOrFrom sem_mdl)
+ -- Are these all the (fam_)instances that we need?
+ (instances, fam_instances) <- liftGhcToErrMsgGhc $ withSession $ \hsc_env -> liftIO $
+ (md_insts &&& md_fam_insts)
+ <$> initIfaceCheck (O.text "createInterface'") hsc_env
+ (typecheckIface mod_iface)
+ let localInsts = filter (nameIsLocalOrFrom sem_mdl)
$ map getName instances
++ map getName fam_instances
- -- Locations of all TH splices
- splices = [ l | L l (SpliceD _ _) <- hsmodDecls hsm ]
-
- warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)
-
- maps@(!docMap, !argMap, !declMap, _) <-
- liftErrMsg (mkMaps dflags pkgName gre localInsts declsWithDocs)
+ instanceMap = M.fromList (map (getSrcSpan &&& id) localInsts)
let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
+ -- Locations of all TH splices
+ -- TODO: We use the splice info in 'Haddock.Backends.Xhtml.Layout.links' to
+ -- determine what kind of link we want to generate. Since we depend on
+ -- declaration locations there, it makes sense to get the splice locations
+ -- together with the other locations from the extended .hie files.
+ splices = []
+
+ -- See Note [Exporting built-in items]
+ let builtinTys = DsiSectionHeading 1 (HsDoc (mkHsDocString "Builtin syntax") [])
+ bonus_ds mods
+ | mdl == gHC_TYPES = [ DsiExports (listAvail <> eqAvail) ] <> mods
+ | mdl == gHC_PRIM = [ builtinTys, DsiExports funAvail ] <> mods
+ | mdl == pRELUDE = let (hs, rest) = splitAt 2 mods
+ in hs <> [ DsiExports (listAvail <> funAvail) ] <> rest
+ | mdl == dATA_TUPLE = mods <> [ DsiExports tupsAvail ]
+ | mdl == dATA_LIST = [ DsiExports listAvail ] <> mods
+ | otherwise = mods
+
-- The MAIN functionality: compute the export items which will
-- each be the actual documentation of this module.
- exportItems <- mkExportItems is_sig modMap pkgName mdl sem_mdl allWarnings gre
- exportedNames decls maps fixMap unrestrictedImportedMods
- splices exports all_exports instIfaceMap dflags
+ exportItems <- mkExportItems prr modMap pkgName mdl allWarnings
+ docMap argMap fixMap splices
+ (docs_named_chunks mod_iface_docs)
+ (bonus_ds $ docs_structure mod_iface_docs) instIfaceMap
- let !visibleNames = mkVisibleNames maps exportItems opts
+ let !visibleNames = mkVisibleNames instanceMap exportItems opts
-- Measure haddock documentation coverage.
let prunedExportItems0 = pruneExportItems exportItems
@@ -158,15 +167,9 @@ createInterface tm flags modMap instIfaceMap = do
| otherwise = exportItems
!prunedExportItems = seqList prunedExportItems' `seq` prunedExportItems'
- let !aliases =
- mkAliasMap dflags $ tm_renamed_source tm
-
- modWarn <- liftErrMsg (moduleWarning dflags gre warnings)
-
return $! Interface {
ifaceMod = mdl
, ifaceIsSig = is_sig
- , ifaceOrigFilename = msHsFilePath ms
, ifaceInfo = info
, ifaceDoc = Documentation mbDoc modWarn
, ifaceRnDoc = Documentation Nothing Nothing
@@ -179,128 +182,130 @@ createInterface tm flags modMap instIfaceMap = do
, ifaceRnExportItems = []
, ifaceExports = exportedNames
, ifaceVisibleExports = visibleNames
- , ifaceDeclMap = declMap
, ifaceFixMap = fixMap
- , ifaceModuleAliases = aliases
, ifaceInstances = instances
, ifaceFamInstances = fam_instances
- , ifaceOrphanInstances = [] -- Filled in `attachInstances`
- , ifaceRnOrphanInstances = [] -- Filled in `renameInterface`
+ , ifaceOrphanInstances = []
+ , ifaceRnOrphanInstances = []
, ifaceHaddockCoverage = coverage
, ifaceWarningMap = warningMap
- , ifaceHieFile = Just $ ml_hie_file $ ms_location ms
+ , ifaceHieFile = ml_hie_file mod_loc
, ifaceDynFlags = dflags
}
+ where
+ -- Note [Exporting built-in items]
+ --
+ -- Some items do not show up in their modules exports simply because Haskell
+ -- lacks the concrete syntax to represent such an export. We'd still like
+ -- these to show up in docs, so we manually patch on some extra exports for a
+ -- small number of modules:
+ --
+ -- * "GHC.Prim" should export @(->)@
+ -- * "GHC.Types" should export @[]([], (:))@ and @(~)@
+ -- * "Prelude" should export @(->)@ and @[]([], (:))@
+ -- * "Data.Tuple" should export tuples up to arity 15 (that is the number
+ -- that Haskell98 guarantees exist and that is also the point at which
+ -- GHC stops providing instances)
+ --
+ listAvail = [ AvailTC listTyConName
+ [listTyConName, nilDataConName, consDataConName]
+ [] ]
+ funAvail = [ AvailTC funTyConName [funTyConName] [] ]
+ eqAvail = [ AvailTC eqTyConName [eqTyConName] [] ]
+ tupsAvail = [ AvailTC tyName [tyName, datName] []
+ | i<-[0..15]
+ , let tyName = tupleTyConName BoxedTuple i
+ , let datName = getName $ tupleDataCon Boxed i
+ ]
--- | Given all of the @import M as N@ declarations in a package,
--- create a mapping from the module identity of M, to an alias N
--- (if there are multiple aliases, we pick the last one.) This
--- will go in 'ifaceModuleAliases'.
-mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
-mkAliasMap dflags mRenamedSource =
- case mRenamedSource of
- Nothing -> M.empty
- Just (_,impDecls,_,_) ->
- M.fromList $
- mapMaybe (\(SrcLoc.L _ impDecl) -> do
- SrcLoc.L _ alias <- ideclAs impDecl
- return $
- (lookupModuleDyn dflags
- -- TODO: This is supremely dodgy, because in general the
- -- UnitId isn't going to look anything like the package
- -- qualifier (even with old versions of GHC, the
- -- IPID would be p-0.1, but a package qualifier never
- -- has a version number it. (Is it possible that in
- -- Haddock-land, the UnitIds never have version numbers?
- -- I, ezyang, have not quite understand Haddock's package
- -- identifier model.)
- --
- -- Additionally, this is simulating some logic GHC already
- -- has for deciding how to qualify names when it outputs
- -- them to the user. We should reuse that information;
- -- or at least reuse the renamed imports, which know what
- -- they import!
- (fmap Module.fsToUnitId $
- fmap sl_fs $ ideclPkgQual impDecl)
- (case ideclName impDecl of SrcLoc.L _ name -> name),
- alias))
- impDecls
-
--- We want to know which modules are imported without any qualification. This
--- way we can display module reexports more compactly. This mapping also looks
--- through aliases:
+-- | Given the information that comes out of a 'DsiModExport', decide which of
+-- the re-exported modules can be linked directly and which modules need to have
+-- their avails inlined. We can link directly to a module when:
--
--- module M (module X) where
--- import M1 as X
--- import M2 as X
+-- * all of the stuff avail from that module is also available here
+-- * that module is not marked as hidden
--
--- With our mapping we know that we can display exported modules M1 and M2.
---
-unrestrictedModuleImports :: [ImportDecl name] -> M.Map ModuleName [ModuleName]
-unrestrictedModuleImports idecls =
- M.map (map (unLoc . ideclName))
- $ M.filter (all isInteresting) impModMap
+-- TODO: Do we need a special case for the current module?
+unrestrictedModExports
+ :: IfaceMap
+ -> Avails
+ -> [ModuleName]
+ -> ErrMsgGhc ([Module], Avails)
+ -- ^ ( modules exported without restriction
+ -- , remaining exports not included in any
+ -- of these modules
+ -- )
+unrestrictedModExports ifaceMap avails mod_names = do
+ mods_and_exports <- fmap catMaybes $ for mod_names $ \mod_name -> do
+ mdl <- liftGhcToErrMsgGhc $ findModule mod_name Nothing
+ mb_modinfo <- liftGhcToErrMsgGhc $ getModuleInfo mdl
+ case mb_modinfo of
+ Nothing -> do
+ dflags <- getDynFlags
+ liftErrMsg $ tell [ "Bug: unrestrictedModExports: " ++ pretty dflags mdl]
+ pure Nothing
+ Just modinfo ->
+ pure (Just (mdl, mkNameSet (modInfoExportsWithSelectors modinfo)))
+ let unrestricted = filter everythingVisible mods_and_exports
+ mod_exps = unionNameSets (map snd unrestricted)
+ remaining = nubAvails (filterAvails (\n -> not (n `elemNameSet` mod_exps)) avails)
+ pure (map fst unrestricted, remaining)
where
- impModMap =
- M.fromListWith (++) (concatMap moduleMapping idecls)
-
- moduleMapping idecl =
- concat [ [ (unLoc (ideclName idecl), [idecl]) ]
- , [ (unLoc mod_name, [idecl])
- | Just mod_name <- [ideclAs idecl]
- ]
- ]
-
- isInteresting idecl =
- case ideclHiding idecl of
- -- i) no subset selected
- Nothing -> True
- -- ii) an import with a hiding clause
- -- without any names
- Just (True, L _ []) -> True
- -- iii) any other case of qualification
- _ -> False
-
--- Similar to GHC.lookupModule
--- ezyang: Not really...
-lookupModuleDyn ::
- DynFlags -> Maybe UnitId -> ModuleName -> Module
-lookupModuleDyn _ (Just pkgId) mdlName =
- Module.mkModule pkgId mdlName
-lookupModuleDyn dflags Nothing mdlName =
- case lookupModuleInAllPackages dflags mdlName of
- (m,_):_ -> m
- [] -> Module.mkModule Module.mainUnitId mdlName
+ all_names = availsToNameSetWithSelectors avails
+
+ -- Is everything in this (supposedly re-exported) module visible?
+ everythingVisible :: (Module, NameSet) -> Bool
+ everythingVisible (mdl, exps)
+ | not (exps `isSubsetOf` all_names) = False
+ | Just iface <- M.lookup mdl ifaceMap = OptHide `notElem` ifaceOptions iface
+ | otherwise = True
+
+ -- TODO: Add a utility based on IntMap.isSubmapOfBy
+ isSubsetOf :: NameSet -> NameSet -> Bool
+ isSubsetOf a b = nameSetAll (`elemNameSet` b) a
-------------------------------------------------------------------------------
-- Warnings
-------------------------------------------------------------------------------
-mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap
-mkWarningMap dflags warnings gre exps = case warnings of
+-- TODO: Either find a different way of looking up the OccNames or change the Warnings or
+-- WarningMap type.
+mkWarningMap :: Warnings (HsDoc Name) -> [Name] -> ErrMsgGhc WarningMap
+mkWarningMap warnings exps = case warnings of
NoWarnings -> pure M.empty
WarnAll _ -> pure M.empty
WarnSome ws ->
+ -- Not sure if this is equivalent to the original code below.
+ let expsOccEnv = mkOccEnv [(nameOccName n, n) | n <- exps]
+ ws' = flip mapMaybe ws $ \(occ, w) ->
+ (,w) <$> lookupOccEnv expsOccEnv occ
+ {-
let ws' = [ (n, w)
| (occ, w) <- ws
, elt <- lookupGlobalRdrEnv gre occ
, let n = gre_name elt, n `elem` exps ]
- in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws'
-
-moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
-moduleWarning _ _ NoWarnings = pure Nothing
-moduleWarning _ _ (WarnSome _) = pure Nothing
-moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w
-
-parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
-parseWarning dflags gre w = case w of
- DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (bytesFS . sl_fs . unLoc) msg)
- WarningTxt _ msg -> format "Warning: " (foldMap (bytesFS . sl_fs . unLoc) msg)
+ -}
+ in M.fromList <$> traverse (traverse parseWarning) ws'
+
+moduleWarning :: Warnings (HsDoc Name) -> ErrMsgGhc (Maybe (Doc Name))
+moduleWarning = \case
+ NoWarnings -> pure Nothing
+ WarnSome _ -> pure Nothing
+ WarnAll w -> Just <$> parseWarning w
+
+parseWarning :: WarningTxt (HsDoc Name) -> ErrMsgGhc (Doc Name)
+parseWarning w =
+ -- TODO: Find something more efficient than (foldl' appendHsDoc)
+ format heading (foldl' appendHsDoc emptyHsDoc msgs)
where
- format x bs = DocWarning . DocParagraph . DocAppend (DocString x)
- <$> processDocString dflags gre (mkHsDocStringUtf8ByteString bs)
+ format x msg = DocWarning . DocParagraph . DocAppend (DocString x)
+ <$> processDocString msg
+ heading = case sort_ of
+ WsWarning -> "Warning: "
+ WsDeprecated -> "Deprecated: "
+ (sort_, msgs) = warningTxtContents w
-------------------------------------------------------------------------------
@@ -325,447 +330,121 @@ mkDocOpts mbOpts flags mdl = do
go os m | m == Flag_HideModule mdlStr = OptHide : os
| m == Flag_ShowModule mdlStr = filter (/= OptHide) os
| m == Flag_ShowAllModules = filter (/= OptHide) os
- | m == Flag_IgnoreAllExports = OptIgnoreExports : os
- | m == Flag_ShowExtensions mdlStr = OptIgnoreExports : os
+ | m == Flag_ShowExtensions mdlStr = OptShowExtensions : os
| otherwise = os
parseOption :: String -> ErrMsgM (Maybe DocOption)
parseOption "hide" = return (Just OptHide)
parseOption "prune" = return (Just OptPrune)
-parseOption "ignore-exports" = return (Just OptIgnoreExports)
parseOption "not-home" = return (Just OptNotHome)
parseOption "show-extensions" = return (Just OptShowExtensions)
+parseOption "print-explicit-runtime-reps" = return (Just OptPrintRuntimeRep)
parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
-
---------------------------------------------------------------------------------
--- Maps
---------------------------------------------------------------------------------
-
-
-type Maps = (DocMap Name, ArgMap Name, DeclMap, InstMap)
-
--- | Create 'Maps' by looping through the declarations. For each declaration,
--- find its names, its subordinates, and its doc strings. Process doc strings
--- into 'Doc's.
-mkMaps :: DynFlags
- -> Maybe Package -- this package
- -> GlobalRdrEnv
- -> [Name]
- -> [(LHsDecl GhcRn, [HsDocString])]
- -> ErrMsgM Maps
-mkMaps dflags pkgName gre instances decls = do
- (a, b, c) <- unzip3 <$> traverse mappings decls
- pure ( f' (map (nubByName fst) a)
- , f (filterMapping (not . M.null) b)
- , f (filterMapping (not . null) c)
- , instanceMap
- )
- where
- f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
- f = M.fromListWith (<>) . concat
-
- f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
- f' = M.fromListWith metaDocAppend . concat
-
- filterMapping :: (b -> Bool) -> [[(a, b)]] -> [[(a, b)]]
- filterMapping p = map (filter (p . snd))
-
- mappings :: (LHsDecl GhcRn, [HsDocString])
- -> ErrMsgM ( [(Name, MDoc Name)]
- , [(Name, Map Int (MDoc Name))]
- , [(Name, [LHsDecl GhcRn])]
- )
- mappings (ldecl, docStrs) = do
- let L l decl = ldecl
- declDoc :: [HsDocString] -> Map Int HsDocString
- -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
- declDoc strs m = do
- doc' <- processDocStrings dflags pkgName gre strs
- m' <- traverse (processDocStringParas dflags pkgName gre) m
- pure (doc', m')
-
- (doc, args) <- declDoc docStrs (declTypeDocs decl)
-
- let
- subs :: [(Name, [HsDocString], Map Int HsDocString)]
- subs = subordinates instanceMap decl
-
- (subDocs, subArgs) <- unzip <$> traverse (\(_, strs, m) -> declDoc strs m) subs
-
- let
- ns = names l decl
- subNs = [ n | (n, _, _) <- subs ]
- dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ]
- am = [ (n, args) | n <- ns ] ++ zip subNs subArgs
- cm = [ (n, [ldecl]) | n <- ns ++ subNs ]
-
- seqList ns `seq`
- seqList subNs `seq`
- doc `seq`
- seqList subDocs `seq`
- seqList subArgs `seq`
- pure (dm, am, cm)
-
- instanceMap :: Map SrcSpan Name
- instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
-
- names :: SrcSpan -> HsDecl GhcRn -> [Name]
- names _ (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
- where loc = case d of
- -- The CoAx's loc is the whole line, but only for TFs. The
- -- workaround is to dig into the family instance declaration and
- -- get the identifier with the right location.
- TyFamInstD _ (TyFamInstDecl d') -> getLoc (feqn_tycon (hsib_body d'))
- _ -> getInstLoc d
- names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
- names _ decl = getMainDeclBinder decl
-
--- Note [2]:
-------------
--- 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
---------------------------------------------------------------------------------
-
-
--- | Get all subordinate declarations inside a declaration, and their docs.
--- A subordinate declaration is something like the associate type or data
--- family of a type class.
-subordinates :: InstMap
- -> HsDecl GhcRn
- -> [(Name, [HsDocString], Map Int HsDocString)]
-subordinates instMap decl = case decl of
- InstD _ (ClsInstD _ d) -> do
- DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
- FamEqn { feqn_tycon = L l _
- , feqn_rhs = defn }}} <- unLoc <$> cid_datafam_insts d
- [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn
-
- InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body = d })))
- -> dataSubs (feqn_rhs d)
- TyClD _ d | isClassDecl d -> classSubs d
- | isDataDecl d -> dataSubs (tcdDataDefn d)
- _ -> []
- where
- classSubs dd = [ (name, doc, declTypeDocs d) | (L _ d, doc) <- classDecls dd
- , name <- getMainDeclBinder d, not (isValD d)
- ]
- dataSubs :: HsDataDefn GhcRn -> [(Name, [HsDocString], Map Int HsDocString)]
- dataSubs dd = constrs ++ fields ++ derivs
- where
- cons = map unL $ (dd_cons dd)
- constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, conArgDocs c)
- | c <- cons, cname <- getConNames c ]
- fields = [ (extFieldOcc n, maybeToList $ fmap unL doc, M.empty)
- | RecCon flds <- map getConArgs cons
- , L _ (ConDeclField _ ns _ doc) <- (unLoc flds)
- , L _ n <- ns ]
- derivs = [ (instName, [unL doc], M.empty)
- | HsIB { hsib_body = L l (HsDocTy _ _ doc) }
- <- concatMap (unLoc . deriv_clause_tys . unLoc) $
- unLoc $ dd_derivs dd
- , Just instName <- [M.lookup l instMap] ]
-
--- | Extract constructor argument docs from inside constructor decls.
-conArgDocs :: ConDecl GhcRn -> Map Int HsDocString
-conArgDocs con = case getConArgs con of
- PrefixCon args -> go 0 (map unLoc args ++ ret)
- InfixCon arg1 arg2 -> go 0 ([unLoc arg1, unLoc arg2] ++ ret)
- RecCon _ -> go 1 ret
- where
- go n (HsDocTy _ _ (L _ ds) : tys) = M.insert n ds $ go (n+1) tys
- go n (HsBangTy _ _ (L _ (HsDocTy _ _ (L _ ds))) : tys) = M.insert n ds $ go (n+1) tys
- go n (_ : tys) = go (n+1) tys
- go _ [] = M.empty
-
- ret = case con of
- ConDeclGADT { con_res_ty = res_ty } -> [ unLoc res_ty ]
- _ -> []
-
--- | Extract function argument docs from inside top-level decls.
-declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
-declTypeDocs (SigD _ (TypeSig _ _ ty)) = typeDocs (unLoc (hsSigWcType ty))
-declTypeDocs (SigD _ (ClassOpSig _ _ _ ty)) = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (SigD _ (PatSynSig _ _ ty)) = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (ForD _ (ForeignImport _ _ ty _)) = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (TyClD _ (SynDecl { tcdRhs = ty })) = typeDocs (unLoc ty)
-declTypeDocs _ = M.empty
-
--- | Extract function argument docs from inside types.
-typeDocs :: HsType GhcRn -> Map Int HsDocString
-typeDocs = go 0
- where
- go n (HsForAllTy { hst_body = ty }) = go n (unLoc ty)
- go n (HsQualTy { hst_body = ty }) = go n (unLoc ty)
- go n (HsFunTy _ (L _ (HsDocTy _ _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
- go n (HsFunTy _ _ ty) = go (n+1) (unLoc ty)
- go n (HsDocTy _ _ (L _ doc)) = M.singleton n doc
- go _ _ = M.empty
-
--- | All the sub declarations of a class (that we handle), ordered by
--- source location, with documentation attached if it exists.
-classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
-classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
- where
- decls = docs ++ defs ++ sigs ++ ats
- docs = mkDecls tcdDocs (DocD noExt) class_
- defs = mkDecls (bagToList . tcdMeths) (ValD noExt) class_
- sigs = mkDecls tcdSigs (SigD noExt) class_
- ats = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_
-
-
--- | The top-level declarations of a module that we care about,
--- ordered by source location, with documentation attached if it exists.
-topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
-topDecls =
- filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
-
-- | Extract a map of fixity declarations only
-mkFixMap :: HsGroup GhcRn -> FixMap
-mkFixMap group_ = M.fromList [ (n,f)
- | L _ (FixitySig _ ns f) <- hs_fixds group_,
- L _ n <- ns ]
-
-
--- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
-ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
-ungroup group_ =
- mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt) group_ ++
- mkDecls hs_derivds (DerivD noExt) group_ ++
- mkDecls hs_defds (DefD noExt) group_ ++
- mkDecls hs_fords (ForD noExt) group_ ++
- mkDecls hs_docs (DocD noExt) group_ ++
- mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt) group_ ++
- mkDecls (typesigs . hs_valds) (SigD noExt) group_ ++
- mkDecls (valbinds . hs_valds) (ValD noExt) group_
+mkFixMap :: [Name] -> [(OccName, Fixity)] -> FixMap
+mkFixMap exps occFixs =
+ M.fromList $ flip mapMaybe occFixs $ \(occ, fix_) ->
+ (,fix_) <$> lookupOccEnv expsOccEnv occ
where
- typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs
- typesigs _ = error "expected ValBindsOut"
-
- valbinds (XValBindsLR (NValBinds binds _)) = concatMap bagToList . snd . unzip $ binds
- valbinds _ = error "expected ValBindsOut"
-
-
--- | Take a field of declarations from a data structure and create HsDecls
--- using the given constructor
-mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
-mkDecls field con struct = [ L loc (con decl) | L loc decl <- field struct ]
-
-
--- | Sort by source location
-sortByLoc :: [Located a] -> [Located a]
-sortByLoc = sortBy (comparing getLoc)
-
-
---------------------------------------------------------------------------------
--- Filtering of declarations
---
--- We filter out declarations that we don't intend to handle later.
---------------------------------------------------------------------------------
-
+ expsOccEnv = mkOccEnv (map (nameOccName &&& id) exps)
--- | Filter out declarations that we don't handle in Haddock
-filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
-filterDecls = filter (isHandled . unL . fst)
- where
- isHandled (ForD _ (ForeignImport {})) = 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
- isHandled (DocD {}) = True
- isHandled _ = False
-
--- | Go through all class declarations and filter their sub-declarations
-filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
-filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
- | x@(L loc d, doc) <- decls ]
- where
- filterClass (TyClD x c) =
- TyClD x $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }
- filterClass _ = error "expected TyClD"
-
-
---------------------------------------------------------------------------------
--- Collect docs
---
--- To be able to attach the right Haddock comment to the right declaration,
--- we sort the declarations by their SrcLoc and "collect" the docs for each
--- declaration.
---------------------------------------------------------------------------------
-
-
--- | Collect docs and attach them to the right declarations.
-collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
-collectDocs = go Nothing []
- where
- go Nothing _ [] = []
- go (Just prev) docs [] = finished prev docs []
- go prev docs (L _ (DocD _ (DocCommentNext str)) : ds)
- | Nothing <- prev = go Nothing (str:docs) ds
- | Just decl <- prev = finished decl docs (go Nothing [str] ds)
- go prev docs (L _ (DocD _ (DocCommentPrev str)) : ds) = go prev (str:docs) ds
- go Nothing docs (d:ds) = go (Just d) docs ds
- go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
-
- finished decl docs rest = (decl, reverse docs) : rest
-
-
--- | Build the list of items that will become the documentation, from the
--- export list. At this point, the list of ExportItems is in terms of
--- original names.
---
--- We create the export items even if the module is hidden, since they
--- might be useful when creating the export items for other modules.
mkExportItems
- :: Bool -- is it a signature
+ :: PrintRuntimeReps
-> IfaceMap
-> Maybe Package -- this package
-> Module -- this module
- -> Module -- semantic module
-> WarningMap
- -> GlobalRdrEnv
- -> [Name] -- exported names (orig)
- -> [LHsDecl GhcRn] -- renamed source declarations
- -> Maps
+ -> DocMap Name -- docs (keyed by 'Name's)
+ -> ArgMap Name -- docs for arguments (keyed by 'Name's)
-> FixMap
- -> M.Map ModuleName [ModuleName]
-> [SrcSpan] -- splice locations
- -> Maybe [(IE GhcRn, Avails)]
- -> Avails -- exported stuff from this module
+ -> Map String (HsDoc Name) -- named chunks
+ -> DocStructure
-> InstIfaceMap
- -> DynFlags
-> ErrMsgGhc [ExportItem GhcRn]
mkExportItems
- is_sig modMap pkgName thisMod semMod warnings gre exportedNames decls
- maps fixMap unrestricted_imp_mods splices exportList allExports
- instIfaceMap dflags =
- case exportList of
- Nothing ->
- fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre
- exportedNames decls maps fixMap splices instIfaceMap dflags
- allExports
- Just exports -> liftM concat $ mapM lookupExport exports
+ prr modMap mbPkgName thisMod warnings
+ docMap argMap fixMap splices namedChunks dsItems instIfaceMap =
+ concat <$> traverse lookupExport dsItems
where
- lookupExport (IEGroup _ lev docStr, _) = liftErrMsg $ do
- doc <- processDocString dflags gre docStr
- return [ExportGroup lev "" doc]
-
- lookupExport (IEDoc _ docStr, _) = liftErrMsg $ do
- doc <- processDocStringParas dflags pkgName gre docStr
- return [ExportDoc doc]
-
- lookupExport (IEDocNamed _ str, _) = liftErrMsg $
- findNamedDoc str [ unL d | d <- decls ] >>= \case
- Nothing -> return []
- Just docStr -> do
- doc <- processDocStringParas dflags pkgName gre docStr
- return [ExportDoc doc]
-
- lookupExport (IEModuleContents _ (L _ mod_name), _)
- -- only consider exporting a module if we are sure we
- -- are really exporting the whole module and not some
- -- subset. We also look through module aliases here.
- | Just mods <- M.lookup mod_name unrestricted_imp_mods
- , not (null mods)
- = concat <$> traverse (moduleExport thisMod dflags modMap instIfaceMap) mods
-
- lookupExport (_, avails) =
- concat <$> traverse availExport (nubAvails avails)
+ lookupExport :: DocStructureItem -> ErrMsgGhc [ExportItem GhcRn]
+ lookupExport = \case
+ DsiSectionHeading lev hsDoc' -> do
+ doc <- processDocString hsDoc'
+ pure [ExportGroup lev "" doc]
+ DsiDocChunk hsDoc' -> do
+ doc <- processDocStringParas mbPkgName hsDoc'
+ pure [ExportDoc doc]
+ DsiNamedChunkRef ref -> do
+ case M.lookup ref namedChunks of
+ Nothing -> do
+ liftErrMsg $ tell ["Cannot find documentation for: $" ++ ref]
+ pure []
+ Just hsDoc' -> do
+ doc <- processDocStringParas mbPkgName hsDoc'
+ pure [ExportDoc doc]
+ DsiExports avails ->
+ -- TODO: We probably don't need nubAvails here.
+ -- mkDocStructureFromExportList already uses it.
+ concat <$> traverse availExport (nubAvails avails)
+ DsiModExport mod_names avails -> do
+ -- only consider exporting a module if we are sure we are really
+ -- exporting the whole module and not some subset.
+ (unrestricted_mods, remaining_avails) <- unrestrictedModExports modMap avails (NE.toList mod_names)
+ avail_exps <- concat <$> traverse availExport remaining_avails
+ pure (map ExportModule unrestricted_mods ++ avail_exps)
availExport avail =
- availExportItem is_sig modMap thisMod semMod warnings exportedNames
- maps fixMap splices instIfaceMap dflags avail
+ availExportItem prr modMap thisMod warnings
+ docMap argMap fixMap splices instIfaceMap avail
-availExportItem :: Bool -- is it a signature
+availExportItem :: PrintRuntimeReps
-> IfaceMap
-> Module -- this module
- -> Module -- semantic module
-> WarningMap
- -> [Name] -- exported names (orig)
- -> Maps
+ -> DocMap Name -- docs (keyed by 'Name's)
+ -> ArgMap Name -- docs for arguments (keyed by 'Name's)
-> FixMap
-> [SrcSpan] -- splice locations
-> InstIfaceMap
- -> DynFlags
-> AvailInfo
-> ErrMsgGhc [ExportItem GhcRn]
-availExportItem is_sig modMap thisMod semMod warnings exportedNames
- (docMap, argMap, declMap, _) fixMap splices instIfaceMap
- dflags availInfo = declWith availInfo
+availExportItem prr modMap thisMod warnings
+ docMap argMap fixMap splices instIfaceMap
+ availInfo = declWith availInfo
where
declWith :: AvailInfo -> ErrMsgGhc [ ExportItem GhcRn ]
declWith avail = do
- let t = availName avail
- r <- findDecl avail
- case r of
- ([L l (ValD _ _)], (doc, _)) -> do
- -- Top-level binding without type signature
- export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap
- return [export]
- (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->
- let declNames = getMainDeclBinder (unL decl)
- in case () of
- _
- -- We should not show a subordinate by itself if any of its
- -- parents is also exported. See note [1].
- | t `notElem` declNames,
- Just p <- find isExported (parents t $ unL decl) ->
- do liftErrMsg $ tell [
- "Warning: " ++ moduleString thisMod ++ ": " ++
- pretty dflags (nameOccName t) ++ " is exported separately but " ++
- "will be documented under " ++ pretty dflags (nameOccName p) ++
- ". Consider exporting it together with its parent(s)" ++
- " for code clarity." ]
- return []
-
- -- normal case
- | otherwise -> case decl of
- -- A single signature might refer to many names, but we
- -- create an export item for a single name only. So we
- -- modify the signature to contain only that single name.
- L loc (SigD _ sig) ->
- -- fromJust is safe since we already checked in guards
- -- that 't' is a name declared in this declaration.
- let newDecl = L loc . SigD noExt . fromJust $ filterSigNames (== t) sig
- in availExportDecl avail newDecl docs_
-
- L loc (TyClD _ cl@ClassDecl{}) -> do
- mdef <- liftGhcToErrMsgGhc $ minimalDef t
- let sig = maybeToList $ fmap (noLoc . MinimalSig noExt NoSourceText . noLoc . fmap noLoc) mdef
- availExportDecl avail
- (L loc $ TyClD noExt cl { tcdSigs = sig ++ tcdSigs cl }) docs_
-
- _ -> availExportDecl avail decl docs_
-
- -- Declaration from another package
- ([], _) -> do
- mayDecl <- hiDecl dflags t
- case mayDecl of
- Nothing -> return [ ExportNoDecl t [] ]
- Just decl ->
- -- We try to get the subs and docs
- -- from the installed .haddock file for that package.
- -- TODO: This needs to be more sophisticated to deal
- -- with signature inheritance
- case M.lookup (nameModule t) instIfaceMap of
- Nothing -> do
- liftErrMsg $ tell
- ["Warning: Couldn't find .haddock for export " ++ pretty dflags t]
- let subs_ = availNoDocs avail
- availExportDecl avail decl (noDocForDecl, subs_)
+ dflags <- getDynFlags
+ let t = availName avail -- NB: 't' might not be in the scope of 'avail'.
+ -- Example: @data C = D@, where C isn't exported.
+ mayDecl <- hiDecl prr t
+ case mayDecl of
+ Nothing -> return [ ExportNoDecl t [] ]
+ Just decl -> do
+ docs_ <- do
+ let tmod = nameModule t
+ if tmod == thisMod
+ then pure (lookupDocs avail warnings docMap argMap)
+ else case M.lookup tmod modMap of
Just iface ->
- availExportDecl avail decl (lookupDocs avail warnings (instDocMap iface) (instArgMap iface))
-
- _ -> return []
+ pure (lookupDocs avail warnings (ifaceDocMap iface) (ifaceArgMap iface))
+ Nothing ->
+ -- We try to get the subs and docs
+ -- from the installed .haddock file for that package.
+ -- TODO: This needs to be more sophisticated to deal
+ -- with signature inheritance
+ case M.lookup (nameModule t) instIfaceMap of
+ Nothing -> do
+ liftErrMsg $ tell
+ ["Warning: " ++ pretty dflags thisMod ++
+ ": Couldn't find .haddock for export " ++ pretty dflags t]
+ let subs_ = availNoDocs avail
+ pure (noDocForDecl, subs_)
+ Just instIface ->
+ pure (lookupDocs avail warnings (instDocMap instIface) (instArgMap instIface))
+ availExportDecl avail decl docs_
availExportDecl :: AvailInfo -> LHsDecl GhcRn
-> (DocForDecl Name, [(Name, DocForDecl Name)])
@@ -786,9 +465,10 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
, Just f <- [M.lookup n fixMap]
]
+ extracted <- extractDecl prr (availName avail) decl
+
return [ ExportDecl {
- expItemDecl = restrictTo (fmap fst subs)
- (extractDecl declMap (availName avail) decl)
+ expItemDecl = restrictTo (fmap fst subs) extracted
, expItemPats = bundledPatSyns
, expItemMbDoc = doc
, expItemSubDocs = subs
@@ -799,49 +479,18 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
]
| otherwise =
- return [ ExportDecl {
- expItemDecl = extractDecl declMap sub decl
- , expItemPats = []
- , expItemMbDoc = sub_doc
- , expItemSubDocs = []
- , expItemInstances = []
- , expItemFixities = [ (sub, f) | Just f <- [M.lookup sub fixMap] ]
- , expItemSpliced = False
- }
- | (sub, sub_doc) <- subs
- ]
-
- exportedNameSet = mkNameSet exportedNames
- isExported n = elemNameSet n exportedNameSet
-
- findDecl :: AvailInfo -> ErrMsgGhc ([LHsDecl GhcRn], (DocForDecl Name, [(Name, DocForDecl Name)]))
- findDecl avail
- | m == semMod =
- case M.lookup n declMap of
- Just ds -> return (ds, lookupDocs avail warnings docMap argMap)
- Nothing
- | is_sig -> do
- -- OK, so it wasn't in the local declaration map. It could
- -- have been inherited from a signature. Reconstitute it
- -- from the type.
- mb_r <- hiDecl dflags n
- case mb_r of
- Nothing -> return ([], (noDocForDecl, availNoDocs avail))
- -- TODO: If we try harder, we might be able to find
- -- a Haddock! Look in the Haddocks for each thing in
- -- requirementContext (pkgState)
- Just decl -> return ([decl], (noDocForDecl, availNoDocs avail))
- | otherwise ->
- return ([], (noDocForDecl, availNoDocs avail))
- | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap
- , Just ds <- M.lookup n (ifaceDeclMap iface) =
- return (ds, lookupDocs avail warnings
- (ifaceDocMap iface)
- (ifaceArgMap iface))
- | otherwise = return ([], (noDocForDecl, availNoDocs avail))
- where
- n = availName avail
- m = nameModule n
+ let extractSub (sub, sub_doc) = do
+ extracted <- extractDecl prr sub decl
+ pure (ExportDecl {
+ expItemDecl = extracted
+ , expItemPats = []
+ , expItemMbDoc = sub_doc
+ , expItemSubDocs = []
+ , expItemInstances = []
+ , expItemFixities = [ (sub, f) | Just f <- [M.lookup sub fixMap] ]
+ , expItemSpliced = False
+ })
+ in traverse extractSub subs
findBundledPatterns :: AvailInfo -> ErrMsgGhc [(HsDecl GhcRn, DocForDecl Name)]
findBundledPatterns avail = do
@@ -877,21 +526,16 @@ availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)]
availNoDocs avail =
zip (availSubordinates avail) (repeat noDocForDecl)
--- | Given a 'Module' from a 'Name', convert it into a 'Module' that
--- we can actually find in the 'IfaceMap'.
-semToIdMod :: UnitId -> Module -> Module
-semToIdMod this_uid m
- | Module.isHoleModule m = mkModule this_uid (moduleName m)
- | otherwise = m
-
-hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))
-hiDecl dflags t = do
+hiDecl :: PrintRuntimeReps -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))
+hiDecl prr t = do
+ dflags <- getDynFlags
mayTyThing <- liftGhcToErrMsgGhc $ lookupName t
+ let bugWarn = O.showSDoc dflags . warnLine
case mayTyThing of
Nothing -> do
liftErrMsg $ tell ["Warning: Not found in environment: " ++ pretty dflags t]
return Nothing
- Just x -> case tyThingToLHsDecl ShowRuntimeRep x of
+ Just x -> case tyThingToLHsDecl prr x of
Left m -> liftErrMsg (tell [bugWarn m]) >> return Nothing
Right (m, t') -> liftErrMsg (tell $ map bugWarn m)
>> return (Just $ noLoc t')
@@ -899,141 +543,31 @@ hiDecl dflags t = do
warnLine x = O.text "haddock-bug:" O.<+> O.text x O.<>
O.comma O.<+> O.quotes (O.ppr t) O.<+>
O.text "-- Please report this on Haddock issue tracker!"
- bugWarn = O.showSDoc dflags . warnLine
-
--- | This function is called for top-level bindings without type signatures.
--- It gets the type signature from GHC and that means it's not going to
--- have a meaningful 'SrcSpan'. So we pass down 'SrcSpan' for the
--- declaration and use it instead - 'nLoc' here.
-hiValExportItem :: DynFlags -> Name -> SrcSpan -> DocForDecl Name -> Bool
- -> Maybe Fixity -> ErrMsgGhc (ExportItem GhcRn)
-hiValExportItem dflags name nLoc doc splice fixity = do
- mayDecl <- hiDecl dflags name
- case mayDecl of
- Nothing -> return (ExportNoDecl name [])
- Just decl -> return (ExportDecl (fixSpan decl) [] doc [] [] fixities splice)
- where
- fixSpan (L l t) = L (SrcLoc.combineSrcSpans l nLoc) t
- fixities = case fixity of
- Just f -> [(name, f)]
- Nothing -> []
-
-- | Lookup docs for a declaration from maps.
lookupDocs :: AvailInfo -> WarningMap -> DocMap Name -> ArgMap Name
-> (DocForDecl Name, [(Name, DocForDecl Name)])
lookupDocs avail warnings docMap argMap =
- let n = availName avail in
- let lookupArgDoc x = M.findWithDefault M.empty x argMap in
- let doc = (lookupDoc n, lookupArgDoc n) in
- let subDocs = [ (s, (lookupDoc s, lookupArgDoc s))
- | s <- availSubordinates avail
- ] in
- (doc, subDocs)
- where
- lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)
-
-
--- | Export the given module as `ExportModule`. We are not concerned with the
--- single export items of the given module.
-moduleExport :: Module -- ^ Module A (identity, NOT semantic)
- -> DynFlags -- ^ The flags used when typechecking A
- -> IfaceMap -- ^ Already created interfaces
- -> InstIfaceMap -- ^ Interfaces in other packages
- -> ModuleName -- ^ The exported module
- -> ErrMsgGhc [ExportItem GhcRn] -- ^ Resulting export items
-moduleExport thisMod dflags ifaceMap instIfaceMap expMod =
- -- NB: we constructed the identity module when looking up in
- -- the IfaceMap.
- case M.lookup m ifaceMap of
- Just iface
- | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface)
- | otherwise -> return [ ExportModule m ]
-
- Nothing -> -- We have to try to find it in the installed interfaces
- -- (external packages).
- case M.lookup expMod (M.mapKeys moduleName instIfaceMap) of
- Just iface -> return [ ExportModule (instMod iface) ]
- Nothing -> do
- liftErrMsg $
- tell ["Warning: " ++ pretty dflags thisMod ++ ": Could not find " ++
- "documentation for exported module: " ++ pretty dflags expMod]
- return []
+ ( lookupDocForDecl (availName avail)
+ , [ (s, lookupDocForDecl s) | s <- availSubordinates avail ]
+ )
where
- m = mkModule unitId expMod -- Identity module!
- unitId = moduleUnitId thisMod
-
--- Note [1]:
-------------
--- It is unnecessary to document a subordinate by itself at the top level if
--- any of its parents is also documented. Furthermore, if the subordinate is a
--- record field or a class method, documenting it under its parent
--- indicates its special status.
---
--- A user might expect that it should show up separately, so we issue a
--- warning. It's a fine opportunity to also tell the user she might want to
--- export the subordinate through the parent export item for clarity.
---
--- The code removes top-level subordinates also when the parent is exported
--- through a 'module' export. I think that is fine.
---
--- (For more information, see Trac #69)
-
-
--- | Simplified variant of 'mkExportItems', where we can assume that
--- every locally defined declaration is exported; thus, we just
--- zip through the renamed declarations.
-
-fullModuleContents :: Bool -- is it a signature
- -> IfaceMap
- -> Maybe Package -- this package
- -> Module -- this module
- -> Module -- semantic module
- -> WarningMap
- -> GlobalRdrEnv -- ^ The renaming environment
- -> [Name] -- exported names (orig)
- -> [LHsDecl GhcRn] -- renamed source declarations
- -> Maps
- -> FixMap
- -> [SrcSpan] -- splice locations
- -> InstIfaceMap
- -> DynFlags
- -> Avails
- -> ErrMsgGhc [ExportItem GhcRn]
-fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNames
- decls maps@(_, _, declMap, _) fixMap splices instIfaceMap dflags avails = do
- let availEnv = availsToNameEnv (nubAvails avails)
- (concat . concat) `fmap` (for decls $ \decl -> do
- case decl of
- (L _ (DocD _ (DocGroup lev docStr))) -> do
- doc <- liftErrMsg (processDocString dflags gre docStr)
- return [[ExportGroup lev "" doc]]
- (L _ (DocD _ (DocCommentNamed _ docStr))) -> do
- doc <- liftErrMsg (processDocStringParas dflags pkgName gre docStr)
- return [[ExportDoc doc]]
- (L _ (ValD _ valDecl))
- | name:_ <- collectHsBindBinders valDecl
- , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap
- -> return []
- _ ->
- for (getMainDeclBinder (unLoc decl)) $ \nm -> do
- case lookupNameEnv availEnv nm of
- Just avail ->
- availExportItem is_sig modMap thisMod
- semMod warnings exportedNames maps fixMap
- splices instIfaceMap dflags avail
- Nothing -> pure [])
- where
- isSigD (L _ SigD{}) = True
- isSigD _ = False
+ lookupDoc x = Documentation (M.lookup x docMap) (M.lookup x warnings)
+ lookupArgDoc x = M.findWithDefault M.empty x argMap
+ lookupDocForDecl x = (lookupDoc x, lookupArgDoc x)
+
-- | 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
-- cases we have to extract the required declaration (and somehow cobble
-- together a type signature for it...).
-extractDecl :: DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn
-extractDecl declMap name decl
- | name `elem` getMainDeclBinder (unLoc decl) = decl
+extractDecl
+ :: PrintRuntimeReps -- ^ should we print 'RuntimeRep' tyvars?
+ -> Name -- ^ name of subdecl to extract
+ -> LHsDecl GhcRn -- ^ parent decl
+ -> ErrMsgGhc (LHsDecl GhcRn) -- ^ extracted subdecl
+extractDecl prr name decl
+ | name `elem` getMainDeclBinder (unLoc decl) = pure decl
| otherwise =
case unLoc decl of
TyClD _ d@ClassDecl {} ->
@@ -1056,29 +590,34 @@ extractDecl declMap name decl
in case (matchesMethod, matchesAssociatedType) of
([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)
L pos sig = addClassContext n tyvar_names s0
- in L pos (SigD noExt sig)
- (_, [L pos fam_decl]) -> L pos (TyClD noExt (FamDecl noExt fam_decl))
-
- ([], [])
- | Just (famInstDecl:_) <- M.lookup name declMap
- -> extractDecl declMap name famInstDecl
+ in pure (L pos (SigD noExt sig))
+ (_, [L pos fam_decl]) -> pure (L pos (TyClD noExt (FamDecl noExt fam_decl)))
+
+ ([], []) -> do
+ famInstDeclOpt <- hiDecl prr name
+ case famInstDeclOpt of
+ Nothing -> O.pprPanic "extractDecl" (O.text "Failed to find decl for" O.<+> O.ppr name)
+ Just famInstDecl -> extractDecl prr name famInstDecl
_ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
O.$$ O.nest 4 (O.ppr d)
O.$$ O.text "Matches:"
O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType))
- TyClD _ d@DataDecl {} ->
+ TyClD _ d@DataDecl {} -> pure $
let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
in if isDataConName name
then SigD noExt <$> extractPatternSyn name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d))
else SigD noExt <$> extractRecSel name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d))
TyClD _ FamDecl {}
| isValName name
- , Just (famInst:_) <- M.lookup name declMap
- -> extractDecl declMap name famInst
+ -> do
+ famInstOpt <- hiDecl prr name
+ case famInstOpt of
+ Nothing -> O.pprPanic "extractDecl" (O.text "Failed to find decl for" O.<+> O.ppr name)
+ Just famInst -> extractDecl prr name famInst
InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body =
FamEqn { feqn_tycon = L _ n
, feqn_pats = tys
- , feqn_rhs = defn }}))) ->
+ , feqn_rhs = defn }}))) -> pure $
if isDataConName name
then SigD noExt <$> extractPatternSyn name n tys (dd_cons defn)
else SigD noExt <$> extractRecSel name n tys (dd_cons defn)
@@ -1091,7 +630,7 @@ extractDecl declMap name decl
, name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))
]
in case matches of
- [d0] -> extractDecl declMap name (noLoc (InstD noExt (DataFamInstD noExt d0)))
+ [d0] -> extractDecl prr name (noLoc (InstD noExt (DataFamInstD noExt d0)))
_ -> error "internal: extractDecl (ClsInstD)"
| otherwise ->
let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
@@ -1103,7 +642,7 @@ extractDecl declMap name decl
, extFieldOcc n == name
]
in case matches of
- [d0] -> extractDecl declMap name (noLoc . InstD noExt $ DataFamInstD noExt d0)
+ [d0] -> extractDecl prr name (noLoc . InstD noExt $ DataFamInstD noExt d0)
_ -> error "internal: extractDecl (ClsInstD)"
_ -> O.pprPanic "extractDecl" $
O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":"
@@ -1173,8 +712,8 @@ pruneExportItems = filter hasDoc
hasDoc _ = True
-mkVisibleNames :: Maps -> [ExportItem GhcRn] -> [DocOption] -> [Name]
-mkVisibleNames (_, _, _, instMap) exports opts
+mkVisibleNames :: InstMap -> [ExportItem GhcRn] -> [DocOption] -> [Name]
+mkVisibleNames instMap exports opts
| OptHide `elem` opts = []
| otherwise = let ns = concatMap exportName exports
in seqList ns `seq` ns
@@ -1192,15 +731,3 @@ mkVisibleNames (_, _, _, instMap) exports opts
seqList :: [a] -> ()
seqList [] = ()
seqList (x : xs) = x `seq` seqList xs
-
--- | Find a stand-alone documentation comment by its name.
-findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString)
-findNamedDoc name = search
- where
- search [] = do
- tell ["Cannot find documentation for: $" ++ name]
- return Nothing
- search (DocD _ (DocCommentNamed name' doc) : rest)
- | name == name' = return (Just doc)
- | otherwise = search rest
- search (_other_decl : rest) = search rest
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 59ad4fdfdb..dab82060b7 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -15,7 +15,6 @@
module Haddock.Interface.LexParseRn
( processDocString
, processDocStringParas
- , processDocStrings
, processModuleHeader
) where
@@ -24,8 +23,9 @@ import Control.Arrow
import Control.Monad
import Data.List
import Data.Ord
-import Documentation.Haddock.Doc (metaDocConcat)
-import DynFlags (languageExtensions)
+import qualified Data.Map as Map
+import qualified Documentation.Haddock.Parser as LibParser
+import DynFlags (getDynFlags, languageExtensions, Language)
import qualified GHC.LanguageExtensions as LangExt
import GHC
import Haddock.Interface.ParseModuleHeader
@@ -35,48 +35,46 @@ import Name
import Outputable ( showPpr, showSDoc )
import RdrName
import EnumSet
-import RnEnv (dataTcOccs)
-
-processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]
- -> ErrMsgM (Maybe (MDoc Name))
-processDocStrings dflags pkg gre strs = do
- mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags pkg gre) strs
- case mdoc of
- -- We check that we don't have any version info to render instead
- -- of just checking if there is no comment: there may not be a
- -- comment but we still want to pass through any meta data.
- MetaDoc { _meta = Meta Nothing Nothing, _doc = DocEmpty } -> pure Nothing
- x -> pure (Just x)
-
-processDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name)
-processDocStringParas dflags pkg gre hds =
- overDocF (rename dflags gre) $ parseParas dflags pkg (unpackHDS hds)
-
-processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
-processDocString dflags gre hds =
- rename dflags gre $ parseString dflags (unpackHDS hds)
-
-processModuleHeader :: DynFlags -> Maybe Package -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
- -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
-processModuleHeader dflags pkgName gre safety mayStr = do
+
+processDocStringParas :: Maybe Package -> (HsDoc Name) -> ErrMsgGhc (MDoc Name)
+processDocStringParas pkg hsDoc = do
+ let mdoc = LibParser.parseParas pkg (unpackHDS (hsDocString hsDoc))
+ overDocF (rename (hsDocRenamer hsDoc)) mdoc
+
+processDocString :: HsDoc Name -> ErrMsgGhc (Doc Name)
+processDocString hsDoc = do
+ let doc = LibParser.parseString (unpackHDS (hsDocString hsDoc))
+ rename (hsDocRenamer hsDoc) doc
+
+processModuleHeader :: Maybe Package -> SafeHaskellMode
+ -> Maybe Language -> EnumSet LangExt.Extension
+ -> Maybe (HsDoc Name)
+ -> ErrMsgGhc (HaddockModInfo Name, Maybe (MDoc Name))
+processModuleHeader pkgName safety mayLang extSet mayStr = do
(hmi, doc) <-
case mayStr of
Nothing -> return failure
- Just (L _ hds) -> do
- let str = unpackHDS hds
- (hmi, doc) = parseModuleHeader dflags pkgName str
+ Just hsDoc -> do
+ let str = unpackHDS (hsDocString hsDoc)
+ (hmi, doc) = parseModuleHeader pkgName str
+ renamer = hsDocRenamer hsDoc
!descr <- case hmi_description hmi of
- Just hmi_descr -> Just <$> rename dflags gre hmi_descr
+ Just hmi_descr -> Just <$> rename renamer hmi_descr
Nothing -> pure Nothing
let hmi' = hmi { hmi_description = descr }
- doc' <- overDocF (rename dflags gre) doc
+ doc' <- overDocF (rename renamer) doc
return (hmi', Just doc')
+
let flags :: [LangExt.Extension]
- -- We remove the flags implied by the language setting and we display the language instead
- flags = EnumSet.toList (extensionFlags dflags) \\ languageExtensions (language dflags)
+ -- We remove the flags implied by the language setting and we display the
+ -- language instead.
+ -- NB: 'hmi_extensions' cannot reflect that some extensions included in
+ -- 'mayLang' may have been disabled.
+ flags = EnumSet.toList extSet \\ languageExtensions mayLang
+ dflags <- getDynFlags
return (hmi { hmi_safety = Just $ showPpr dflags safety
- , hmi_language = language dflags
+ , hmi_language = mayLang
, hmi_extensions = flags
} , doc)
where
@@ -89,41 +87,32 @@ processModuleHeader dflags pkgName gre safety mayStr = do
-- fallbacks in case we can't locate the identifiers.
--
-- See the comments in the source for implementation commentary.
-rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name)
-rename dflags gre = rn
+rename :: Renamer -> Doc LibParser.Identifier -> ErrMsgGhc (Doc Name)
+rename renamer = rn
where
rn d = case d of
DocAppend a b -> DocAppend <$> rn a <*> rn b
DocParagraph doc -> DocParagraph <$> rn doc
- DocIdentifier x -> do
- -- Generate the choices for the possible kind of thing this
- -- is.
- let choices = dataTcOccs x
-
- -- Lookup any GlobalRdrElts that match the choices.
- case concatMap (\c -> lookupGRE_RdrName c gre) choices of
- -- We found no names in the env so we start guessing.
- [] ->
- case choices of
- -- This shouldn't happen as 'dataTcOccs' always returns at least its input.
- [] -> pure (DocMonospaced (DocString (showPpr dflags x)))
-
- -- There was nothing in the environment so we need to
- -- pick some default from what's available to us. We
- -- diverge here from the old way where we would default
- -- to type constructors as we're much more likely to
- -- actually want anchors to regular definitions than
- -- type constructor names (such as in #253). So now we
- -- only get type constructor links if they are actually
- -- in scope.
- a:_ -> outOfScope dflags a
+ DocIdentifier id_@(_, x, _) -> do
+ case renamer x of
+ Nothing -> invalid id_
+
+ -- There was nothing in the environment so we need to
+ -- pick some default from what's available to us. We
+ -- diverge here from the old way where we would default
+ -- to type constructors as we're much more likely to
+ -- actually want anchors to regular definitions than
+ -- type constructor names (such as in #253). So now we
+ -- only get type constructor links if they are actually
+ -- in scope.
+ Just [] -> outOfScope x
-- There is only one name in the environment that matches so
-- use it.
- [a] -> pure (DocIdentifier (gre_name a))
+ Just [a] -> pure (DocIdentifier a)
-- There are multiple names available.
- gres -> ambiguous dflags x gres
+ Just names -> ambiguous id_ names
DocWarning doc -> DocWarning <$> rn doc
DocEmphasis doc -> DocEmphasis <$> rn doc
@@ -147,6 +136,10 @@ rename dflags gre = rn
DocHeader (Header l t) -> DocHeader . Header l <$> rn t
DocTable t -> DocTable <$> traverse rn t
+-- | TODO: We could emit a warning here.
+invalid :: LibParser.Identifier -> ErrMsgGhc (Doc a)
+invalid (o, x, e) = pure (DocString $ o : x ++ [e])
+
-- | Wrap an identifier that's out of scope (i.e. wasn't found in
-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
-- we simply monospace the identifier in most cases except when the
@@ -155,46 +148,54 @@ rename dflags gre = rn
-- users shouldn't rely on this doing the right thing. See tickets
-- #253 and #375 on the confusion this causes depending on which
-- default we pick in 'rename'.
-outOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a)
-outOfScope dflags x =
- case x of
- Unqual occ -> warnAndMonospace occ
- Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ))
- Orig _ occ -> warnAndMonospace occ
- Exact name -> warnAndMonospace name -- Shouldn't happen since x is out of scope
- where
- warnAndMonospace a = do
- tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++
- " If you qualify the identifier, haddock can try to link it anyway."]
- pure (monospaced a)
- monospaced a = DocMonospaced (DocString (showPpr dflags a))
+outOfScope :: String -> ErrMsgGhc (Doc a)
+outOfScope x = do
+ dflags <- getDynFlags
+ let warnAndMonospace a = do
+ liftErrMsg $
+ tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope.\n" ++
+ " If you qualify the identifier, haddock can try to link it anyway."]
+ pure (monospaced a)
+ monospaced a = DocMonospaced (DocString (showPpr dflags a))
+
+ -- Using our local dflags isn't quite correct – ideally we'd use those GHC used when
+ -- compiling the module
+ case parseIdent dflags x of
+ Nothing -> invalid ('\'', x, '\'') -- Shouldn't happen
+ Just (rdr_name) -> case rdr_name of
+ Unqual occ -> warnAndMonospace occ
+ Qual mdl occ -> pure (DocIdentifierUnchecked (mdl, occ))
+ Orig _ occ -> warnAndMonospace occ
+ Exact name -> warnAndMonospace name -- Shouldn't happen since x is out of scope
-- | Handle ambiguous identifiers.
--
-- Prefers local names primarily and type constructors or class names secondarily.
--
-- Emits a warning if the 'GlobalRdrElts's don't belong to the same type or class.
-ambiguous :: DynFlags
- -> RdrName
- -> [GlobalRdrElt] -- ^ More than one @gre@s sharing the same `RdrName` above.
- -> ErrMsgM (Doc Name)
-ambiguous dflags x gres = do
- let noChildren = map availName (gresToAvailInfo gres)
+ambiguous :: LibParser.Identifier
+ -> [Name] -- ^ More than one 'Name's that the 'Identifier' may be intended
+ -- to reference.
+ -> ErrMsgGhc (Doc Name)
+ambiguous (o, x, e) names = do
+ dflags <- getDynFlags
+ let noChildren = map availName (nubAvails (map avail names))
dflt = maximumBy (comparing (isLocalName &&& isTyConName)) noChildren
- msg = "Warning: " ++ x_str ++ " is ambiguous. It is defined\n" ++
- concatMap (\n -> " * " ++ defnLoc n ++ "\n") (map gre_name gres) ++
+ dflt_str = '\'' : showPpr dflags dflt ++ "'"
+ id_str = o : x ++ (e : [])
+ defnLoc = showSDoc dflags . pprNameDefnLoc
+ msg = "Warning: " ++ id_str ++ " is ambiguous. It is defined\n" ++
+ concatMap (\n -> " * " ++ defnLoc n ++ "\n") names ++
" You may be able to disambiguate the identifier by qualifying it or\n" ++
" by hiding some imports.\n" ++
- " Defaulting to " ++ x_str ++ " defined " ++ defnLoc dflt
- -- TODO: Once we have a syntax for namespace qualification (#667) we may also
- -- want to emit a warning when an identifier is a data constructor for a type
- -- of the same name, but not the only constructor.
- -- For example, for @data D = C | D@, someone may want to reference the @D@
- -- constructor.
- when (length noChildren > 1) $ tell [msg]
+ " Defaulting to " ++ dflt_str ++ " defined " ++ defnLoc dflt
+ when (length noChildren > 1) $ liftErrMsg $ tell [msg]
pure (DocIdentifier dflt)
where
isLocalName (nameSrcLoc -> RealSrcLoc {}) = True
isLocalName _ = False
- x_str = '\'' : showPpr dflags x ++ "'"
- defnLoc = showSDoc dflags . pprNameDefnLoc
+
+hsDocRenamer :: HsDoc Name -> Renamer
+hsDocRenamer hsDoc = \s -> Map.lookup s env
+ where
+ env = Map.mapKeysMonotonic unpackHDS (hsDocIdEnv hsDoc)
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index 050901b6e3..30d7800059 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -11,12 +11,10 @@
-----------------------------------------------------------------------------
module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where
+import qualified Documentation.Haddock.Parser as P
import Control.Monad (mplus)
import Data.Char
-import DynFlags
-import Haddock.Parser
import Haddock.Types
-import RdrName
-- -----------------------------------------------------------------------------
-- Parsing module headers
@@ -24,8 +22,8 @@ import RdrName
-- NB. The headers must be given in the order Module, Description,
-- Copyright, License, Maintainer, Stability, Portability, except that
-- any or all may be omitted.
-parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName)
-parseModuleHeader dflags pkgName str0 =
+parseModuleHeader :: Maybe Package -> String -> (HaddockModInfo P.Identifier, MDoc P.Identifier)
+parseModuleHeader pkgName str0 =
let
getKey :: String -> String -> (Maybe String,String)
getKey key str = case parseKey key str of
@@ -43,7 +41,7 @@ parseModuleHeader dflags pkgName str0 =
(portabilityOpt,str9) = getKey "Portability" str8
in (HaddockModInfo {
- hmi_description = parseString dflags <$> descriptionOpt,
+ hmi_description = P.parseString <$> descriptionOpt,
hmi_copyright = copyrightOpt,
hmi_license = spdxLicenceOpt `mplus` licenseOpt `mplus` licenceOpt,
hmi_maintainer = maintainerOpt,
@@ -52,7 +50,7 @@ parseModuleHeader dflags pkgName str0 =
hmi_safety = Nothing,
hmi_language = Nothing, -- set in LexParseRn
hmi_extensions = [] -- also set in LexParseRn
- }, parseParas dflags pkgName str9)
+ }, P.parseParas pkgName str9)
-- | This function is how we read keys.
--
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 5ba5d454a1..66b0deab96 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -14,8 +14,6 @@
module Haddock.Interface.Rename (renameInterface) where
-import Data.Traversable (mapM)
-
import Haddock.GhcUtils
import Haddock.Types
@@ -23,12 +21,13 @@ import Bag (emptyBag)
import GHC hiding (NoLink)
import Name
import Outputable ( panic )
-import RdrName (RdrName(Exact))
-import TysWiredIn (eqTyCon_RDR)
+import RdrName ( RdrName(Exact) )
+import TysPrim ( eqPrimTyCon )
+import TysWiredIn ( eqTyCon_RDR )
import Control.Applicative
import Control.Arrow ( first )
-import Control.Monad hiding (mapM)
+import Control.Monad
import Data.List
import qualified Data.Map as Map hiding ( Map )
import Prelude hiding (mapM)
@@ -73,7 +72,8 @@ renameInterface dflags renamingEnv warnings iface =
| n <- missingNames
, not (isSystemName n)
, not (isBuiltInSyntax n)
- , Exact n /= eqTyCon_RDR
+ , Exact n /= eqTyCon_RDR -- (~)
+ , n /= getName eqPrimTyCon -- (~#)
]
in do
@@ -168,10 +168,8 @@ renameDocumentation :: Documentation Name -> RnM (Documentation DocName)
renameDocumentation (Documentation mDoc mWarning) =
Documentation <$> mapM renameDoc mDoc <*> mapM renameDoc mWarning
-
-renameLDocHsSyn :: LHsDocString -> RnM LHsDocString
-renameLDocHsSyn = return
-
+renameLDocHsSyn :: LHsDoc Name -> RnM (LHsDoc DocName)
+renameLDocHsSyn = traverse renameDoc
renameDoc :: Traversable t => t Name -> RnM (t DocName)
renameDoc = traverse rename
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 36729d70b8..cac8a0b5e7 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -27,8 +27,6 @@ import Control.Monad
import Data.Array
import Data.IORef
import Data.List
-import qualified Data.Map as Map
-import Data.Map (Map)
import Data.Word
import BinIface (getSymtabName, getDictFastString)
@@ -356,12 +354,6 @@ serialiseName bh name _ = do
-- * GhcBinary instances
-------------------------------------------------------------------------------
-
-instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
- put_ bh m = put_ bh (Map.toList m)
- get bh = fmap (Map.fromList) (get bh)
-
-
instance Binary InterfaceFile where
put_ bh (InterfaceFile env ifaces) = do
put_ bh env
@@ -394,8 +386,8 @@ instance Binary InstalledInterface where
visExps <- get bh
opts <- get bh
fixMap <- get bh
- return (InstalledInterface modu is_sig info docMap argMap
- exps visExps opts fixMap)
+ return (InstalledInterface modu is_sig info
+ docMap argMap exps visExps opts fixMap)
instance Binary DocOption where
@@ -403,11 +395,11 @@ instance Binary DocOption where
putByte bh 0
put_ bh OptPrune = do
putByte bh 1
- put_ bh OptIgnoreExports = do
- putByte bh 2
put_ bh OptNotHome = do
- putByte bh 3
+ putByte bh 2
put_ bh OptShowExtensions = do
+ putByte bh 3
+ put_ bh OptPrintRuntimeRep = do
putByte bh 4
get bh = do
h <- getByte bh
@@ -417,11 +409,11 @@ instance Binary DocOption where
1 -> do
return OptPrune
2 -> do
- return OptIgnoreExports
- 3 -> do
return OptNotHome
- 4 -> do
+ 3 -> do
return OptShowExtensions
+ 4 -> do
+ return OptPrintRuntimeRep
_ -> fail "invalid binary data found"
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index e314bbd05a..4b156469fb 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -89,7 +89,6 @@ data Flag
| Flag_GenContents
| Flag_UseIndex String
| Flag_GenIndex
- | Flag_IgnoreAllExports
| Flag_HideModule String
| Flag_ShowModule String
| Flag_ShowAllModules
@@ -147,9 +146,9 @@ options backwardsCompat =
"URL for a source code link on the contents\nand index pages",
Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
(ReqArg Flag_SourceModuleURL "URL")
- "URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)",
+ "URL for a source code link for each module\n(using the %{MODULE} var)",
Option [] ["source-entity"] (ReqArg Flag_SourceEntityURL "URL")
- "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
+ "URL for a source code link for each entity\n(using the %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option [] ["source-entity-line"] (ReqArg Flag_SourceLEntityURL "URL")
"URL for a source code link for each entity.\nUsed if name links are unavailable, eg. for TH splices.",
Option [] ["comments-base"] (ReqArg Flag_WikiBaseURL "URL")
@@ -157,7 +156,7 @@ options backwardsCompat =
Option [] ["comments-module"] (ReqArg Flag_WikiModuleURL "URL")
"URL for a comments link for each module\n(using the %{MODULE} var)",
Option [] ["comments-entity"] (ReqArg Flag_WikiEntityURL "URL")
- "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
+ "URL for a comments link for each entity\n(using the %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
Option ['c'] ["css", "theme"] (ReqArg Flag_CSS "PATH")
"the CSS file or theme directory to use for HTML output",
Option [] ["built-in-themes"] (NoArg Flag_BuiltInThemes)
@@ -167,7 +166,7 @@ options backwardsCompat =
Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE")
"page heading",
Option ['q'] ["qual"] (ReqArg Flag_Qualification "QUAL")
- "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'",
+ "qualification of names, one of \n'none' (default), 'full', 'local'\nor 'relative'",
Option ['?'] ["help"] (NoArg Flag_Help)
"display this help and exit",
Option ['V'] ["version"] (NoArg Flag_Version)
@@ -188,8 +187,6 @@ options backwardsCompat =
"use a separately-generated HTML index",
Option [] ["gen-index"] (NoArg Flag_GenIndex)
"generate an HTML index from specified\ninterfaces",
- Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports)
- "behave as if all modules have the\nignore-exports attribute",
Option [] ["hide"] (ReqArg Flag_HideModule "MODULE")
"behave as if MODULE has the hide attribute",
Option [] ["show"] (ReqArg Flag_ShowModule "MODULE")
@@ -316,7 +313,6 @@ qualification flags =
["full"] -> Right OptFullQual
["local"] -> Right OptLocalQual
["relative"] -> Right OptRelativeQual
- ["aliased"] -> Right OptAliasedQual
[arg] -> Left $ "unknown qualification type " ++ show arg
_:_ -> Left "qualification option given multiple times"
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index a4ef5f8203..3aef72ff03 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -20,12 +20,12 @@
-- Types that are commonly used through-out Haddock. Some of the most
-- important types are defined here, like 'Interface' and 'DocName'.
-----------------------------------------------------------------------------
-module Haddock.Types (
- module Haddock.Types
+module Haddock.Types
+ ( module Haddock.Types
, HsDocString, LHsDocString
, Fixity(..)
, module Documentation.Haddock.Types
- ) where
+ ) where
import Control.Exception
import Control.Arrow hiding ((<+>))
@@ -39,7 +39,7 @@ import Documentation.Haddock.Types
import BasicTypes (Fixity(..), PromotionFlag(..))
import GHC
-import DynFlags (Language)
+import DynFlags (Language, HasDynFlags(..))
import qualified GHC.LanguageExtensions as LangExt
import OccName
import Outputable
@@ -54,7 +54,6 @@ type InstIfaceMap = Map Module InstalledInterface -- TODO: rename
type DocMap a = Map Name (MDoc a)
type ArgMap a = Map Name (Map Int (MDoc a))
type SubMap = Map Name [Name]
-type DeclMap = Map Name [LHsDecl GhcRn]
type InstMap = Map SrcSpan Name
type FixMap = Map Name Fixity
type DocPaths = (FilePath, Maybe FilePath) -- paths to HTML and sources
@@ -78,9 +77,6 @@ data Interface = Interface
-- | Is this a signature?
, ifaceIsSig :: !Bool
- -- | Original file name of the module.
- , ifaceOrigFilename :: !FilePath
-
-- | Textual information about the module.
, ifaceInfo :: !(HaddockModInfo Name)
@@ -90,14 +86,9 @@ data Interface = Interface
-- | Documentation header with cross-reference information.
, ifaceRnDoc :: !(Documentation DocName)
- -- | Haddock options for this module (prune, ignore-exports, etc).
+ -- | Haddock options for this module (prune, not-home, etc).
, ifaceOptions :: ![DocOption]
- -- | Declarations originating from the module. Excludes declarations without
- -- names (instances and stand-alone documentation comments). Includes
- -- names of subordinate declarations mapped to their parent declarations.
- , ifaceDeclMap :: !(Map Name [LHsDecl GhcRn])
-
-- | Documentation of declarations originating from the module (including
-- subordinates).
, ifaceDocMap :: !(DocMap Name)
@@ -119,11 +110,10 @@ data Interface = Interface
-- | All \"visible\" names exported by the module.
-- A visible name is a name that will show up in the documentation of the
-- module.
+ --
+ -- Names from modules that are entirely re-exported don't count as visible.
, ifaceVisibleExports :: ![Name]
- -- | Aliases of module imports as in @import A.B.C as C@.
- , ifaceModuleAliases :: !AliasMap
-
-- | Instances exported by the module.
, ifaceInstances :: ![ClsInst]
, ifaceFamInstances :: ![FamInst]
@@ -141,7 +131,7 @@ data Interface = Interface
-- | Tokenized source code of module (avaliable if Haddock is invoked with
-- source generation flag).
- , ifaceHieFile :: !(Maybe FilePath)
+ , ifaceHieFile :: !FilePath
, ifaceDynFlags :: !DynFlags
}
@@ -175,7 +165,7 @@ data InstalledInterface = InstalledInterface
-- module.
, instVisibleExports :: [Name]
- -- | Haddock options for this module (prune, ignore-exports, etc).
+ -- | Haddock options for this module (prune, not-home, etc).
, instOptions :: [DocOption]
, instFixMap :: Map Name Fixity
@@ -329,6 +319,9 @@ instance SetName DocName where
setName name' (Undocumented _) = Undocumented name'
+instance HasOccName DocName where
+
+ occName = occName . getName
-----------------------------------------------------------------------------
-- * Instances
@@ -524,10 +517,11 @@ emptyHaddockModInfo = HaddockModInfo
data DocOption
= OptHide -- ^ This module should not appear in the docs.
| OptPrune
- | OptIgnoreExports -- ^ Pretend everything is exported.
| OptNotHome -- ^ Not the best place to get docs for things
-- exported by this module.
| OptShowExtensions -- ^ Render enabled extensions for this module.
+ | OptPrintRuntimeRep -- ^ Render runtime reps for this module (see
+ -- the GHC @-fprint-explicit-runtime-reps@ flag)
deriving (Eq, Show)
@@ -538,23 +532,12 @@ data QualOption
| OptLocalQual -- ^ Qualify all imported names fully.
| OptRelativeQual -- ^ Like local, but strip module prefix
-- from modules in the same hierarchy.
- | OptAliasedQual -- ^ Uses aliases of module names
- -- as suggested by module import renamings.
- -- However, we are unfortunately not able
- -- to maintain the original qualifications.
- -- Image a re-export of a whole module,
- -- how could the re-exported identifiers be qualified?
-
-type AliasMap = Map Module ModuleName
data Qualification
= NoQual
| FullQual
| LocalQual Module
| RelativeQual Module
- | AliasedQual AliasMap Module
- -- ^ @Module@ contains the current module.
- -- This way we can distinguish imported and local identifiers.
makeContentsQual :: QualOption -> Qualification
makeContentsQual qual =
@@ -562,12 +545,11 @@ makeContentsQual qual =
OptNoQual -> NoQual
_ -> FullQual
-makeModuleQual :: QualOption -> AliasMap -> Module -> Qualification
-makeModuleQual qual aliases mdl =
+makeModuleQual :: QualOption -> Module -> Qualification
+makeModuleQual qual mdl =
case qual of
OptLocalQual -> LocalQual mdl
OptRelativeQual -> RelativeQual mdl
- OptAliasedQual -> AliasedQual aliases mdl
OptFullQual -> FullQual
OptNoQual -> NoQual
@@ -584,6 +566,17 @@ data SinceQual
| External -- ^ only qualify when the thing being annotated is from
-- an external package
+-----------------------------------------------------------------------------
+-- * Renaming
+-----------------------------------------------------------------------------
+
+-- | Validates and renames an identifier.
+--
+-- [@Nothing@]: The input is not a valid identifier.
+--
+-- [@Just []@]: The input is a valid identifier but it's not in scope.
+type Renamer = String -> Maybe [Name]
+
-----------------------------------------------------------------------------
-- * Error handling
-----------------------------------------------------------------------------
@@ -662,7 +655,10 @@ instance Monad ErrMsgGhc where
fmap (second (msgs1 ++)) (runWriterGhc (k a))
instance MonadIO ErrMsgGhc where
- liftIO m = WriterGhc (fmap (\x -> (x, [])) (liftIO m))
+ liftIO = liftGhcToErrMsgGhc . liftIO
+
+instance HasDynFlags ErrMsgGhc where
+ getDynFlags = liftGhcToErrMsgGhc getDynFlags
-----------------------------------------------------------------------------
-- * Pass sensitive types
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 493e26625d..dd599531ad 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Utils
@@ -168,8 +169,8 @@ restrictTo names (L loc decl) = L loc $ case decl of
TyClD x d | isDataDecl d ->
TyClD x (d { tcdDataDefn = restrictDataDefn names (tcdDataDefn d) })
TyClD x d | isClassDecl d ->
- TyClD x (d { tcdSigs = restrictDecls names (tcdSigs d),
- tcdATs = restrictATs names (tcdATs d) })
+ TyClD x (d { tcdSigs = restrictDecls names (tcdSigs d)
+ , tcdATs = restrictATs names (tcdATs d) })
_ -> decl
restrictDataDefn :: [Name] -> HsDataDefn GhcRn -> HsDataDefn GhcRn
@@ -207,7 +208,13 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
keep _ = Nothing
restrictDecls :: [Name] -> [LSig GhcRn] -> [LSig GhcRn]
-restrictDecls names = mapMaybe (filterLSigNames (`elem` names))
+restrictDecls names = mapMaybe (filterLSigNames func)
+ where func n | n `elem` names = True
+
+ -- let through default method iff method is let through
+ | '$':'d':'m':strN <- getOccString n
+ , strN `elem` map getOccString names = True
+ | otherwise = False
restrictATs :: [Name] -> [LFamilyDecl GhcRn] -> [LFamilyDecl GhcRn]
diff --git a/hoogle-test/ref/Bug722/test.txt b/hoogle-test/ref/Bug722/test.txt
index 2f44ed8fb7..052c6e950f 100644
--- a/hoogle-test/ref/Bug722/test.txt
+++ b/hoogle-test/ref/Bug722/test.txt
@@ -8,7 +8,7 @@ module Bug722
class Foo a
(!@#) :: Foo a => a -> a -> a
infixl 4 !@#
-type family (&*) :: * -> * -> *
+type family (&*) :: Type -> Type -> Type
infixr 3 &*
data a :-& b
(:^&) :: a -> b -> (:-&) a b
diff --git a/hoogle-test/ref/Bug806/test.txt b/hoogle-test/ref/Bug806/test.txt
index 67e9fd6180..cf006edeb4 100644
--- a/hoogle-test/ref/Bug806/test.txt
+++ b/hoogle-test/ref/Bug806/test.txt
@@ -7,13 +7,13 @@
module Bug806
-- | <a>F1</a> docs
-type family F1 a b :: * -> *
+type family F1 a b :: Type -> Type
-- | <a>F2</a> docs
-type family F2 a b :: * -> *
+type family F2 a b :: Type -> Type
-- | <a>D</a> docs
-data family D a :: * -> *
+data family D a :: Type -> Type
v :: Int
-- | <a>C</a> docs
@@ -21,5 +21,5 @@ class C a where {
-- | <a>AT</a> docs
type family AT a;
- type AT a = Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy (Proxy)))))))));
+ type AT a = Proxy Proxy Proxy Proxy Proxy Proxy Proxy Proxy Proxy Proxy :: Any :: Type -> Type;
}
diff --git a/hoogle-test/ref/Bug825/test.txt b/hoogle-test/ref/Bug825/test.txt
index a88202dcf3..a800c10baa 100644
--- a/hoogle-test/ref/Bug825/test.txt
+++ b/hoogle-test/ref/Bug825/test.txt
@@ -6,4 +6,4 @@
module Bug825
data a :~: b
-data (:~~:) a b
+data a :~~: b
diff --git a/hoogle-test/ref/Bug873/test.txt b/hoogle-test/ref/Bug873/test.txt
index 6887331746..1d6772921b 100644
--- a/hoogle-test/ref/Bug873/test.txt
+++ b/hoogle-test/ref/Bug873/test.txt
@@ -21,7 +21,7 @@ module Bug873
-- Note that <tt>(<a>$</a>)</tt> is levity-polymorphic in its result
-- type, so that <tt>foo <a>$</a> True</tt> where <tt>foo :: Bool ->
-- Int#</tt> is well-typed.
-($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b
+($) :: (a -> b) -> a -> b
infixr 0 $
($$) :: (a -> b) -> a -> b
infixr 0 $$
diff --git a/hoogle-test/ref/classes/test.txt b/hoogle-test/ref/classes/test.txt
index 69f224eb2c..98ef48e98b 100644
--- a/hoogle-test/ref/classes/test.txt
+++ b/hoogle-test/ref/classes/test.txt
@@ -5,7 +5,7 @@
@version 0.0.0
module Classes
-class Foo f
+class Foo (f :: Type -> Type)
bar :: Foo f => f a -> f b -> f (a, b)
baz :: Foo f => f ()
class Quux q
diff --git a/hoogle-test/ref/type-sigs/test.txt b/hoogle-test/ref/type-sigs/test.txt
index 1209279c59..31c74c7fe0 100644
--- a/hoogle-test/ref/type-sigs/test.txt
+++ b/hoogle-test/ref/type-sigs/test.txt
@@ -5,12 +5,12 @@
@version 0.0.0
module ReaderT
-newtype ReaderT r m a
-ReaderT :: (r -> m a) -> ReaderT r m a
-[runReaderT] :: ReaderT r m a -> r -> m a
+newtype ReaderT r (m :: Type -> Type) a
+ReaderT :: (r -> m a) -> ReaderT r m :: Type -> Type a
+[runReaderT] :: ReaderT r m :: Type -> Type a -> r -> m a
module ReaderTReexport
-newtype ReaderT r m a
-ReaderT :: (r -> m a) -> ReaderT r m a
-[runReaderT] :: ReaderT r m a -> r -> m a
+newtype ReaderT r (m :: Type -> Type) a
+ReaderT :: (r -> m a) -> ReaderT r m :: Type -> Type a
+[runReaderT] :: ReaderT r m :: Type -> Type a -> r -> m a
runReaderT :: ReaderT r m a -> r -> m a
diff --git a/html-test/Main.hs b/html-test/Main.hs
index d65a508708..1de2a9c74e 100755
--- a/html-test/Main.hs
+++ b/html-test/Main.hs
@@ -54,12 +54,6 @@ ingoredTests =
-- we need a reliable way to deduplicate here.
-- Happens since PR #688.
"B"
-
- -- ignore-exports flag broke with PR #688. We use
- -- the Avails calculated by GHC now. Probably
- -- requires a change to GHC to "ignore" a modules
- -- export list reliably.
- , "IgnoreExports"
]
checkIgnore :: FilePath -> Bool
diff --git a/html-test/ref/Bug294.html b/html-test/ref/Bug294.html
index 1a75c1aa1d..4ec33c202d 100644
--- a/html-test/ref/Bug294.html
+++ b/html-test/ref/Bug294.html
@@ -191,7 +191,7 @@
>data family</span
> <a id="t:TP" class="def"
>TP</a
- > t :: * <a href="#" class="selflink"
+ > t <a href="#" class="selflink"
>#</a
></p
><div class="subs instances"
@@ -253,7 +253,7 @@
>data family</span
> <a id="t:DP" class="def"
>DP</a
- > t :: * <a href="#" class="selflink"
+ > t <a href="#" class="selflink"
>#</a
></p
><div class="subs instances"
@@ -315,7 +315,7 @@
>data family</span
> <a id="t:TO-39-" class="def"
>TO'</a
- > t :: * <a href="#" class="selflink"
+ > t <a href="#" class="selflink"
>#</a
></p
><div class="subs instances"
diff --git a/html-test/ref/Bug613.html b/html-test/ref/Bug613.html
index 4bcfcb13df..1bb9c792ff 100644
--- a/html-test/ref/Bug613.html
+++ b/html-test/ref/Bug613.html
@@ -52,7 +52,11 @@
>class</span
> <a href="#"
>Functor</a
- > f <span class="keyword"
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) <span class="keyword"
>where</span
><ul class="subs"
><li
@@ -81,7 +85,11 @@
>class</span
> <a id="t:Functor" class="def"
>Functor</a
- > f <span class="keyword"
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
diff --git a/html-test/ref/Bug85.html b/html-test/ref/Bug85.html
index 641d00bbe1..934fec8b28 100644
--- a/html-test/ref/Bug85.html
+++ b/html-test/ref/Bug85.html
@@ -51,7 +51,11 @@
>data</span
> <a id="t:Foo" class="def"
>Foo</a
- > :: (* -> *) -> * -> * <span class="keyword"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -64,7 +68,13 @@
><td class="src"
><a id="v:Bar" class="def"
>Bar</a
- > :: f x -> <a href="#" title="Bug85"
+ > :: <span class="keyword"
+ >forall</span
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) x. f x -> <a href="#" title="Bug85"
>Foo</a
> f (f x)</td
><td class="doc empty"
@@ -79,7 +89,7 @@
>data</span
> <a id="t:Baz" class="def"
>Baz</a
- > :: * <span class="keyword"
+ > <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
diff --git a/html-test/ref/Bug923.html b/html-test/ref/Bug923.html
index 47fced8ee7..41b1ecb9f6 100644
--- a/html-test/ref/Bug923.html
+++ b/html-test/ref/Bug923.html
@@ -52,17 +52,31 @@
>data</span
> <a href="#"
>T</a
- > :: (* -> (*, *)) -> * <span class="keyword"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> (<a href="#" title="Data.Kind"
+ >Type</a
+ >, <a href="#" title="Data.Kind"
+ >Type</a
+ >)) <span class="keyword"
>where</span
><ul class="subs"
><li
><a href="#"
>T</a
- > :: a -> <a href="#" title="Bug923"
+ > :: <span class="keyword"
+ >forall</span
+ > a. a -> <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
- > a)</li
+ > a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> (<a href="#" title="Data.Kind"
+ >Type</a
+ >, <a href="#" title="Data.Kind"
+ >Type</a
+ >))</li
></ul
></li
></ul
@@ -77,7 +91,13 @@
>data</span
> <a id="t:T" class="def"
>T</a
- > :: (* -> (*, *)) -> * <span class="keyword"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> (<a href="#" title="Data.Kind"
+ >Type</a
+ >, <a href="#" title="Data.Kind"
+ >Type</a
+ >)) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -94,11 +114,19 @@
><td class="src"
><a id="v:T" class="def"
>T</a
- > :: a -> <a href="#" title="Bug923"
+ > :: <span class="keyword"
+ >forall</span
+ > a. a -> <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
- > a)</td
+ > a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> (<a href="#" title="Data.Kind"
+ >Type</a
+ >, <a href="#" title="Data.Kind"
+ >Type</a
+ >))</td
><td class="doc empty"
> </td
></tr
@@ -122,7 +150,7 @@
>Eq</a
> (<a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
> a :: <a href="#" title="Data.Kind"
>Type</a
@@ -156,11 +184,11 @@
>(==)</a
> :: <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
> a) -> <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
> a) -> <a href="#" title="Data.Bool"
>Bool</a
@@ -172,11 +200,11 @@
>(/=)</a
> :: <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
> a) -> <a href="#" title="Bug923"
>T</a
- > ('<a href="#" title="GHC.Tuple"
+ > ('<a href="#" title="Data.Tuple"
>(,)</a
> a) -> <a href="#" title="Data.Bool"
>Bool</a
diff --git a/html-test/ref/BundledPatterns.html b/html-test/ref/BundledPatterns.html
index afa12e2b6e..7c075e7c16 100644
--- a/html-test/ref/BundledPatterns.html
+++ b/html-test/ref/BundledPatterns.html
@@ -52,15 +52,17 @@
>data</span
> <a href="#"
>Vec</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
><ul class="subs"
><li
><a href="#"
>Nil</a
- > :: <a href="#" title="BundledPatterns"
+ > :: <span class="keyword"
+ >forall</span
+ > a. <a href="#" title="BundledPatterns"
>Vec</a
> 0 a</li
><li
@@ -82,9 +84,9 @@
>data</span
> <a href="#"
>RTree</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
><ul class="subs"
><li
@@ -123,9 +125,9 @@
>data</span
> <a id="t:Vec" class="def"
>Vec</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -161,7 +163,9 @@
><td class="src"
><a id="v:Nil" class="def"
>Nil</a
- > :: <a href="#" title="BundledPatterns"
+ > :: <span class="keyword"
+ >forall</span
+ > a. <a href="#" title="BundledPatterns"
>Vec</a
> 0 a</td
><td class="doc empty"
@@ -285,9 +289,9 @@
>data</span
> <a id="t:RTree" class="def"
>RTree</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
diff --git a/html-test/ref/BundledPatterns2.html b/html-test/ref/BundledPatterns2.html
index 48493cf9e6..aaf8c7bdbf 100644
--- a/html-test/ref/BundledPatterns2.html
+++ b/html-test/ref/BundledPatterns2.html
@@ -52,9 +52,9 @@
>data</span
> <a href="#"
>Vec</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
><ul class="subs"
><li
@@ -84,9 +84,9 @@
>data</span
> <a href="#"
>RTree</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
><ul class="subs"
><li
@@ -125,9 +125,9 @@
>data</span
> <a id="t:Vec" class="def"
>Vec</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -283,9 +283,9 @@
>data</span
> <a id="t:RTree" class="def"
>RTree</a
- > :: <a href="#" title="GHC.TypeNats"
+ > (a :: <a href="#" title="GHC.TypeNats"
>Nat</a
- > -> * -> * <span class="keyword"
+ >) b <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
diff --git a/html-test/ref/DefaultAssociatedTypes.html b/html-test/ref/DefaultAssociatedTypes.html
new file mode 100644
index 0000000000..a0724e8de6
--- /dev/null
+++ b/html-test/ref/DefaultAssociatedTypes.html
@@ -0,0 +1,160 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><meta name="viewport" content="width=device-width, initial-scale=1"
+ /><title
+ >DefaultAssociatedTypes</title
+ ><link href="#" rel="stylesheet" type="text/css" title="NewOcean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><span class="caption empty"
+ > </span
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >DefaultAssociatedTypes</p
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><span class="keyword"
+ >class</span
+ > <a href="#"
+ >Foo</a
+ > a <span class="keyword"
+ >where</span
+ ><ul class="subs"
+ ><li
+ ><span class="keyword"
+ >type</span
+ > <a href="#"
+ >Qux</a
+ > a</li
+ ><li
+ ><a href="#"
+ >bar</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ ></li
+ ><li
+ ><a href="#"
+ >baz</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ ></li
+ ></ul
+ ></li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a id="t:Foo" class="def"
+ >Foo</a
+ > a <span class="keyword"
+ >where</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for Foo.</p
+ ></div
+ ><div class="subs associated-types"
+ ><p class="caption"
+ >Associated Types</p
+ ><p class="src"
+ ><span class="keyword"
+ >type</span
+ > <a id="t:Qux" class="def"
+ >Qux</a
+ > a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Doc for Qux</p
+ ></div
+ > <div class="subs default"
+ ><p class="caption"
+ ></p
+ ><p class="src"
+ ><span class="keyword"
+ >type</span
+ > <a id="t:Qux" class="def"
+ >Qux</a
+ > a = [a] <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a id="v:bar" class="def"
+ >bar</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for bar and baz.</p
+ ></div
+ ><p class="src"
+ ><a id="v:baz" class="def"
+ >baz</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for bar and baz.</p
+ ></div
+ ></div
+ ></div
+ ></div
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/DefaultSignatures.html b/html-test/ref/DefaultSignatures.html
new file mode 100644
index 0000000000..74da534345
--- /dev/null
+++ b/html-test/ref/DefaultSignatures.html
@@ -0,0 +1,184 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><meta name="viewport" content="width=device-width, initial-scale=1"
+ /><title
+ >DefaultSignatures</title
+ ><link href="#" rel="stylesheet" type="text/css" title="NewOcean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><span class="caption empty"
+ > </span
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >DefaultSignatures</p
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><span class="keyword"
+ >class</span
+ > <a href="#"
+ >Foo</a
+ > a <span class="keyword"
+ >where</span
+ ><ul class="subs"
+ ><li
+ ><a href="#"
+ >bar</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ ></li
+ ><li
+ ><a href="#"
+ >baz</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ ></li
+ ><li
+ ><a href="#"
+ >baz'</a
+ > :: <a href="#" title="Data.String"
+ >String</a
+ > -> a</li
+ ></ul
+ ></li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a id="t:Foo" class="def"
+ >Foo</a
+ > a <span class="keyword"
+ >where</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for Foo.</p
+ ></div
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="#" title="DefaultSignatures"
+ >baz</a
+ ></p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a id="v:bar" class="def"
+ >bar</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for bar and baz.</p
+ ></div
+ > <div class="subs default"
+ ><p class="caption"
+ ></p
+ ><p class="src"
+ ><span class="keyword"
+ >default</span
+ > <a id="v:bar" class="def"
+ >bar</a
+ > :: <a href="#" title="Text.Show"
+ >Show</a
+ > a => a -> <a href="#" title="Data.String"
+ >String</a
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ><p class="src"
+ ><a id="v:baz" class="def"
+ >baz</a
+ > :: a -> <a href="#" title="Data.String"
+ >String</a
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for bar and baz.</p
+ ></div
+ ><p class="src"
+ ><a id="v:baz-39-" class="def"
+ >baz'</a
+ > :: <a href="#" title="Data.String"
+ >String</a
+ > -> a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Documentation for baz'.</p
+ ></div
+ > <div class="subs default"
+ ><p class="caption"
+ ></p
+ ><p class="src"
+ ><span class="keyword"
+ >default</span
+ > <a id="v:baz-39-" class="def"
+ >baz'</a
+ > :: <a href="#" title="Text.Read"
+ >Read</a
+ > a => <a href="#" title="Data.String"
+ >String</a
+ > -> a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ></div
+ ></div
+ ></div
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/DeprecatedTypeFamily.html b/html-test/ref/DeprecatedTypeFamily.html
index f2292c793a..10022f7f44 100644
--- a/html-test/ref/DeprecatedTypeFamily.html
+++ b/html-test/ref/DeprecatedTypeFamily.html
@@ -52,13 +52,21 @@
>data family</span
> <a href="#"
>SomeTypeFamily</a
- > k :: * -> *</li
+ > k :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ ></li
><li class="src short"
><span class="keyword"
>data family</span
> <a href="#"
>SomeOtherTypeFamily</a
- > k :: * -> *</li
+ > k :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ ></li
></ul
></details
></div
@@ -71,7 +79,11 @@
>data family</span
> <a id="t:SomeTypeFamily" class="def"
>SomeTypeFamily</a
- > k :: * -> * <a href="#" class="selflink"
+ > k :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ > <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -89,7 +101,11 @@
>data family</span
> <a id="t:SomeOtherTypeFamily" class="def"
>SomeOtherTypeFamily</a
- > k :: * -> * <a href="#" class="selflink"
+ > k :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ > <a href="#" class="selflink"
>#</a
></p
><div class="doc"
diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html
index 7a15eec60e..9096b01194 100644
--- a/html-test/ref/FunArgs.html
+++ b/html-test/ref/FunArgs.html
@@ -218,9 +218,9 @@
><td class="src"
>:: <span class="keyword"
>forall</span
- > (b :: ()). d ~ '<a href="#" title="GHC.Tuple"
- >()</a
- ></td
+ > (b :: ()) (d :: ()). d <a href="#" title="GHC.Types"
+ >~</a
+ > '()</td
><td class="doc empty"
> </td
></tr
diff --git a/html-test/ref/GADTRecords.html b/html-test/ref/GADTRecords.html
index 77202f99cf..ce050c74cd 100644
--- a/html-test/ref/GADTRecords.html
+++ b/html-test/ref/GADTRecords.html
@@ -58,13 +58,17 @@
><li
><a href="#"
>C1</a
- > :: <a href="#" title="GADTRecords"
+ > :: <span class="keyword"
+ >forall</span
+ > a b. <a href="#" title="GADTRecords"
>H1</a
> a b</li
><li
><a href="#"
>C2</a
- > :: <a href="#" title="Data.Ord"
+ > :: <span class="keyword"
+ >forall</span
+ > a. <a href="#" title="Data.Ord"
>Ord</a
> a => [a] -> <a href="#" title="GADTRecords"
>H1</a
@@ -82,7 +86,9 @@
><li
><a href="#"
>C4</a
- > :: {..} -> <a href="#" title="GADTRecords"
+ > :: <span class="keyword"
+ >forall</span
+ > a. {..} -> <a href="#" title="GADTRecords"
>H1</a
> <a href="#" title="Data.Int"
>Int</a
@@ -118,7 +124,9 @@
><td class="src"
><a id="v:C1" class="def"
>C1</a
- > :: <a href="#" title="GADTRecords"
+ > :: <span class="keyword"
+ >forall</span
+ > a b. <a href="#" title="GADTRecords"
>H1</a
> a b</td
><td class="doc empty"
@@ -128,7 +136,9 @@
><td class="src"
><a id="v:C2" class="def"
>C2</a
- > :: <a href="#" title="Data.Ord"
+ > :: <span class="keyword"
+ >forall</span
+ > a. <a href="#" title="Data.Ord"
>Ord</a
> a => [a] -> <a href="#" title="GADTRecords"
>H1</a
diff --git a/html-test/ref/HideRuntimeReps.html b/html-test/ref/HideRuntimeReps.html
new file mode 100644
index 0000000000..876f88b77d
--- /dev/null
+++ b/html-test/ref/HideRuntimeReps.html
@@ -0,0 +1,165 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><meta name="viewport" content="width=device-width, initial-scale=1"
+ /><title
+ >HideRuntimeReps</title
+ ><link href="#" rel="stylesheet" type="text/css" title="NewOcean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><span class="caption empty"
+ > </span
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >HideRuntimeReps</p
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><a href="#"
+ >($)</a
+ > :: (a -> b) -> a -> b</li
+ ><li class="src short"
+ ><a href="#"
+ >error</a
+ > :: <a href="#" title="GHC.Stack"
+ >HasCallStack</a
+ > => [<a href="#" title="Data.Char"
+ >Char</a
+ >] -> a</li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:-36-" class="def"
+ >($)</a
+ > :: (a -> b) -> a -> b <span class="fixity"
+ >infixr 0</span
+ ><span class="rightedge"
+ ></span
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Application operator. This operator is redundant, since ordinary
+ application <code
+ >(f x)</code
+ > means the same as <code
+ >(f <code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ > x)</code
+ >. However, <code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ > has
+ low, right-associative binding precedence, so it sometimes allows
+ parentheses to be omitted; for example:</p
+ ><pre
+ >f $ g $ h x = f (g (h x))</pre
+ ><p
+ >It is also useful in higher-order situations, such as <code
+ ><code
+ ><a href="#" title="GHC.List"
+ >map</a
+ ></code
+ > (<code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ > 0) xs</code
+ >,
+ or <code
+ ><code
+ ><a href="#" title="Data.List"
+ >zipWith</a
+ ></code
+ > (<code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ >) fs xs</code
+ >.</p
+ ><p
+ >Note that <code
+ >(<code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ >)</code
+ > is levity-polymorphic in its result type, so that
+ <code
+ >foo <code
+ ><a href="#" title="HideRuntimeReps"
+ >$</a
+ ></code
+ > True</code
+ > where <code
+ >foo :: Bool -> Int#</code
+ > is well-typed.</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:error" class="def"
+ >error</a
+ > :: <a href="#" title="GHC.Stack"
+ >HasCallStack</a
+ > => [<a href="#" title="Data.Char"
+ >Char</a
+ >] -> a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ ><code
+ ><a href="#" title="HideRuntimeReps"
+ >error</a
+ ></code
+ > stops execution and displays an error message.</p
+ ></div
+ ></div
+ ></div
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html
index 949f85b03e..29e85a4671 100644
--- a/html-test/ref/Instances.html
+++ b/html-test/ref/Instances.html
@@ -147,7 +147,11 @@
>class</span
> <a id="t:Foo" class="def"
>Foo</a
- > f <span class="keyword"
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -194,7 +198,9 @@
></span
> <a href="#" title="Instances"
>Foo</a
- > []</span
+ > <a href="#" title="Data.List"
+ >[]</a
+ ></span
> <a href="#" class="selflink"
>#</a
></td
@@ -370,7 +376,7 @@
>Foo</a
> f) => <a href="#" title="Instances"
>Foo</a
- > (<a href="#" title="GHC.Tuple"
+ > (<a href="#" title="Data.Tuple"
>(,)</a
> (f a))</span
> <a href="#" class="selflink"
@@ -482,7 +488,7 @@
></span
> <a href="#" title="Instances"
>Foo</a
- > (<a href="#" title="GHC.Tuple"
+ > (<a href="#" title="Data.Tuple"
>(,,)</a
> a a)</span
> <a href="#" class="selflink"
@@ -594,7 +600,9 @@
></span
> <a href="#" title="Instances"
>Foo</a
- > ((->) a :: <a href="#" title="Data.Kind"
+ > (<a href="#" title="Prelude"
+ >(->)</a
+ > a :: <a href="#" title="Data.Kind"
>Type</a
> -> <a href="#" title="Data.Kind"
>Type</a
@@ -620,17 +628,29 @@
><p class="src"
><a href="#"
>foo</a
- > :: (a -> <a href="#" title="Data.Int"
+ > :: (a <a href="#" title="Prelude"
+ >-></a
+ > <a href="#" title="Data.Int"
>Int</a
- >) -> a0 -> a -> a0 <a href="#" class="selflink"
+ >) -> a0 -> a <a href="#" title="Prelude"
+ >-></a
+ > a0 <a href="#" class="selflink"
>#</a
></p
><p class="src"
><a href="#"
>foo'</a
- > :: (a -> (a -> a0)) -> <a href="#" title="Data.Int"
+ > :: (a <a href="#" title="Prelude"
+ >-></a
+ > (a <a href="#" title="Prelude"
+ >-></a
+ > a0)) -> <a href="#" title="Data.Int"
>Int</a
- > -> a -> (a -> <a href="#" title="Data.Int"
+ > -> a <a href="#" title="Prelude"
+ >-></a
+ > (a <a href="#" title="Prelude"
+ >-></a
+ > <a href="#" title="Data.Int"
>Int</a
>) <a href="#" class="selflink"
>#</a
@@ -651,7 +671,11 @@
>Foo</a
> f => <a id="t:Bar" class="def"
>Bar</a
- > f a <span class="keyword"
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) a <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -898,7 +922,9 @@
></span
> <a href="#" title="Instances"
>Bar</a
- > [] (a, a)</span
+ > <a href="#" title="Data.List"
+ >[]</a
+ > (a, a)</span
> <a href="#" class="selflink"
>#</a
></td
@@ -1044,11 +1070,11 @@
></span
> <a href="#" title="Instances"
>Foo</a
- > (<a href="#" title="GHC.Tuple"
+ > (<a href="#" title="Data.Tuple"
>(,,)</a
> a b) => <a href="#" title="Instances"
>Bar</a
- > (<a href="#" title="GHC.Tuple"
+ > (<a href="#" title="Data.Tuple"
>(,,)</a
> a b) (a, b, a)</span
> <a href="#" class="selflink"
@@ -2139,6 +2165,160 @@
></details
></div
></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data family</span
+ > <a id="t:Thud" class="def"
+ >Thud</a
+ > a c <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="subs instances"
+ ><h4 class="instances details-toggle-control details-toggle" data-details-id="i:Thud"
+ >Instances</h4
+ ><details id="i:Thud" open="open"
+ ><summary class="hide-when-js-enabled"
+ >Instances details</summary
+ ><table
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Thud:Thud:1"
+ ></span
+ > <span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ > [a]</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:if:Thud:Thud:1"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >Instances</a
+ ></p
+ > <div class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ > [a] = <a id="v:Thuuuud" class="def"
+ >Thuuuud</a
+ > <a href="#" title="Data.Bool"
+ >Bool</a
+ ></div
+ ></details
+ ></td
+ ></tr
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Thud:Thud:2"
+ ></span
+ > <span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ > (<a href="#" title="Instances"
+ >Quux</a
+ > a [a] c)</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:if:Thud:Thud:2"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >Instances</a
+ ></p
+ > <div class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ > (<a href="#" title="Instances"
+ >Quux</a
+ > a [a] c) <ul class="inst"
+ ><li class="inst"
+ >= <a id="v:Thuud" class="def"
+ >Thuud</a
+ > a</li
+ ><li class="inst"
+ >| <a id="v:Thuuud" class="def"
+ >Thuuud</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ > <a href="#" title="Data.Int"
+ >Int</a
+ ></li
+ ></ul
+ ></div
+ ></details
+ ></td
+ ></tr
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Thud:Thud:3"
+ ></span
+ > <span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > [a] (a, a, a)</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:if:Thud:Thud:3"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >Instances</a
+ ></p
+ > <div class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="#" title="Instances"
+ >Thud</a
+ > [a] (a, a, a) = <a id="v:Thd" class="def"
+ >Thd</a
+ > a</div
+ ></details
+ ></td
+ ></tr
+ ></table
+ ></details
+ ></div
+ ></div
></div
></div
></body
diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html
index ae0ae29938..c8e5fe3dae 100644
--- a/html-test/ref/Operators.html
+++ b/html-test/ref/Operators.html
@@ -108,7 +108,9 @@
><li
><a href="#"
>(:<->)</a
- > :: a -> b -> a <a href="#" title="Operators"
+ > :: <span class="keyword"
+ >forall</span
+ > a b. a -> b -> a <a href="#" title="Operators"
><-></a
> b</li
></ul
@@ -138,7 +140,7 @@
>type</span
> a <a href="#"
><><</a
- > b :: *</li
+ > b</li
><li
><span class="keyword"
>data</span
@@ -148,17 +150,25 @@
><li
><a href="#"
>(>><)</a
- >, <a href="#"
+ > :: a -> b -> ()</li
+ ><li
+ ><a href="#"
>(<<>)</a
> :: a -> b -> ()</li
><li
><a href="#"
>(**>)</a
- >, <a href="#"
+ > :: a -> a -> ()</li
+ ><li
+ ><a href="#"
>(**<)</a
- >, <a href="#"
+ > :: a -> a -> ()</li
+ ><li
+ ><a href="#"
>(>**)</a
- >, <a href="#"
+ > :: a -> a -> ()</li
+ ><li
+ ><a href="#"
>(<**)</a
> :: a -> a -> ()</li
></ul
@@ -322,7 +332,9 @@
><td class="src"
><a id="v::-60--45--62-" class="def"
>(:<->)</a
- > :: a -> b -> a <a href="#" title="Operators"
+ > :: <span class="keyword"
+ >forall</span
+ > a b. a -> b -> a <a href="#" title="Operators"
><-></a
> b <span class="fixity"
>infixr 6</span
@@ -398,7 +410,7 @@
>type</span
> a <a id="t:-60--62--60-" class="def"
><><</a
- > b :: * <span class="fixity"
+ > b <span class="fixity"
>infixl 2</span
><span class="rightedge"
></span
diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html
index 6fec017ece..8c1540359d 100644
--- a/html-test/ref/PatternSyns.html
+++ b/html-test/ref/PatternSyns.html
@@ -116,9 +116,9 @@
><li class="src short"
><span class="keyword"
>data</span
- > (a :: *) <a href="#"
+ > a <a href="#"
>><</a
- > b = <a href="#"
+ > (b :: k) = <a href="#"
>Empty</a
></li
><li class="src short"
@@ -295,9 +295,9 @@
><p class="src"
><span class="keyword"
>data</span
- > (a :: *) <a id="t:-62--60-" class="def"
+ > a <a id="t:-62--60-" class="def"
>><</a
- > b <a href="#" class="selflink"
+ > (b :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/PrefixStarOperator.html
similarity index 50%
rename from html-test/ref/IgnoreExports.html
rename to html-test/ref/PrefixStarOperator.html
index eed12c0067..bb170b96db 100644
--- a/html-test/ref/IgnoreExports.html
+++ b/html-test/ref/PrefixStarOperator.html
@@ -3,19 +3,21 @@
><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
/><meta name="viewport" content="width=device-width, initial-scale=1"
/><title
- >IgnoreExports</title
- ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+ >PrefixStarOperator</title
+ ><link href="#" rel="stylesheet" type="text/css" title="NewOcean"
/><link rel="stylesheet" type="text/css" href="#"
/><link rel="stylesheet" type="text/css" href="#"
/><script src="haddock-bundle.min.js" async="async" type="text/javascript"
></script
- ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
></script
></head
><body
><div id="package-header"
><span class="caption empty"
- ></span
+ > </span
><ul class="links" id="page-menu"
><li
><a href="#"
@@ -38,63 +40,25 @@
></tr
></table
><p class="caption"
- >IgnoreExports</p
- ></div
- ><div id="synopsis"
- ><details id="syn"
- ><summary
- >Synopsis</summary
- ><ul class="details-toggle" data-details-id="syn"
- ><li class="src short"
- ><a href="#"
- >foo</a
- > :: <a href="#"
- >Int</a
- ></li
- ><li class="src short"
- ><a href="#"
- >bar</a
- > :: <a href="#"
- >Int</a
- ></li
- ></ul
- ></details
+ >PrefixStarOperator</p
></div
><div id="interface"
><h1
>Documentation</h1
><div class="top"
><p class="src"
- ><a id="v:foo" class="def"
- >foo</a
- > :: <a href="#"
- >Int</a
- > <a href="#" class="selflink"
- >#</a
- ></p
- ><div class="doc"
- ><p
- >documentation for foo</p
- ></div
- ></div
- ><div class="top"
- ><p class="src"
- ><a id="v:bar" class="def"
- >bar</a
- > :: <a href="#"
- >Int</a
- > <a href="#" class="selflink"
+ ><span class="keyword"
+ >type</span
+ > <a id="t:-42-" class="def"
+ >(*)</a
+ > a = <a href="#" title="Data.Tuple"
+ >(,)</a
+ > a <a href="#" class="selflink"
>#</a
></p
- ><div class="doc"
- ><p
- >documentation for bar</p
- ></div
></div
></div
></div
- ><div id="footer"
- ></div
></body
></html
>
diff --git a/html-test/ref/PrintRuntimeReps.html b/html-test/ref/PrintRuntimeReps.html
new file mode 100644
index 0000000000..c28443bf0e
--- /dev/null
+++ b/html-test/ref/PrintRuntimeReps.html
@@ -0,0 +1,189 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><meta name="viewport" content="width=device-width, initial-scale=1"
+ /><title
+ >PrintRuntimeReps</title
+ ><link href="#" rel="stylesheet" type="text/css" title="NewOcean"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><span class="caption empty"
+ > </span
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >PrintRuntimeReps</p
+ ></div
+ ><div id="synopsis"
+ ><details id="syn"
+ ><summary
+ >Synopsis</summary
+ ><ul class="details-toggle" data-details-id="syn"
+ ><li class="src short"
+ ><a href="#"
+ >($)</a
+ > :: <span class="keyword"
+ >forall</span
+ > (r :: <a href="#" title="GHC.Exts"
+ >RuntimeRep</a
+ >) a (b :: <a href="#" title="GHC.Exts"
+ >TYPE</a
+ > r). (a -> b) -> a -> b</li
+ ><li class="src short"
+ ><a href="#"
+ >error</a
+ > :: <span class="keyword"
+ >forall</span
+ > (r :: <a href="#" title="GHC.Exts"
+ >RuntimeRep</a
+ >) (a :: <a href="#" title="GHC.Exts"
+ >TYPE</a
+ > r). <a href="#" title="GHC.Stack"
+ >HasCallStack</a
+ > => [<a href="#" title="Data.Char"
+ >Char</a
+ >] -> a</li
+ ></ul
+ ></details
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:-36-" class="def"
+ >($)</a
+ > :: <span class="keyword"
+ >forall</span
+ > (r :: <a href="#" title="GHC.Exts"
+ >RuntimeRep</a
+ >) a (b :: <a href="#" title="GHC.Exts"
+ >TYPE</a
+ > r). (a -> b) -> a -> b <span class="fixity"
+ >infixr 0</span
+ ><span class="rightedge"
+ ></span
+ > <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Application operator. This operator is redundant, since ordinary
+ application <code
+ >(f x)</code
+ > means the same as <code
+ >(f <code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ > x)</code
+ >. However, <code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ > has
+ low, right-associative binding precedence, so it sometimes allows
+ parentheses to be omitted; for example:</p
+ ><pre
+ >f $ g $ h x = f (g (h x))</pre
+ ><p
+ >It is also useful in higher-order situations, such as <code
+ ><code
+ ><a href="#" title="GHC.List"
+ >map</a
+ ></code
+ > (<code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ > 0) xs</code
+ >,
+ or <code
+ ><code
+ ><a href="#" title="Data.List"
+ >zipWith</a
+ ></code
+ > (<code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ >) fs xs</code
+ >.</p
+ ><p
+ >Note that <code
+ >(<code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ >)</code
+ > is levity-polymorphic in its result type, so that
+ <code
+ >foo <code
+ ><a href="#" title="PrintRuntimeReps"
+ >$</a
+ ></code
+ > True</code
+ > where <code
+ >foo :: Bool -> Int#</code
+ > is well-typed.</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a id="v:error" class="def"
+ >error</a
+ > :: <span class="keyword"
+ >forall</span
+ > (r :: <a href="#" title="GHC.Exts"
+ >RuntimeRep</a
+ >) (a :: <a href="#" title="GHC.Exts"
+ >TYPE</a
+ > r). <a href="#" title="GHC.Stack"
+ >HasCallStack</a
+ > => [<a href="#" title="Data.Char"
+ >Char</a
+ >] -> a <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ ><code
+ ><a href="#" title="PrintRuntimeReps"
+ >error</a
+ ></code
+ > stops execution and displays an error message.</p
+ ></div
+ ></div
+ ></div
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/PromotedTypes.html b/html-test/ref/PromotedTypes.html
index 23e30e2190..1e775ed746 100644
--- a/html-test/ref/PromotedTypes.html
+++ b/html-test/ref/PromotedTypes.html
@@ -85,7 +85,9 @@
>data</span
> <a id="t:Pattern" class="def"
>Pattern</a
- > :: [*] -> * <span class="keyword"
+ > (a :: [<a href="#" title="Data.Kind"
+ >Type</a
+ >]) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -100,7 +102,9 @@
>Nil</a
> :: <a href="#" title="PromotedTypes"
>Pattern</a
- > '[]</td
+ > ('[] :: [<a href="#" title="Data.Kind"
+ >Type</a
+ >])</td
><td class="doc empty"
> </td
></tr
@@ -108,13 +112,19 @@
><td class="src"
><a id="v:Cons" class="def"
>Cons</a
- > :: <a href="#" title="Data.Maybe"
+ > :: <span class="keyword"
+ >forall</span
+ > h (t :: [<a href="#" title="Data.Kind"
+ >Type</a
+ >]). <a href="#" title="Data.Maybe"
>Maybe</a
> h -> <a href="#" title="PromotedTypes"
>Pattern</a
> t -> <a href="#" title="PromotedTypes"
>Pattern</a
- > (h ': t)</td
+ > (h '<a href="#" title="Data.List"
+ >:</a
+ > t)</td
><td class="doc empty"
> </td
></tr
@@ -127,9 +137,11 @@
>data</span
> <a id="t:RevPattern" class="def"
>RevPattern</a
- > :: <a href="#" title="PromotedTypes"
+ > (a :: <a href="#" title="PromotedTypes"
>RevList</a
- > * -> * <span class="keyword"
+ > <a href="#" title="Data.Kind"
+ >Type</a
+ >) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -144,9 +156,13 @@
>RevNil</a
> :: <a href="#" title="PromotedTypes"
>RevPattern</a
- > <a href="#" title="PromotedTypes"
+ > ('<a href="#" title="PromotedTypes"
>RNil</a
- ></td
+ > :: <a href="#" title="PromotedTypes"
+ >RevList</a
+ > <a href="#" title="Data.Kind"
+ >Type</a
+ >)</td
><td class="doc empty"
> </td
></tr
@@ -154,7 +170,13 @@
><td class="src"
><a id="v:RevCons" class="def"
>RevCons</a
- > :: <a href="#" title="Data.Maybe"
+ > :: <span class="keyword"
+ >forall</span
+ > h (t :: <a href="#" title="PromotedTypes"
+ >RevList</a
+ > <a href="#" title="Data.Kind"
+ >Type</a
+ >). <a href="#" title="Data.Maybe"
>Maybe</a
> h -> <a href="#" title="PromotedTypes"
>RevPattern</a
@@ -175,7 +197,11 @@
>data</span
> <a id="t:Tuple" class="def"
>Tuple</a
- > :: (*, *) -> * <span class="keyword"
+ > (a :: (<a href="#" title="Data.Kind"
+ >Type</a
+ >, <a href="#" title="Data.Kind"
+ >Type</a
+ >)) <span class="keyword"
>where</span
> <a href="#" class="selflink"
>#</a
@@ -188,7 +214,9 @@
><td class="src"
><a id="v:Tuple" class="def"
>Tuple</a
- > :: a -> b -> <a href="#" title="PromotedTypes"
+ > :: <span class="keyword"
+ >forall</span
+ > a b. a -> b -> <a href="#" title="PromotedTypes"
>Tuple</a
> '(a, b)</td
><td class="doc empty"
diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html
index 8069db6c4e..8d21a5a778 100644
--- a/html-test/ref/SpuriousSuperclassConstraints.html
+++ b/html-test/ref/SpuriousSuperclassConstraints.html
@@ -77,7 +77,11 @@ Fix spurious superclass constraints bug.</pre
>data</span
> <a id="t:SomeType" class="def"
>SomeType</a
- > (f :: * -> *) a <a href="#" class="selflink"
+ > (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) a <a href="#" class="selflink"
>#</a
></p
><div class="subs instances"
diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html
index 26e8c7e85d..a2e21fce88 100644
--- a/html-test/ref/Test.html
+++ b/html-test/ref/Test.html
@@ -279,7 +279,11 @@
>newtype</span
> <a href="#"
>N2</a
- > a b = <a href="#"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b = <a href="#"
>N2</a
> {<ul class="subs"
><li
@@ -293,7 +297,11 @@
>newtype</span
> <a href="#"
>N3</a
- > a b = <a href="#"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b = <a href="#"
>N3</a
> {<ul class="subs"
><li
@@ -313,7 +321,11 @@
>newtype</span
> <a href="#"
>N5</a
- > a b = <a href="#"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b = <a href="#"
>N5</a
> {<ul class="subs"
><li
@@ -327,7 +339,11 @@
>newtype</span
> <a href="#"
>N6</a
- > a b = <a href="#"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b = <a href="#"
>N6</a
> {<ul class="subs"
><li
@@ -341,7 +357,11 @@
>newtype</span
> <a href="#"
>N7</a
- > a b = <a href="#"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b = <a href="#"
>N7</a
> {<ul class="subs"
><li
@@ -375,7 +395,11 @@
><li
><a href="#"
>r</a
- >, <a href="#"
+ > :: <a href="#" title="Data.Int"
+ >Int</a
+ ></li
+ ><li
+ ><a href="#"
>s</a
> :: <a href="#" title="Data.Int"
>Int</a
@@ -413,7 +437,11 @@
><li
><a href="#"
>u</a
- >, <a href="#"
+ > :: <a href="#" title="Data.Int"
+ >Int</a
+ ></li
+ ><li
+ ><a href="#"
>v</a
> :: <a href="#" title="Data.Int"
>Int</a
@@ -979,7 +1007,11 @@
>newtype</span
> <a id="t:N2" class="def"
>N2</a
- > a b <a href="#" class="selflink"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1025,7 +1057,11 @@
>newtype</span
> <a id="t:N3" class="def"
>N3</a
- > a b <a href="#" class="selflink"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1092,7 +1128,11 @@
>newtype</span
> <a id="t:N5" class="def"
>N5</a
- > a b <a href="#" class="selflink"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <a href="#" class="selflink"
>#</a
></p
><div class="subs constructors"
@@ -1136,7 +1176,11 @@
>newtype</span
> <a id="t:N6" class="def"
>N6</a
- > a b <a href="#" class="selflink"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <a href="#" class="selflink"
>#</a
></p
><div class="subs constructors"
@@ -1180,7 +1224,11 @@
>newtype</span
> <a id="t:N7" class="def"
>N7</a
- > a b <a href="#" class="selflink"
+ > (a :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) b <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1324,7 +1372,25 @@
><dfn class="src"
><a id="v:r" class="def"
>r</a
- >, <a id="v:s" class="def"
+ > :: <a href="#" title="Data.Int"
+ >Int</a
+ ></dfn
+ ><div class="doc"
+ ><p
+ >This comment applies to both <code
+ ><a href="#" title="Test"
+ >r</a
+ ></code
+ > and <code
+ ><a href="#" title="Test"
+ >s</a
+ ></code
+ ></p
+ ></div
+ ></li
+ ><li
+ ><dfn class="src"
+ ><a id="v:s" class="def"
>s</a
> :: <a href="#" title="Data.Int"
>Int</a
@@ -1398,7 +1464,15 @@
><dfn class="src"
><a id="v:u" class="def"
>u</a
- >, <a id="v:v" class="def"
+ > :: <a href="#" title="Data.Int"
+ >Int</a
+ ></dfn
+ ><div class="doc empty"
+ > </div
+ ></li
+ ><li
+ ><dfn class="src"
+ ><a id="v:v" class="def"
>v</a
> :: <a href="#" title="Data.Int"
>Int</a
diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html
index 53a65db87c..9cc6e74d1a 100644
--- a/html-test/ref/TypeFamilies.html
+++ b/html-test/ref/TypeFamilies.html
@@ -102,7 +102,7 @@
>class</span
> <a href="#"
>Test</a
- > a</li
+ > (a :: k)</li
><li class="src short"
><span class="keyword"
>type family</span
@@ -114,13 +114,13 @@
>data family</span
> <a href="#"
>Bat</a
- > (a :: k) :: *</li
+ > (a :: k)</li
><li class="src short"
><span class="keyword"
>class</span
> <a href="#"
>Assoc</a
- > a <span class="keyword"
+ > (a :: k) <span class="keyword"
>where</span
><ul class="subs"
><li
@@ -128,13 +128,13 @@
>data</span
> <a href="#"
>AssocD</a
- > a :: *</li
+ > (a :: k)</li
><li
><span class="keyword"
>type</span
> <a href="#"
>AssocT</a
- > a :: *</li
+ > (a :: k)</li
></ul
></li
><li class="src short"
@@ -157,6 +157,12 @@
> (a :: k) <a href="#"
>><</a
> (b :: k)</li
+ ><li class="src short"
+ ><span class="keyword"
+ >data family</span
+ > <a href="#"
+ >AssocD</a
+ > (a :: k)</li
></ul
></details
></div
@@ -1129,7 +1135,7 @@
>class</span
> <a id="t:Test" class="def"
>Test</a
- > a <a href="#" class="selflink"
+ > (a :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1321,7 +1327,7 @@
>data family</span
> <a id="t:Bat" class="def"
>Bat</a
- > (a :: k) :: * <a href="#" class="selflink"
+ > (a :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1517,7 +1523,7 @@
>class</span
> <a id="t:Assoc" class="def"
>Assoc</a
- > a <a href="#" class="selflink"
+ > (a :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1532,7 +1538,7 @@
>data</span
> <a id="t:AssocD" class="def"
>AssocD</a
- > a :: * <a href="#" class="selflink"
+ > (a :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1544,7 +1550,7 @@
>type</span
> <a id="t:AssocT" class="def"
>AssocT</a
- > a :: * <a href="#" class="selflink"
+ > (a :: k) <a href="#" class="selflink"
>#</a
></p
><div class="doc"
@@ -1915,6 +1921,110 @@
></details
></div
></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data family</span
+ > <a id="t:AssocD" class="def"
+ >AssocD</a
+ > (a :: k) <a href="#" class="selflink"
+ >#</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Doc for: data AssocD a</p
+ ></div
+ ><div class="subs instances"
+ ><h4 class="instances details-toggle-control details-toggle" data-details-id="i:AssocD"
+ >Instances</h4
+ ><details id="i:AssocD" open="open"
+ ><summary class="hide-when-js-enabled"
+ >Instances details</summary
+ ><table
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:AssocD:AssocD:1"
+ ></span
+ > <span class="keyword"
+ >data</span
+ > <a href="#" title="TypeFamilies"
+ >AssocD</a
+ > <a href="#" title="TypeFamilies"
+ >Y</a
+ ></span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:if:AssocD:AssocD:1"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >TypeFamilies</a
+ ></p
+ > <div class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="#" title="TypeFamilies"
+ >AssocD</a
+ > <a href="#" title="TypeFamilies"
+ >Y</a
+ > = <a id="v:AssocY" class="def"
+ >AssocY</a
+ ></div
+ ></details
+ ></td
+ ></tr
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:AssocD:AssocD:2"
+ ></span
+ > <span class="keyword"
+ >data</span
+ > <a href="#" title="TypeFamilies"
+ >AssocD</a
+ > <a href="#" title="TypeFamilies"
+ >X</a
+ ></span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:if:AssocD:AssocD:2"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >TypeFamilies</a
+ ></p
+ > <div class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="#" title="TypeFamilies"
+ >AssocD</a
+ > <a href="#" title="TypeFamilies"
+ >X</a
+ > = <a id="v:AssocX" class="def"
+ >AssocX</a
+ ></div
+ ></details
+ ></td
+ ></tr
+ ></table
+ ></details
+ ></div
+ ></div
></div
></div
></body
diff --git a/html-test/ref/TypeFamilies3.html b/html-test/ref/TypeFamilies3.html
index f7d78999b3..6023cd104b 100644
--- a/html-test/ref/TypeFamilies3.html
+++ b/html-test/ref/TypeFamilies3.html
@@ -106,7 +106,7 @@
><td class="src"
><a href="#" title="TypeFamilies3"
>Foo</a
- > _ = ()</td
+ > _1 = ()</td
><td class="doc empty"
> </td
></tr
diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html
index 45e6dbe4a9..093c41d17e 100644
--- a/html-test/ref/TypeOperators.html
+++ b/html-test/ref/TypeOperators.html
@@ -81,7 +81,15 @@
>newtype</span
> <a id="t:O" class="def"
>O</a
- > g f a <a href="#" class="selflink"
+ > (g :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) a <a href="#" class="selflink"
>#</a
></p
><div class="subs constructors"
@@ -131,9 +139,19 @@
><p class="src"
><a id="v:biO" class="def"
>biO</a
- > :: (g <a href="#" title="TypeOperators"
- >`O`</a
- > f) a <a href="#" class="selflink"
+ > :: <span class="keyword"
+ >forall</span
+ > (g :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) (f :: <a href="#" title="Data.Kind"
+ >Type</a
+ > -> <a href="#" title="Data.Kind"
+ >Type</a
+ >) a. <a href="#" title="TypeOperators"
+ >O</a
+ > g f a <a href="#" class="selflink"
>#</a
></p
></div
@@ -141,7 +159,9 @@
><p class="src"
><a id="v:f" class="def"
>f</a
- > :: a ~ b => a -> b <a href="#" class="selflink"
+ > :: a <a href="#" title="GHC.Types"
+ >~</a
+ > b => a -> b <a href="#" class="selflink"
>#</a
></p
></div
@@ -149,7 +169,11 @@
><p class="src"
><a id="v:g" class="def"
>g</a
- > :: (a ~ b, b ~ c) => a -> c <a href="#" class="selflink"
+ > :: (a <a href="#" title="GHC.Types"
+ >~</a
+ > b, b <a href="#" title="GHC.Types"
+ >~</a
+ > c) => a -> c <a href="#" class="selflink"
>#</a
></p
></div
@@ -161,9 +185,9 @@
>:-:</a
> a) <a href="#" title="TypeOperators"
><=></a
- > (a <a href="#" title="TypeOperators"
- >`Op`</a
- > a) => a <a href="#" class="selflink"
+ > <a href="#" title="TypeOperators"
+ >Op</a
+ > a a => a <a href="#" class="selflink"
>#</a
></p
></div
@@ -173,9 +197,9 @@
>y</a
> :: (a <a href="#" title="TypeOperators"
><=></a
- > a, (a <a href="#" title="TypeOperators"
- >`Op`</a
- > a) <a href="#" title="TypeOperators"
+ > a, <a href="#" title="TypeOperators"
+ >Op</a
+ > a a <a href="#" title="TypeOperators"
><=></a
> a) => a <a href="#" class="selflink"
>#</a
diff --git a/html-test/ref/mini_IgnoreExports.html b/html-test/ref/mini_IgnoreExports.html
deleted file mode 100644
index e97867f428..0000000000
--- a/html-test/ref/mini_IgnoreExports.html
+++ /dev/null
@@ -1,39 +0,0 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml"
-><head
- ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
- /><title
- >IgnoreExports</title
- ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
- /><script src="haddock-util.js" type="text/javascript"
- ></script
- ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
- ></script
- ><script type="text/javascript"
- >//<![CDATA[
-window.onload = function () {pageLoad();};
-//]]>
-</script
- ></head
- ><body id="mini"
- ><div id="module-header"
- ><p class="caption"
- >IgnoreExports</p
- ></div
- ><div id="interface"
- ><div class="top"
- ><p class="src"
- ><a href="" target="main"
- >foo</a
- ></p
- ></div
- ><div class="top"
- ><p class="src"
- ><a href="" target="main"
- >bar</a
- ></p
- ></div
- ></div
- ></body
- ></html
->
diff --git a/html-test/src/DefaultAssociatedTypes.hs b/html-test/src/DefaultAssociatedTypes.hs
new file mode 100644
index 0000000000..6ad197d399
--- /dev/null
+++ b/html-test/src/DefaultAssociatedTypes.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DefaultSignatures, TypeFamilies #-}
+
+module DefaultAssociatedTypes where
+
+-- | Documentation for Foo.
+class Foo a where
+ -- | Documentation for bar and baz.
+ bar, baz :: a -> String
+
+ -- | Doc for Qux
+ type Qux a :: *
+
+ -- | Doc for default Qux
+ type Qux a = [a]
diff --git a/html-test/src/DefaultSignatures.hs b/html-test/src/DefaultSignatures.hs
new file mode 100644
index 0000000000..52d68a9609
--- /dev/null
+++ b/html-test/src/DefaultSignatures.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE DefaultSignatures #-}
+
+module DefaultSignatures where
+
+-- | Documentation for Foo.
+class Foo a where
+ -- | Documentation for bar and baz.
+ bar, baz :: a -> String
+
+ -- | Documentation for the default signature of bar.
+ default bar :: Show a => a -> String
+ bar = show
+
+ -- | Documentation for baz'.
+ baz' :: String -> a
+
+ -- | Documentation for the default signature of baz'.
+ default baz' :: Read a => String -> a
+ baz' = read
diff --git a/html-test/src/HideRuntimeReps.hs b/html-test/src/HideRuntimeReps.hs
new file mode 100644
index 0000000000..9fa035f78d
--- /dev/null
+++ b/html-test/src/HideRuntimeReps.hs
@@ -0,0 +1,2 @@
+module HideRuntimeReps (($), error) where
+-- Type variables of kind 'RuntimeRep' are hidden by default.
diff --git a/html-test/src/IgnoreExports.hs b/html-test/src/IgnoreExports.hs
deleted file mode 100644
index 0321ad0272..0000000000
--- a/html-test/src/IgnoreExports.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# OPTIONS_HADDOCK ignore-exports #-}
-module IgnoreExports (foo) where
-
--- | documentation for foo
-foo :: Int
-foo = 23
-
--- | documentation for bar
-bar :: Int
-bar = 23
diff --git a/html-test/src/PrefixStarOperator.hs b/html-test/src/PrefixStarOperator.hs
new file mode 100644
index 0000000000..2532099153
--- /dev/null
+++ b/html-test/src/PrefixStarOperator.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE TypeOperators, NoStarIsType #-}
+module PrefixStarOperator where
+type (*) a = (,) a
diff --git a/html-test/src/PrintRuntimeReps.hs b/html-test/src/PrintRuntimeReps.hs
new file mode 100644
index 0000000000..6dce82a77b
--- /dev/null
+++ b/html-test/src/PrintRuntimeReps.hs
@@ -0,0 +1,2 @@
+{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}
+module PrintRuntimeReps (($), error) where
diff --git a/latex-test/ref/DefaultSignatures/DefaultSignatures.tex b/latex-test/ref/DefaultSignatures/DefaultSignatures.tex
new file mode 100644
index 0000000000..63ec7beb16
--- /dev/null
+++ b/latex-test/ref/DefaultSignatures/DefaultSignatures.tex
@@ -0,0 +1,48 @@
+\haddockmoduleheading{DefaultSignatures}
+\label{module:DefaultSignatures}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module DefaultSignatures (
+ Foo(baz', baz, bar)
+ ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+class\ Foo\ a\ where
+\end{tabular}]\haddockbegindoc
+Documentation for Foo.\par
+
+\haddockpremethods{}\emph{Methods}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+bar\ ::\ a\ ->\ String
+\end{tabular}]\haddockbegindoc
+Documentation for bar and baz.\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+default\ bar\ ::\ Show\ a\ =>\ a\ ->\ String
+\end{tabular}]
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+baz\ ::\ a\ ->\ String
+\end{tabular}]\haddockbegindoc
+Documentation for bar and baz.\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+baz'\ ::\ String\ ->\ a
+\end{tabular}]\haddockbegindoc
+Documentation for baz'.\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+default\ baz'\ ::\ Read\ a\ =>\ String\ ->\ a
+\end{tabular}]
+\end{haddockdesc}
+\end{haddockdesc}
\ No newline at end of file
diff --git a/latex-test/ref/DefaultSignatures/haddock.sty b/latex-test/ref/DefaultSignatures/haddock.sty
new file mode 100644
index 0000000000..6e031a98b6
--- /dev/null
+++ b/latex-test/ref/DefaultSignatures/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions. To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+ {\begin{center}\bgroup\large\bfseries}
+ {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''. Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+ {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+ \let\makelabel\haddocklabel}}
+ {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''. I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/DefaultSignatures/main.tex b/latex-test/ref/DefaultSignatures/main.tex
new file mode 100644
index 0000000000..d30eb00840
--- /dev/null
+++ b/latex-test/ref/DefaultSignatures/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{DefaultSignatures}
+\end{document}
\ No newline at end of file
diff --git a/latex-test/ref/Deprecated/Deprecated.tex b/latex-test/ref/Deprecated/Deprecated.tex
new file mode 100644
index 0000000000..fa8fc20ac2
--- /dev/null
+++ b/latex-test/ref/Deprecated/Deprecated.tex
@@ -0,0 +1,17 @@
+\haddockmoduleheading{Deprecated}
+\label{module:Deprecated}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module Deprecated (
+ deprecated
+ ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+deprecated\ ::\ Int
+\end{tabular}]\haddockbegindoc
+Deprecated: Don't use this\par
+Docs for something deprecated\par
+
+\end{haddockdesc}
\ No newline at end of file
diff --git a/latex-test/ref/Deprecated/haddock.sty b/latex-test/ref/Deprecated/haddock.sty
new file mode 100644
index 0000000000..6e031a98b6
--- /dev/null
+++ b/latex-test/ref/Deprecated/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions. To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+ {\begin{center}\bgroup\large\bfseries}
+ {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''. Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+ {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+ \let\makelabel\haddocklabel}}
+ {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''. I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/Deprecated/main.tex b/latex-test/ref/Deprecated/main.tex
new file mode 100644
index 0000000000..76def1cddf
--- /dev/null
+++ b/latex-test/ref/Deprecated/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{Deprecated}
+\end{document}
\ No newline at end of file
diff --git a/latex-test/ref/Example/Example.tex b/latex-test/ref/Example/Example.tex
new file mode 100644
index 0000000000..0a4f057342
--- /dev/null
+++ b/latex-test/ref/Example/Example.tex
@@ -0,0 +1,30 @@
+\haddockmoduleheading{Example}
+\label{module:Example}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module Example (
+ split
+ ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+split\ ::\ Int\ ->\ ()
+\end{tabular}]\haddockbegindoc
+Example use.\par
+\begin{quote}
+{\haddockverb\begin{verbatim}
+>>> split 1
+()
+
+\end{verbatim}}
+\end{quote}
+\begin{quote}
+{\haddockverb\begin{verbatim}
+>>> split 2
+()
+
+\end{verbatim}}
+\end{quote}
+
+\end{haddockdesc}
\ No newline at end of file
diff --git a/latex-test/ref/Example/haddock.sty b/latex-test/ref/Example/haddock.sty
new file mode 100644
index 0000000000..6e031a98b6
--- /dev/null
+++ b/latex-test/ref/Example/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions. To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+ {\begin{center}\bgroup\large\bfseries}
+ {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''. Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+ {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+ \let\makelabel\haddocklabel}}
+ {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''. I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/Example/main.tex b/latex-test/ref/Example/main.tex
new file mode 100644
index 0000000000..66459115f1
--- /dev/null
+++ b/latex-test/ref/Example/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{Example}
+\end{document}
\ No newline at end of file
diff --git a/latex-test/ref/TypeFamilies3/TypeFamilies3.tex b/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
index 2a8ad29747..94dd1e0f35 100644
--- a/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
+++ b/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
@@ -13,7 +13,7 @@ type\ family\ Foo\ a\ where
\end{tabular}]\haddockbegindoc
\haddockbeginargs
\haddockdecltt{Foo () = Int} \\
-\haddockdecltt{Foo \_ = ()} \\
+\haddockdecltt{Foo _1 = ()} \\
\end{tabulary}\par
A closed type family\par
diff --git a/latex-test/src/DefaultSignatures/DefaultSignatures.hs b/latex-test/src/DefaultSignatures/DefaultSignatures.hs
new file mode 100644
index 0000000000..52d68a9609
--- /dev/null
+++ b/latex-test/src/DefaultSignatures/DefaultSignatures.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE DefaultSignatures #-}
+
+module DefaultSignatures where
+
+-- | Documentation for Foo.
+class Foo a where
+ -- | Documentation for bar and baz.
+ bar, baz :: a -> String
+
+ -- | Documentation for the default signature of bar.
+ default bar :: Show a => a -> String
+ bar = show
+
+ -- | Documentation for baz'.
+ baz' :: String -> a
+
+ -- | Documentation for the default signature of baz'.
+ default baz' :: Read a => String -> a
+ baz' = read
diff --git a/latex-test/src/Deprecated/Deprecated.hs b/latex-test/src/Deprecated/Deprecated.hs
new file mode 100644
index 0000000000..aecec94e9b
--- /dev/null
+++ b/latex-test/src/Deprecated/Deprecated.hs
@@ -0,0 +1,7 @@
+module Deprecated where
+
+-- | Docs for something deprecated
+deprecated :: Int
+deprecated = 1
+
+{-# DEPRECATED deprecated "Don't use this" #-}
diff --git a/latex-test/src/Example/Example.hs b/latex-test/src/Example/Example.hs
new file mode 100644
index 0000000000..42ff1646ef
--- /dev/null
+++ b/latex-test/src/Example/Example.hs
@@ -0,0 +1,11 @@
+module Example where
+
+-- | Example use.
+--
+-- >>> split 1
+-- ()
+--
+-- >>> split 2
+-- ()
+split :: Int -> ()
+split _ = ()
--
GitLab