[WIP] Hi Haddock

.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

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

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``

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

haddock-api/src/Documentation/Haddock.hs

@@ -43,7 +43,6 @@ module Documentation.Haddock (
   DocMarkupH(..),
   Documentation(..),
   ArgMap,
-  AliasMap,
   WarningMap,
   DocMap,
   HaddockModInfo(..),

haddock-api/src/Haddock.hs

@@ -500,8 +500,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

haddock-api/src/Haddock/Backends/Hoogle.hs

@@ -263,8 +263,13 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         -- docs for con_names on why it is a list to begin with.
         name = commaSeparate dflags . map unL $ getConNames con
 
-        resType = apps $ map (reL . HsTyVar NoExt NotPromoted . reL) $
-                        (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _ _) <- hsQTvExplicit $ tyClDeclTyVars dat]
+        tyVarArg (UserTyVar _ n) = HsTyVar NoExt NotPromoted n
+        tyVarArg (KindedTyVar _ n lty) = HsKindSig NoExt (reL (HsTyVar NoExt NotPromoted n)) lty
+        tyVarArg _ = panic "ppCtor"
+
+        resType = apps $ map reL $
+                        (HsTyVar NoExt NotPromoted (reL (tcdName dat))) :
+                        map (tyVarArg . unLoc) (hsQTvExplicit $ tyClDeclTyVars dat)
 
 ppCtor dflags _dat subdocs con@(ConDeclGADT { })
    = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f

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
 
 

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

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.
@@ -587,6 +585,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
@@ -612,13 +611,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
 
@@ -960,7 +967,7 @@ ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
 
 pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX
 pp_hs_context []  _       = empty
-pp_hs_context [p] unicode = ppType unicode p
+pp_hs_context [p] unicode = ppCtxType unicode p
 pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
 
 
@@ -995,11 +1002,11 @@ ppLType       unicode y = ppType unicode (unLoc y)
 ppLParendType unicode y = ppParendType unicode (unLoc y)
 ppLFunLhType  unicode y = ppFunLhType unicode (unLoc y)
 
-
-ppType, ppParendType, ppFunLhType :: Bool -> HsType DocNameI -> LaTeX
+ppType, ppParendType, ppFunLhType, ppCtxType :: Bool -> HsType DocNameI -> LaTeX
 ppType       unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
 ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
 ppFunLhType  unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode
+ppCtxType    unicode ty = ppr_mono_ty (reparenTypePrec PREC_CTX ty) unicode
 
 ppLHsTypeArg :: Bool -> LHsTypeArg DocNameI -> LaTeX
 ppLHsTypeArg unicode (HsValArg ty) = ppLParendType unicode ty
@@ -1045,7 +1052,7 @@ ppr_mono_ty (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) tys)
 ppr_mono_ty (HsSumTy _ tys) u       = sumParens (map (ppLType u) tys)
 ppr_mono_ty (HsKindSig _ ty kind) u = parens (ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind)
 ppr_mono_ty (HsListTy _ ty)       u = brackets (ppr_mono_lty ty u)
-ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty ty u)
+ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u
 ppr_mono_ty (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty (HsRecTy {})        _ = text "{..}"
 ppr_mono_ty (XHsType (NHsCoreTy {}))  _ = error "ppr_mono_ty HsCoreTy"
@@ -1110,7 +1117,7 @@ ppVerbOccName :: OccName -> LaTeX
 ppVerbOccName = text . latexFilter . occNameString
 
 ppIPName :: HsIPName -> LaTeX
-ppIPName ip = text $ unpackFS $ hsIPNameFS ip
+ppIPName = text . ('?':) . unpackFS . hsIPNameFS
 
 ppOccName :: OccName -> LaTeX
 ppOccName = text . occNameString
@@ -1177,32 +1184,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 "",
+  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) p -> markupLink u (fmap ($p) 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