From e329a73765c510774e3a3f54472bcdeca48613f6 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Mon, 4 Dec 2017 17:06:31 -0500 Subject: Bump GHC bound to 8.4.* --- haddock.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock.cabal b/haddock.cabal index 53a077cd..af7d7b4f 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -78,7 +78,7 @@ executable haddock xhtml >= 3000.2 && < 3000.3, Cabal >= 1.10, ghc-boot, - ghc == 8.3.*, + ghc == 8.4.*, bytestring, transformers -- cgit v1.2.3 From b91172c51b541b9211c338136e9e3b002a90ff71 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Fri, 19 Jan 2018 15:33:30 +0100 Subject: extractDecl: Extract associated types correctly (#736) --- haddock-api/src/Haddock/Interface/Create.hs | 32 +++++++++++++++++++---------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 27456998..26e293a6 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -999,21 +999,31 @@ extractDecl name decl | otherwise = case unLoc decl of TyClD d@ClassDecl {} -> - let matches = [ lsig - | lsig <- tcdSigs d - , ClassOpSig False _ _ <- pure $ unLoc lsig - -- Note: exclude `default` declarations (see #505) - , name `elem` sigName lsig - ] + let + matchesMethod = + [ lsig + | lsig <- tcdSigs d + , ClassOpSig False _ _ <- pure $ unLoc lsig + -- Note: exclude `default` declarations (see #505) + , name `elem` sigName lsig + ] + + matchesAssociatedType = + [ lfam_decl + | lfam_decl <- tcdATs d + , name == unLoc (fdLName (unLoc lfam_decl)) + ] + -- TODO: document fixity - in case matches of - [s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) - L pos sig = addClassContext n tyvar_names s0 - in L pos (SigD sig) + 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 sig) + (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl)) _ -> 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 matches)) + O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) in if isDataConName name -- cgit v1.2.3 From 25e2050c506ef1a65856cd6676dae0690840b59d Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sat, 20 Jan 2018 10:18:22 +0100 Subject: haddock-api: bump ghc to ^>= 8.4 --- haddock-api/haddock-api.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 660108ac..a91afd36 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -42,7 +42,7 @@ library -- this package typically supports only single major versions build-depends: base ^>= 4.11.0 , Cabal ^>= 2.0.0 - , ghc ^>= 8.3 + , ghc ^>= 8.4 , ghc-paths ^>= 0.1.0.9 , haddock-library ^>= 1.4.6 , xhtml ^>= 3000.2.2 @@ -132,7 +132,7 @@ test-suite spec Haddock.Backends.Hyperlinker.Types build-depends: - ghc ^>= 8.3 + ghc ^>= 8.4 , hspec ^>= 2.4.4 , QuickCheck ^>= 2.10 -- cgit v1.2.3 From 7fd659e1998bf5d1d1665c741a6d82086ef00eab Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sat, 20 Jan 2018 19:18:20 +0100 Subject: Fix duplicate declarations and TypeFamilies specifics --- haddock-api/src/Haddock/Interface/Create.hs | 46 ++++++++++++++++++----------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 26e293a6..2a56e87a 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -115,7 +115,7 @@ createInterface tm flags modMap instIfaceMap = do unrestrictedImportedMods -- module re-exports are only possible with -- explicit export list - | Just _ <- exports + | Just{} <- exports = unrestrictedModuleImports (map unLoc imports) | otherwise = M.empty @@ -689,11 +689,6 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames let declNames = getMainDeclBinder (unL decl) in case () of _ - -- TODO: temp hack: we filter out separately exported ATs, since we haven't decided how - -- to handle them yet. We should really give an warning message also, and filter the - -- name out in mkVisibleNames... - | t `elem` declATs (unL decl) -> return [] - -- We should not show a subordinate by itself if any of its -- parents is also exported. See note [1]. | t `notElem` declNames, @@ -767,7 +762,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames return [ ExportDecl { expItemDecl = restrictTo (fmap fst subs) - (extractDecl (availName avail) decl) + (extractDecl declMap (availName avail) decl) , expItemPats = bundledPatSyns , expItemMbDoc = doc , expItemSubDocs = subs @@ -779,7 +774,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames | otherwise = return [ ExportDecl { - expItemDecl = extractDecl sub decl + expItemDecl = extractDecl declMap sub decl , expItemPats = [] , expItemMbDoc = sub_doc , expItemSubDocs = [] @@ -978,23 +973,32 @@ fullModuleContents :: Bool -- is it a signature -> Avails -> ErrMsgGhc [ExportItem GhcRn] fullModuleContents is_sig modMap thisMod semMod warnings exportedNames - decls maps fixMap splices instIfaceMap dflags avails = do - let availEnv = availsToNameEnv avails + decls maps@(_, _, declMap, _) fixMap splices instIfaceMap dflags avails = do + let availEnv = availsToNameEnv (nubAvails avails) (concat . concat) `fmap` (for decls $ \decl -> do 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 + Just avail + | L _ (ValD valDecl) <- decl + , (name:_) <- collectHsBindBinders valDecl + , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap + -> pure [] + + | otherwise + -> availExportItem is_sig modMap thisMod + semMod warnings exportedNames maps fixMap + splices instIfaceMap dflags avail Nothing -> pure []) - + where + isSigD (L _ SigD{}) = True + isSigD _ = False -- | 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 :: Name -> LHsDecl GhcRn -> LHsDecl GhcRn -extractDecl name decl +extractDecl :: DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn +extractDecl declMap name decl | name `elem` getMainDeclBinder (unLoc decl) = decl | otherwise = case unLoc decl of @@ -1020,6 +1024,10 @@ extractDecl name decl L pos sig = addClassContext n tyvar_names s0 in L pos (SigD sig) (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl)) + + ([], []) + | Just (famInstDecl:_) <- M.lookup name declMap + -> extractDecl declMap 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:" @@ -1029,6 +1037,10 @@ extractDecl name decl in if isDataConName name then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d)) else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) + TyClD FamDecl {} + | isValName name + , Just (famInst:_) <- M.lookup name declMap + -> extractDecl declMap name famInst InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n , feqn_pats = tys @@ -1044,7 +1056,7 @@ extractDecl name decl , selectorFieldOcc n == name ] in case matches of - [d0] -> extractDecl name (noLoc . InstD $ DataFamInstD d0) + [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0) _ -> error "internal: extractDecl (ClsInstD)" _ -> error "internal: extractDecl" -- cgit v1.2.3 From f1a6a6c9c0538fc329054d4fb4d717371d456886 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 6 Jan 2018 08:20:43 -0800 Subject: Pass to GHC visible modules for instance filtering The GHC-side `getNameToInstancesIndex` filters out incorrectly some instances because it is not aware of what modules are visible. On the Haddock side, we need to pass in the modules we are processing. On the GHC side, we need to check against _those_ modules when checking if an instance is visible. --- haddock-api/src/Haddock/Interface/AttachInstances.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 2231ce7e..4fd9d264 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -54,7 +54,7 @@ type ExportInfo = (ExportedNames, Modules) -- Also attaches fixities attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface] attachInstances expInfo ifaces instIfaceMap = do - (_msgs, mb_index) <- getNameToInstancesIndex + (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces) mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces where -- TODO: take an IfaceMap as input -- cgit v1.2.3 From deddced31cabadf62fe01fff77b094cd005e52a1 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 15 Jan 2018 17:12:18 -0800 Subject: Update the GblRdrEnv when processing modules Without a complete environment, we will miss some instances that were encountered during typechecking. --- haddock-api/src/Haddock/Interface.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 20689a8f..cbdf81cb 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -58,6 +58,8 @@ import GHC hiding (verbosity) import HscTypes import FastString (unpackFS) import MonadUtils (liftIO) +import TcRnTypes (tcg_rdr_env) +import RdrName (plusGlobalRdrEnv) #if defined(mingw32_HOST_OS) import System.IO @@ -163,6 +165,18 @@ processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap - processModule verbosity modsum flags modMap instIfaceMap = do out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..." tm <- loadModule =<< typecheckModule =<< parseModule modsum + + -- We need to modify the interactive context's environment so that when + -- Haddock later looks for instances, it also looks in the modules it + -- encountered while typechecking. + -- + -- See https://github.com/haskell/haddock/issues/469. + hsc_env@HscEnv{ hsc_IC = old_IC } <- getSession + let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm + setSession hsc_env{ hsc_IC = old_IC { + ic_rn_gbl_env = ic_rn_gbl_env old_IC `plusGlobalRdrEnv` new_rdr_env + } } + if not $ isBootSummary modsum then do out verbosity verbose "Creating interface..." (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap -- cgit v1.2.3 From 60e10eb876899165e9644013508361bf72048bdb Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 14 Nov 2017 09:21:30 -0500 Subject: Fix #548 by rendering datatype kinds more carefully (#702) --- .gitignore | 2 + haddock-api/src/Haddock/Convert.hs | 27 +- html-test/ref/Bug548.html | 600 +++++++++++++++++++++++++++++++++++++ html-test/src/Bug548.hs | 3 + 4 files changed, 629 insertions(+), 3 deletions(-) create mode 100644 html-test/ref/Bug548.html create mode 100644 html-test/src/Bug548.hs diff --git a/.gitignore b/.gitignore index 327f0121..d65138d1 100644 --- a/.gitignore +++ b/.gitignore @@ -25,5 +25,7 @@ TAGS .cabal-sandbox .ghc.environment.* cabal.sandbox.config +cabal.project.local +cabal.project.local~ .stack-work/ diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index fc808568..b712660f 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -164,7 +164,7 @@ synifyTyCon _coax tc -- algebraic data nor newtype: , dd_ctxt = noLoc [] , dd_cType = Nothing - , dd_kindSig = Just (synifyKindSig (tyConKind tc)) + , dd_kindSig = synifyDataTyConReturnKind tc -- we have their kind accurately: , dd_cons = [] -- No constructors , dd_derivs = noLoc [] } @@ -219,7 +219,7 @@ synifyTyCon coax tc -- CoAxioms, not their TyCons _ -> synifyName tc tyvars = synifyTyVars (tyConVisibleTyVars tc) - kindSig = Just (tyConKind tc) + kindSig = synifyDataTyConReturnKind tc -- The data constructors. -- -- Any data-constructors not exported from the module that *defines* the @@ -244,7 +244,7 @@ synifyTyCon coax tc defn = HsDataDefn { dd_ND = alg_nd , dd_ctxt = alg_ctx , dd_cType = Nothing - , dd_kindSig = fmap synifyKindSig kindSig + , dd_kindSig = kindSig , dd_cons = cons , dd_derivs = alg_deriv } in case lefts consRaw of @@ -254,6 +254,27 @@ synifyTyCon coax tc , tcdDataCusk = False, tcdFVs = placeHolderNamesTc } dataConErrs -> Left $ unlines dataConErrs +-- In this module, every TyCon being considered has come from an interface +-- file. This means that when considering a data type constructor such as: +-- +-- data Foo (w :: *) (m :: * -> *) (a :: *) +-- +-- Then its tyConKind will be (* -> (* -> *) -> * -> *). But beware! We are +-- also rendering the type variables of Foo, so if we synify the tyConKind of +-- Foo in full, we will end up displaying this in Haddock: +-- +-- data Foo (w :: *) (m :: * -> *) (a :: *) +-- :: * -> (* -> *) -> * -> * +-- +-- Which is entirely wrong (#548). We only want to display the *return* kind, +-- which this function obtains. +synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind Name) +synifyDataTyConReturnKind tc + = case splitFunTys (tyConKind tc) of + (_, ret_kind) + | isLiftedTypeKind ret_kind -> Nothing -- Don't bother displaying :: * + | otherwise -> Just (synifyKindSig ret_kind) + synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity -> Maybe (LInjectivityAnn GhcRn) synifyInjectivityAnn Nothing _ _ = Nothing diff --git a/html-test/ref/Bug548.html b/html-test/ref/Bug548.html new file mode 100644 index 00000000..1ae91878 --- /dev/null +++ b/html-test/ref/Bug548.html @@ -0,0 +1,600 @@ +Bug548
Safe HaskellSafe

Bug548

Documentation

newtype WrappedArrow (a :: * -> * -> *) b c #

Constructors

WrapArrow

Fields

Instances
Generic1 * (WrappedArrow a b)
Instance details

Associated Types

type Rep1 (WrappedArrow a b) (f :: WrappedArrow a b -> *) :: k -> * #

Methods

from1 :: f a0 -> Rep1 (WrappedArrow a b) f a0 #

to1 :: Rep1 (WrappedArrow a b) f a0 -> f a0 #

Arrow a => Functor (WrappedArrow a b)

Since: 2.1

Instance details

Methods

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

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

Arrow a => Applicative (WrappedArrow a b)

Since: 2.1

Instance details

Methods

pure :: a0 -> WrappedArrow a b a0 #

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

liftA2 :: (a0 -> b0 -> c) -> WrappedArrow a b a0 -> WrappedArrow a b b0 -> WrappedArrow a b c #

(*>) :: WrappedArrow a b a0 -> WrappedArrow a b b0 -> WrappedArrow a b b0 #

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

(ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b)

Since: 2.1

Instance details

Methods

empty :: WrappedArrow a b a0 #

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

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

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

Generic (WrappedArrow a b c)
Instance details

Associated Types

type Rep (WrappedArrow a b c) :: * -> * #

Methods

from :: WrappedArrow a b c -> Rep (WrappedArrow a b c) x #

to :: Rep (WrappedArrow a b c) x -> WrappedArrow a b c #

type Rep1 * (WrappedArrow a b)
Instance details
type Rep1 * (WrappedArrow a b) = D1 * (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 * (MetaCons "WrapArrow" PrefixI True) (S1 * (MetaSel (Just Symbol "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 * (a b))))
type Rep (WrappedArrow a b c)
Instance details
type Rep (WrappedArrow a b c) = D1 * (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 * (MetaCons "WrapArrow" PrefixI True) (S1 * (MetaSel (Just Symbol "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (a b c))))
\ No newline at end of file diff --git a/html-test/src/Bug548.hs b/html-test/src/Bug548.hs new file mode 100644 index 00000000..652d3d32 --- /dev/null +++ b/html-test/src/Bug548.hs @@ -0,0 +1,3 @@ +module Bug548 (WrappedArrow(..)) where + +import Control.Applicative -- cgit v1.2.3 From 4f75be94f45a0e92553eccefe56230c554333ce7 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 10 Dec 2017 12:22:21 -0800 Subject: Use the GHC lexer for the Hyperlinker backend (#714) * Start changing to use GHC lexer * better cpp * Change SrcSpan to RealSrcSpan * Remove error * Try to stop too many open files * wip * wip * Revert "wip" This reverts commit b605510a195f26315e3d8ca90e6d95a6737553e1. Conflicts: haddock-api/haddock-api.cabal haddock-api/src/Haddock/Interface.hs * Remove pointless 'caching' * Use dlist rather than lists when finding vars * Use a map rather than list * Delete bogus comment * Rebase followup Things now run using the GHC lexer. There are still - stray debug statements - unnecessary changes w.r.t. master * Cleaned up differences w.r.t. current Haddock HEAD Things are looking good. quasiquotes in particular look beautiful: the TH ones (with Haskell source inside) colour/link their contents too! Haven't yet begun to check for possible performance problems. * Support CPP and top-level pragmas The support for these is hackier - but no more hacky than the existing support. * Tests pass, CPP is better recognized The tests were in some cases altered: I consider the new output to be more correct than the old one.... * Fix shrinking of source without tabs in test * Replace 'Position'/'Span' with GHC counterparts Replaces 'Position' -> 'GHC.RealSrcLoc' and 'Span' -> 'GHC.RealSrcSpan'. * Nits * Forgot entry in .cabal * Update changelog --- CHANGES.md | 3 + haddock-api/haddock-api.cabal | 62 ++- haddock-api/src/Haddock.hs | 2 +- .../src/Haddock/Backends/Hyperlinker/Ast.hs | 19 +- .../src/Haddock/Backends/Hyperlinker/Parser.hs | 534 +++++++++++++-------- .../src/Haddock/Backends/Hyperlinker/Renderer.hs | 14 +- .../src/Haddock/Backends/Hyperlinker/Types.hs | 33 +- haddock-api/src/Haddock/Interface/Create.hs | 24 +- .../Haddock/Backends/Hyperlinker/ParserSpec.hs | 135 ++++-- hypsrc-test/ref/src/Identifiers.html | 8 +- 10 files changed, 522 insertions(+), 312 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 19417d12..b4d69ce4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,6 +19,9 @@ * Fix: Generate constraint signatures for constructors exported as pattern synonyms (#663) + * The hyperlinker backend now uses the GHC lexer instead of a custom one. + This notably fixes rendering of quasiquotes. + * Overhaul Haddock's rendering of kind signatures so that invisible kind parameters are not printed (#681) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index a91afd36..95af5ef5 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -124,24 +124,68 @@ test-suite spec test , src - -- NB: We only use a small subset of lib:haddock-api here, which - -- explains why this component has a smaller build-depends set other-modules: + Haddock + Haddock.Backends.Hoogle + Haddock.Backends.Hyperlinker + Haddock.Backends.Hyperlinker.Ast + Haddock.Backends.Hyperlinker.Renderer + Haddock.Backends.Hyperlinker.Utils + Haddock.Backends.LaTeX + Haddock.Backends.Xhtml + Haddock.Backends.Xhtml.Decl + Haddock.Backends.Xhtml.DocMarkup + Haddock.Backends.Xhtml.Layout + Haddock.Backends.Xhtml.Meta + Haddock.Backends.Xhtml.Names + Haddock.Backends.Xhtml.Themes + Haddock.Backends.Xhtml.Types + Haddock.Backends.Xhtml.Utils + Haddock.Convert + Haddock.Doc + Haddock.GhcUtils + Haddock.Interface + Haddock.Interface.AttachInstances + Haddock.Interface.Create + Haddock.Interface.Json + Haddock.Interface.LexParseRn + Haddock.Interface.ParseModuleHeader + Haddock.Interface.Rename + Haddock.Interface.Specialize + Haddock.InterfaceFile + Haddock.ModuleTree + Haddock.Options + Haddock.Parser + Haddock.Syb + Haddock.Types + Haddock.Utils + Haddock.Utils.Json + Haddock.Version + Paths_haddock_api Haddock.Backends.Hyperlinker.ParserSpec Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Types - build-depends: - ghc ^>= 8.4 - , hspec ^>= 2.4.4 - , QuickCheck ^>= 2.10 + build-depends: Cabal ^>= 2.0.0 + , ghc ^>= 8.4 + , ghc-paths ^>= 0.1.0.9 + , haddock-library ^>= 1.4.6 + , xhtml ^>= 3000.2.2 + , hspec ^>= 2.4.4 + , QuickCheck ^>= 2.10 -- Versions for the dependencies below are transitively pinned by -- the non-reinstallable `ghc` package and hence need no version -- bounds - build-depends: - base - , containers + build-depends: base + , array + , bytestring + , containers + , deepseq + , directory + , filepath + , ghc-boot + , transformers build-tool-depends: hspec-discover:hspec-discover ^>= 2.4.4 diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index f7fa52b3..3f5e5298 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -277,7 +277,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat | otherwise = srcModule - srcMap = mkSrcMap $ Map.union + srcMap = Map.union (Map.map SrcExternal extSrcMap) (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ]) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 57ff72ff..361bc15d 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -12,6 +12,7 @@ import qualified Haddock.Syb as Syb import Haddock.Backends.Hyperlinker.Types import qualified GHC +import qualified SrcLoc import Control.Applicative import Control.Monad (guard) @@ -51,10 +52,10 @@ type DetailsMap = Map.Map Position (Span, TokenDetails) mkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap mkDetailsMap xs = - Map.fromListWith select_details [ (start, (token_span, token_details)) + Map.fromListWith select_details [ (start, (span, token_details)) | (ghc_span, token_details) <- xs - , Just !token_span <- [ghcSrcSpanToSpan ghc_span] - , let start = spStart token_span + , GHC.RealSrcSpan span <- [ghc_span] + , let start = SrcLoc.realSrcSpanStart span ] where -- favour token details which appear earlier in the list @@ -62,17 +63,11 @@ mkDetailsMap xs = lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails lookupBySpan span details = do - (_, (tok_span, tok_details)) <- Map.lookupLE (spStart span) details - guard (tok_span `containsSpan` span ) + let pos = SrcLoc.realSrcSpanStart span + (_, (tok_span, tok_details)) <- Map.lookupLE pos details + guard (tok_span `SrcLoc.containsSpan` span) return tok_details -ghcSrcSpanToSpan :: GHC.SrcSpan -> Maybe Span -ghcSrcSpanToSpan (GHC.RealSrcSpan span) = - Just (Span { spStart = Position (GHC.srcSpanStartLine span) (GHC.srcSpanStartCol span) - , spEnd = Position (GHC.srcSpanEndLine span) (GHC.srcSpanEndCol span) - }) -ghcSrcSpanToSpan _ = Nothing - enrichToken :: Token -> DetailsMap -> Maybe TokenDetails enrichToken (Token typ _ spn) dm | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index e4345602..da1555b8 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -1,11 +1,17 @@ module Haddock.Backends.Hyperlinker.Parser (parse) where +import Data.Either ( isRight, isLeft ) +import Data.List ( foldl', isPrefixOf, isSuffixOf ) +import Data.Maybe ( maybeToList ) -import Data.Char -import Data.List -import Data.Maybe +import GHC ( DynFlags, addSourceToTokens ) +import SrcLoc +import FastString ( mkFastString ) +import StringBuffer ( stringToStringBuffer ) +import Lexer ( Token(..) ) +import qualified Lexer as L -import Haddock.Backends.Hyperlinker.Types +import Haddock.Backends.Hyperlinker.Types as T -- | Turn source code string into a stream of more descriptive tokens. @@ -13,202 +19,350 @@ import Haddock.Backends.Hyperlinker.Types -- Result should retain original file layout (including comments, whitespace, -- etc.), i.e. the following "law" should hold: -- --- @concat . map 'tkValue' . 'parse' = id@ -parse :: String -> [Token] -parse = tokenize . tag . chunk +-- prop> concat . map tkValue . parse = id +-- +-- (In reality, this only holds for input not containing '\r', '\t', '\f', '\v', +-- characters, since GHC transforms those into ' ' and '\n') +parse :: DynFlags -> FilePath -> String -> [T.Token] +parse dflags fp s = ghcToks (processCPP dflags fp s) + --- | Split raw source string to more meaningful chunks. +-- | Parse the source into tokens using the GHC lexer. +-- +-- * CPP lines are removed and reinserted as line-comments +-- * top-level file pragmas are parsed as block comments (see the +-- 'ITblockComment' case of 'classify' for more details) -- --- This is the initial stage of tokenization process. Each chunk is either --- a comment (including comment delimiters), a whitespace string, preprocessor --- macro (and all its content until the end of a line) or valid Haskell lexeme. -chunk :: String -> [String] -chunk [] = [] -chunk str@(c:_) - | isSpace c = - let (space, mcpp, rest) = spanSpaceOrCpp str - in [space] ++ maybeToList mcpp ++ chunk rest -chunk str - | "--" `isPrefixOf` str = chunk' $ spanToNewline str - | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str - | otherwise = case lex' str of - (tok:_) -> chunk' tok - [] -> [str] +processCPP :: DynFlags -- ^ GHC's flags + -> FilePath -- ^ source file name (for position information) + -> String -- ^ source file contents + -> [(Located L.Token, String)] +processCPP dflags fpath s = addSrc . go start . splitCPP $ s where - chunk' (c, rest) = c:(chunk rest) + start = mkRealSrcLoc (mkFastString fpath) 1 1 + addSrc = addSourceToTokens start (stringToStringBuffer s) --- | A bit better lexer then the default, i.e. handles DataKinds quotes -lex' :: ReadS String -lex' ('\'' : '\'' : rest) = [("''", rest)] -lex' str@('\'' : '\\' : _ : '\'' : _) = lex str -lex' str@('\'' : _ : '\'' : _) = lex str -lex' ('\'' : rest) = [("'", rest)] -lex' str = lex str + -- Transform a list of Haskell/CPP lines into a list of tokens + go :: RealSrcLoc -> [Either String String] -> [Located L.Token] + go _ [] = [] + go pos ls = + let (hLinesRight, ls') = span isRight ls + (cppLinesLeft, rest) = span isLeft ls' + + hSrc = concat [ hLine | Right hLine <- hLinesRight ] + cppSrc = concat [ cppLine | Left cppLine <- cppLinesLeft ] + + in case L.lexTokenStream (stringToStringBuffer hSrc) pos dflags of --- | Split input to "first line" string and the rest of it. --- --- Ideally, this should be done simply with @'break' (== '\n')@. However, --- Haskell also allows line-unbreaking (or whatever it is called) so things --- are not as simple and this function deals with that. -spanToNewline :: String -> (String, String) -spanToNewline [] = ([], []) -spanToNewline ('\\':'\n':str) = - let (str', rest) = spanToNewline str - in ('\\':'\n':str', rest) -spanToNewline str@('\n':_) = ("", str) -spanToNewline (c:str) = - let (str', rest) = spanToNewline str - in (c:str', rest) + -- Stuff that fails to lex gets turned into comments + L.PFailed _ss _msg -> + let (src_pos, failed) = mkToken ITunknown pos hSrc + (new_pos, cpp) = mkToken ITlineComment src_pos cppSrc + in failed : cpp : go new_pos rest --- | Split input to whitespace string, (optional) preprocessor directive and --- the rest of it. + -- Successfully lexed + L.POk ss toks -> + let (new_pos, cpp) = mkToken ITlineComment (L.loc ss) cppSrc + in toks ++ [cpp] ++ go new_pos rest + + -- Manually make a token from a 'String', advancing the cursor position + mkToken tok start' str = + let end = foldl' advanceSrcLoc start' str + in (end, L (RealSrcSpan $ mkRealSrcSpan start' end) (tok str)) + + +-- | Split apart the initial file into Haskell source lines ('Left' entries) and +-- CPP lines ('Right' entries). -- --- Again, using something like @'span' 'isSpace'@ would be nice to chunk input --- to whitespace. The problem is with /#/ symbol - if it is placed at the very --- beginning of a line, it should be recognized as preprocessor macro. In any --- other case, it is ordinary Haskell symbol and can be used to declare --- operators. Hence, while dealing with whitespace we also check whether there --- happens to be /#/ symbol just after a newline character - if that is the --- case, we begin treating the whole line as preprocessor macro. -spanSpaceOrCpp :: String -> (String, Maybe String, String) -spanSpaceOrCpp ('\n':'#':str) = - let (str', rest) = spanToNewline str - in ("\n", Just $ '#':str', rest) -spanSpaceOrCpp (c:str') - | isSpace c = - let (space, mcpp, rest) = spanSpaceOrCpp str' - in (c:space, mcpp, rest) -spanSpaceOrCpp str = ("", Nothing, str) - --- | Split input to comment content (including delimiters) and the rest. +-- All characters in the input are present in the output: -- --- Again, some more logic than simple 'span' is required because of Haskell --- comment nesting policy. -chunkComment :: Int -> String -> (String, String) -chunkComment _ [] = ("", "") -chunkComment depth ('{':'-':str) = - let (c, rest) = chunkComment (depth + 1) str - in ("{-" ++ c, rest) -chunkComment depth ('-':'}':str) - | depth == 1 = ("-}", str) - | otherwise = - let (c, rest) = chunkComment (depth - 1) str - in ("-}" ++ c, rest) -chunkComment depth (e:str) = - let (c, rest) = chunkComment depth str - in (e:c, rest) - --- | Assign source location for each chunk in given stream. -tag :: [String] -> [(Span, String)] -tag = - reverse . snd . foldl aux (Position 1 1, []) - where - aux (pos, cs) str = - let pos' = foldl move pos str - in (pos', (Span pos pos', str):cs) - move pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 } - move pos _ = pos { posCol = posCol pos + 1 } - --- | Turn unrecognised chunk stream to more descriptive token stream. -tokenize :: [(Span, String)] -> [Token] -tokenize = - map aux +-- prop> concat . map (either id id) . splitCPP = id +splitCPP :: String -> [Either String String] +splitCPP "" = [] +splitCPP s | isCPPline s = Left l : splitCPP rest + | otherwise = Right l : splitCPP rest where - aux (sp, str) = Token - { tkType = classify str - , tkValue = str - , tkSpan = sp - } + ~(l, rest) = spanToNewline 0 s --- | Classify given string as appropriate Haskell token. + +-- | Heuristic to decide if a line is going to be a CPP line. This should be a +-- cheap operation since it is going to be run on every line being processed. -- --- This method is based on Haskell 98 Report lexical structure description: --- https://www.haskell.org/onlinereport/lexemes.html +-- Right now it just checks if the first non-whitespace character in the first +-- five characters of the line is a '#': -- --- However, this is probably far from being perfect and most probably does not --- handle correctly all corner cases. -classify :: String -> TokenType -classify str - | "--" `isPrefixOf` str = TkComment - | "{-#" `isPrefixOf` str = TkPragma - | "{-" `isPrefixOf` str = TkComment -classify "''" = TkSpecial -classify "'" = TkSpecial -classify str@(c:_) - | isSpace c = TkSpace - | isDigit c = TkNumber - | c `elem` special = TkSpecial - | str `elem` glyphs = TkGlyph - | all (`elem` symbols) str = TkOperator - | c == '#' = TkCpp - | c == '"' = TkString - | c == '\'' = TkChar -classify str - | str `elem` keywords = TkKeyword - | isIdentifier str = TkIdentifier - | otherwise = TkUnknown - -keywords :: [String] -keywords = - [ "as" - , "case" - , "class" - , "data" - , "default" - , "deriving" - , "do" - , "else" - , "hiding" - , "if" - , "import" - , "in" - , "infix" - , "infixl" - , "infixr" - , "instance" - , "let" - , "module" - , "newtype" - , "of" - , "qualified" - , "then" - , "type" - , "where" - , "forall" - , "family" - , "mdo" - ] - -glyphs :: [String] -glyphs = - [ ".." - , ":" - , "::" - , "=" - , "\\" - , "|" - , "<-" - , "->" - , "@" - , "~" - , "~#" - , "=>" - , "-" - , "!" - ] - -special :: [Char] -special = "()[]{},;`" - --- TODO: Add support for any Unicode symbol or punctuation. --- source: http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators -symbols :: [Char] -symbols = "!#$%&*+./<=>?@\\^|-~:" - -isIdentifier :: String -> Bool -isIdentifier (s:str) - | (isLower' s || isUpper s) && all isAlphaNum' str = True +-- >>> isCPPline "#define FOO 1" +-- True +-- +-- >>> isCPPline "\t\t #ifdef GHC" +-- True +-- +-- >>> isCPPline " #endif" +-- False +-- +isCPPline :: String -> Bool +isCPPline = isPrefixOf "#" . dropWhile (`elem` " \t") . take 5 + + +-- | Split a "line" off the front of a string, supporting newline escapes. +-- +-- By "line", we understand: the shortest substring ending in a '\n' that is not +-- +-- 1. immediately preceded by a '\\' +-- 2. not inside some (possibly nested) block comment +-- +-- All characters in the input are present in the output: +-- +-- prop> curry (++) . spanToNewLine 0 = id +spanToNewline :: Int -- ^ open '{-' + -> String -- ^ input + -> (String, String) +spanToNewline _ [] = ([], []) +spanToNewline n ('\n':str) | n <= 0 = ("\n", str) +spanToNewline n ('\\':'\n':str) = + let (str', rest) = spanToNewline n str + in ('\\':'\n':str', rest) +spanToNewline n ('{':'-':str) = + let (str', rest) = spanToNewline (n+1) str + in ('{':'-':str', rest) +spanToNewline n ('-':'}':str) = + let (str', rest) = spanToNewline (n-1) str + in ('-':'}':str', rest) +spanToNewline n (c:str) = + let (str', rest) = spanToNewline n str + in (c:str', rest) + + +-- | Turn a list of GHC's 'L.Token' (and their source 'String') into a list of +-- Haddock's 'T.Token'. +ghcToks :: [(Located L.Token, String)] -> [T.Token] +ghcToks = reverse . snd . foldl' go (start, []) where - isLower' c = isLower c || c == '_' - isAlphaNum' c = isAlphaNum c || c == '_' || c == '\'' -isIdentifier _ = False + start = mkRealSrcLoc (mkFastString "lexing") 1 1 + + go :: (RealSrcLoc, [T.Token]) -- ^ current position, tokens accumulated + -> (Located L.Token, String) -- ^ next token, its content + -> (RealSrcLoc, [T.Token]) -- ^ new position, new tokens accumulated + go (pos, toks) (L l tok, raw) = ( next_pos + , classifiedTok ++ maybeToList white ++ toks + ) + where + (next_pos, white) = mkWhitespace pos l + classifiedTok = [ Token (classify tok) raw rss + | RealSrcSpan rss <- [l] + , not (null raw) + ] + +-- | Find the correct amount of whitespace between tokens. +mkWhitespace :: RealSrcLoc -> SrcSpan -> (RealSrcLoc, Maybe T.Token) +mkWhitespace prev spn = + case spn of + UnhelpfulSpan _ -> (prev,Nothing) + RealSrcSpan s | null wsstring -> (end, Nothing) + | otherwise -> (end, Just (Token TkSpace wsstring wsspan)) + where + start = realSrcSpanStart s + end = realSrcSpanEnd s + wsspan = mkRealSrcSpan prev start + nls = srcLocLine start - srcLocLine prev + spaces = if nls == 0 then srcLocCol start - srcLocCol prev + else srcLocCol start - 1 + wsstring = replicate nls '\n' ++ replicate spaces ' ' + + +-- | Classify given string as appropriate Haskell token. +classify :: L.Token -> TokenType +classify tok = + case tok of + ITas -> TkKeyword + ITcase -> TkKeyword + ITclass -> TkKeyword + ITdata -> TkKeyword + ITdefault -> TkKeyword + ITderiving -> TkKeyword + ITdo -> TkKeyword + ITelse -> TkKeyword + IThiding -> TkKeyword + ITforeign -> TkKeyword + ITif -> TkKeyword + ITimport -> TkKeyword + ITin -> TkKeyword + ITinfix -> TkKeyword + ITinfixl -> TkKeyword + ITinfixr -> TkKeyword + ITinstance -> TkKeyword + ITlet -> TkKeyword + ITmodule -> TkKeyword + ITnewtype -> TkKeyword + ITof -> TkKeyword + ITqualified -> TkKeyword + ITthen -> TkKeyword + ITtype -> TkKeyword + ITwhere -> TkKeyword + + ITforall {} -> TkKeyword + ITexport -> TkKeyword + ITlabel -> TkKeyword + ITdynamic -> TkKeyword + ITsafe -> TkKeyword + ITinterruptible -> TkKeyword + ITunsafe -> TkKeyword + ITstdcallconv -> TkKeyword + ITccallconv -> TkKeyword + ITcapiconv -> TkKeyword + ITprimcallconv -> TkKeyword + ITjavascriptcallconv -> TkKeyword + ITmdo -> TkKeyword + ITfamily -> TkKeyword + ITrole -> TkKeyword + ITgroup -> TkKeyword + ITby -> TkKeyword + ITusing -> TkKeyword + ITpattern -> TkKeyword + ITstatic -> TkKeyword + ITstock -> TkKeyword + ITanyclass -> TkKeyword + + ITunit -> TkKeyword + ITsignature -> TkKeyword + ITdependency -> TkKeyword + ITrequires -> TkKeyword + + ITinline_prag {} -> TkPragma + ITspec_prag {} -> TkPragma + ITspec_inline_prag {} -> TkPragma + ITsource_prag {} -> TkPragma + ITrules_prag {} -> TkPragma + ITwarning_prag {} -> TkPragma + ITdeprecated_prag {} -> TkPragma + ITline_prag -> TkPragma + ITscc_prag {} -> TkPragma + ITgenerated_prag {} -> TkPragma + ITcore_prag {} -> TkPragma + ITunpack_prag {} -> TkPragma + ITnounpack_prag {} -> TkPragma + ITann_prag {} -> TkPragma + ITcomplete_prag {} -> TkPragma + ITclose_prag -> TkPragma + IToptions_prag {} -> TkPragma + ITinclude_prag {} -> TkPragma + ITlanguage_prag -> TkPragma + ITvect_prag {} -> TkPragma + ITvect_scalar_prag {} -> TkPragma + ITnovect_prag {} -> TkPragma + ITminimal_prag {} -> TkPragma + IToverlappable_prag {} -> TkPragma + IToverlapping_prag {} -> TkPragma + IToverlaps_prag {} -> TkPragma + ITincoherent_prag {} -> TkPragma + ITctype {} -> TkPragma + + ITdotdot -> TkGlyph + ITcolon -> TkGlyph + ITdcolon {} -> TkGlyph + ITequal -> TkGlyph + ITlam -> TkGlyph + ITlcase -> TkGlyph + ITvbar -> TkGlyph + ITlarrow {} -> TkGlyph + ITrarrow {} -> TkGlyph + ITat -> TkGlyph + ITtilde -> TkGlyph + ITtildehsh -> TkGlyph + ITdarrow {} -> TkGlyph + ITminus -> TkGlyph + ITbang -> TkGlyph + ITdot -> TkOperator + ITtypeApp -> TkGlyph + + ITbiglam -> TkGlyph + + ITocurly -> TkSpecial + ITccurly -> TkSpecial + ITvocurly -> TkSpecial + ITvccurly -> TkSpecial + ITobrack -> TkSpecial + ITopabrack -> TkSpecial + ITcpabrack -> TkSpecial + ITcbrack -> TkSpecial + IToparen -> TkSpecial + ITcparen -> TkSpecial + IToubxparen -> TkSpecial + ITcubxparen -> TkSpecial + ITsemi -> TkSpecial + ITcomma -> TkSpecial + ITunderscore -> TkIdentifier + ITbackquote -> TkSpecial + ITsimpleQuote -> TkSpecial + + ITvarid {} -> TkIdentifier + ITconid {} -> TkIdentifier + ITvarsym {} -> TkOperator + ITconsym {} -> TkOperator + ITqvarid {} -> TkIdentifier + ITqconid {} -> TkIdentifier + ITqvarsym {} -> TkOperator + ITqconsym {} -> TkOperator + + ITdupipvarid {} -> TkUnknown + ITlabelvarid {} -> TkUnknown + + ITchar {} -> TkChar + ITstring {} -> TkString + ITinteger {} -> TkNumber + ITrational {} -> TkNumber + + ITprimchar {} -> TkChar + ITprimstring {} -> TkString + ITprimint {} -> TkNumber + ITprimword {} -> TkNumber + ITprimfloat {} -> TkNumber + ITprimdouble {} -> TkNumber + + ITopenExpQuote {} -> TkSpecial + ITopenPatQuote -> TkSpecial + ITopenDecQuote -> TkSpecial + ITopenTypQuote -> TkSpecial + ITcloseQuote {} -> TkSpecial + ITopenTExpQuote {} -> TkSpecial + ITcloseTExpQuote -> TkSpecial + ITidEscape {} -> TkUnknown + ITparenEscape -> TkSpecial + ITidTyEscape {} -> TkUnknown + ITparenTyEscape -> TkSpecial + ITtyQuote -> TkSpecial + ITquasiQuote {} -> TkUnknown + ITqQuasiQuote {} -> TkUnknown + + ITproc -> TkKeyword + ITrec -> TkKeyword + IToparenbar {} -> TkGlyph + ITcparenbar {} -> TkGlyph + ITlarrowtail {} -> TkGlyph + ITrarrowtail {} -> TkGlyph + ITLarrowtail {} -> TkGlyph + ITRarrowtail {} -> TkGlyph + + ITunknown {} -> TkUnknown + ITeof -> TkUnknown + + -- Line comments are only supposed to start with '--'. Starting with '#' + -- means that this was probably a CPP. + ITlineComment s + | isCPPline s -> TkCpp + | otherwise -> TkComment + + ITdocCommentNext {} -> TkComment + ITdocCommentPrev {} -> TkComment + ITdocCommentNamed {} -> TkComment + ITdocSection {} -> TkComment + ITdocOptions {} -> TkComment + + -- The lexer considers top-level pragmas as comments (see `pragState` in + -- the GHC lexer for more), so we have to manually reverse this. The + -- following is a hammer: it smashes _all_ pragma-like block comments into + -- pragmas. + ITblockComment c + | isPrefixOf "{-#" c + , isSuffixOf "#-}" c -> TkPragma + | otherwise -> TkComment diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 15793f0c..27bf7605 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -82,7 +82,7 @@ header mcss mjs = tokenGroup :: SrcMap -> TokenGroup -> Html tokenGroup _ (GrpNormal tok@(Token { .. })) - | tkType == TkSpace = renderSpace (posRow . spStart $ tkSpan) tkValue + | tkType == TkSpace = renderSpace (GHC.srcSpanStartLine tkSpan) tkValue | otherwise = tokenSpan tok ! attrs where attrs = [ multiclass . tokenStyle $ tkType ] @@ -155,7 +155,7 @@ internalHyperlink name content = Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ] externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html -externalNameHyperlink (srcs, _) name content = case Map.lookup mdl srcs of +externalNameHyperlink srcs name content = case Map.lookup mdl srcs of Just SrcLocal -> Html.anchor content ! [ Html.href $ hypSrcModuleNameUrl mdl name ] Just (SrcExternal path) -> Html.anchor content ! @@ -165,12 +165,14 @@ externalNameHyperlink (srcs, _) name content = case Map.lookup mdl srcs of mdl = GHC.nameModule name externalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html -externalModHyperlink (_, srcs) name content = case Map.lookup name srcs of - Just SrcLocal -> Html.anchor content ! +externalModHyperlink srcs name content = + let srcs' = Map.mapKeys GHC.moduleName srcs in + case Map.lookup name srcs' of + Just SrcLocal -> Html.anchor content ! [ Html.href $ hypSrcModuleUrl' name ] - Just (SrcExternal path) -> Html.anchor content ! + Just (SrcExternal path) -> Html.anchor content ! [ Html.href $ path hypSrcModuleUrl' name ] - Nothing -> content + Nothing -> content renderSpace :: Int -> String -> Html diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs index d8ae89e4..e377471e 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs @@ -4,8 +4,6 @@ module Haddock.Backends.Hyperlinker.Types where import qualified GHC import Data.Map (Map) -import qualified Data.Map as Map - data Token = Token { tkType :: TokenType @@ -14,23 +12,8 @@ data Token = Token } deriving (Show) -data Position = Position - { posRow :: !Int - , posCol :: !Int - } - deriving (Eq, Ord, Show) - -data Span = Span - { spStart :: !Position - , spEnd :: !Position - } - deriving (Show) - --- | Tests whether the first span "contains" the other span, meaning --- that it covers at least as much source code. True where spans are equal. -containsSpan :: Span -> Span -> Bool -containsSpan s1 s2 = - spStart s1 <= spStart s2 && spEnd s1 >= spEnd s2 +type Position = GHC.RealSrcLoc +type Span = GHC.RealSrcSpan data TokenType = TkIdentifier @@ -80,15 +63,5 @@ data SrcPath | SrcLocal -- | Mapping from modules to cross-package source paths. --- --- This mapping is actually a pair of maps instead of just one map. The reason --- for this is because when hyperlinking modules in import lists we have no --- 'GHC.Module' available. On the other hand, we can't just use map with --- 'GHC.ModuleName' as indices because certain modules may have common name --- but originate in different packages. Hence, we use both /rich/ and /poor/ --- versions, where the /poor/ is just projection of /rich/ one cached in pair --- for better performance. -type SrcMap = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath) +type SrcMap = Map GHC.Module SrcPath -mkSrcMap :: Map GHC.Module SrcPath -> SrcMap -mkSrcMap srcs = (srcs, Map.mapKeys GHC.moduleName srcs) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 2a56e87a..4309163f 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -20,7 +20,6 @@ module Haddock.Interface.Create (createInterface) where import Documentation.Haddock.Doc (metaDocAppend) -import Documentation.Haddock.Utf8 as Utf8 import Haddock.Types import Haddock.Options import Haddock.GhcUtils @@ -33,15 +32,14 @@ import Haddock.Backends.Hyperlinker.Parser as Hyperlinker import Data.Bifunctor import Data.Bitraversable -import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) import Data.List import Data.Maybe import Data.Ord import Control.Applicative -import Control.Exception (evaluate) import Control.Monad +import Control.DeepSeq import Data.Traversable import Avail hiding (avail) @@ -160,7 +158,7 @@ createInterface tm flags modMap instIfaceMap = do modWarn <- liftErrMsg (moduleWarning dflags gre warnings) - tokenizedSrc <- mkMaybeTokenizedSrc flags tm + tokenizedSrc <- mkMaybeTokenizedSrc dflags flags tm return $! Interface { ifaceMod = mdl @@ -1137,12 +1135,12 @@ seqList :: [a] -> () seqList [] = () seqList (x : xs) = x `seq` seqList xs -mkMaybeTokenizedSrc :: [Flag] -> TypecheckedModule +mkMaybeTokenizedSrc :: DynFlags -> [Flag] -> TypecheckedModule -> ErrMsgGhc (Maybe [RichToken]) -mkMaybeTokenizedSrc flags tm +mkMaybeTokenizedSrc dflags flags tm | Flag_HyperlinkedSource `elem` flags = case renamedSource tm of Just src -> do - tokens <- liftGhcToErrMsgGhc . liftIO $ mkTokenizedSrc summary src + tokens <- liftGhcToErrMsgGhc (liftIO (mkTokenizedSrc dflags summary src)) return $ Just tokens Nothing -> do liftErrMsg . tell . pure $ concat @@ -1155,12 +1153,14 @@ mkMaybeTokenizedSrc flags tm where summary = pm_mod_summary . tm_parsed_module $ tm -mkTokenizedSrc :: ModSummary -> RenamedSource -> IO [RichToken] -mkTokenizedSrc ms src = do - -- make sure to read the whole file at once otherwise +mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken] +mkTokenizedSrc dflags ms src = do + -- make sure to read the whole file at once otherwise -- we run out of file descriptors (see #495) - rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate - return $ Hyperlinker.enrich src (Hyperlinker.parse (decodeUtf8 rawSrc)) + file <- force <$> readFile (filepath) + return $ Hyperlinker.enrich src (Hyperlinker.parse dflags filepath file) + where + filepath = msHsFilePath ms -- | Find a stand-alone documentation comment by its name. findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString) diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index 8cd2690e..dcb30e41 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -4,95 +4,138 @@ module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where import Test.Hspec import Test.QuickCheck +import qualified GHC +import Control.Monad.IO.Class + +import Haddock (getGhcDirs) import Haddock.Backends.Hyperlinker.Parser import Haddock.Backends.Hyperlinker.Types +withDynFlags :: (GHC.DynFlags -> IO ()) -> IO () +withDynFlags cont = do + libDir <- fmap snd (getGhcDirs []) + GHC.runGhc (Just libDir) $ do + dflags <- GHC.getSessionDynFlags + liftIO $ cont dflags + main :: IO () main = hspec spec spec :: Spec -spec = do - describe "parse" parseSpec +spec = describe "parse" parseSpec -parseSpec :: Spec -parseSpec = do +-- | Defined for its instance of 'Arbitrary' +newtype NoTabs = NoTabs String deriving (Show, Eq) - it "is total" $ - property $ \src -> length (parse src) `shouldSatisfy` (>= 0) +noTabs :: String -> Bool +noTabs = all (\c -> c `notElem` "\r\t\f\v") - it "retains file layout" $ - property $ \src -> concatMap tkValue (parse src) == src +-- | Does not generate content with space characters other than ' ' and '\n' +instance Arbitrary NoTabs where + arbitrary = fmap NoTabs (arbitrary `suchThat` noTabs) + shrink (NoTabs src) = [ NoTabs shrunk | shrunk <- shrink src, noTabs shrunk ] - context "when parsing single-line comments" $ do - it "should ignore content until the end of line" $ - "-- some very simple comment\nidentifier" - `shouldParseTo` - [TkComment, TkSpace, TkIdentifier] +parseSpec :: Spec +parseSpec = around withDynFlags $ do - it "should allow endline escaping" $ - "-- first line\\\nsecond line\\\nand another one" - `shouldParseTo` - [TkComment] + it "is total" $ \dflags -> + property $ \src -> length (parse dflags "" src) `shouldSatisfy` (>= 0) - context "when parsing multi-line comments" $ do + it "retains file layout" $ \dflags -> + property $ \(NoTabs src) -> concatMap tkValue (parse dflags "" src) == src - it "should support nested comments" $ - "{- comment {- nested -} still comment -} {- next comment -}" - `shouldParseTo` - [TkComment, TkSpace, TkComment] + context "when parsing single-line comments" $ do + + it "should ignore content until the end of line" $ \dflags -> + shouldParseTo + "-- some very simple comment\nidentifier" + [TkComment, TkSpace, TkIdentifier] + dflags - it "should distinguish compiler pragma" $ - "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" - `shouldParseTo` - [TkComment, TkPragma, TkComment] + it "should allow endline escaping" $ \dflags -> + shouldParseTo + "#define first line\\\nsecond line\\\nand another one" + [TkCpp] + dflags - it "should recognize preprocessor directives" $ do - "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp] - "x # y" `shouldParseTo` - [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] + context "when parsing multi-line comments" $ do - it "should distinguish basic language constructs" $ do - "(* 2) <$> (\"abc\", foo)" `shouldParseTo` + it "should support nested comments" $ \dflags -> + shouldParseTo + "{- comment {- nested -} still comment -} {- next comment -}" + [TkComment, TkSpace, TkComment] + dflags + + it "should distinguish compiler pragma" $ \dflags -> + shouldParseTo + "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}" + [TkComment, TkPragma, TkComment] + dflags + + it "should recognize preprocessor directives" $ \dflags -> do + shouldParseTo + "\n#define foo bar" + [TkSpace, TkCpp] + dflags + shouldParseTo + "x # y" + [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier] + dflags + + it "should distinguish basic language constructs" $ \dflags -> do + + shouldParseTo + "(* 2) <$> (\"abc\", foo)" [ TkSpecial, TkOperator, TkSpace, TkNumber, TkSpecial , TkSpace, TkOperator, TkSpace , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial ] - "let foo' = foo in foo' + foo'" `shouldParseTo` + dflags + + shouldParseTo + "let foo' = foo in foo' + foo'" [ TkKeyword, TkSpace, TkIdentifier , TkSpace, TkGlyph, TkSpace , TkIdentifier, TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier ] - "square x = y^2 where y = x" `shouldParseTo` + dflags + + shouldParseTo + "square x = y^2 where y = x" [ TkIdentifier, TkSpace, TkIdentifier , TkSpace, TkGlyph, TkSpace , TkIdentifier, TkOperator, TkNumber , TkSpace, TkKeyword, TkSpace , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier ] + dflags - it "should parse do-notation syntax" $ do - "do { foo <- getLine; putStrLn foo }" `shouldParseTo` + it "should parse do-notation syntax" $ \dflags -> do + shouldParseTo + "do { foo <- getLine; putStrLn foo }" [ TkKeyword, TkSpace, TkSpecial, TkSpace , TkIdentifier, TkSpace, TkGlyph, TkSpace , TkIdentifier, TkSpecial, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial ] - - unlines - [ "do" - , " foo <- getLine" - , " putStrLn foo" - ] `shouldParseTo` + dflags + + shouldParseTo + (unlines + [ "do" + , " foo <- getLine" + , " putStrLn foo" + ]) [ TkKeyword, TkSpace, TkIdentifier , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace , TkIdentifier, TkSpace, TkIdentifier, TkSpace ] - - -shouldParseTo :: String -> [TokenType] -> Expectation -str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens + dflags + where + shouldParseTo :: String -> [TokenType] -> GHC.DynFlags -> Expectation + shouldParseTo str tokens dflags = map tkType (parse dflags "" str) `shouldBe` tokens diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html index f52db4ab..ce69ad37 100644 --- a/hypsrc-test/ref/src/Identifiers.html +++ b/hypsrc-test/ref/src/Identifiers.html @@ -827,11 +827,7 @@ > Identifiers.norfIdentifiers.norf \ No newline at end of file +> -- cgit v1.2.3 From cabe219d10492e376fcfbfa514ae8a722d5e21e2 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Thu, 14 Dec 2017 01:32:53 -0800 Subject: Clickable anchors for headings (#716) See #579. This just adds an tag around the heading, pointing to the heading itself. --- haddock-api/src/Haddock/Backends/Xhtml.hs | 3 +- html-test/ref/Bug387.html | 16 ++++--- html-test/ref/BugExportHeadings.html | 36 ++++++++++------ html-test/ref/DeprecatedReExport.html | 12 ++++-- html-test/ref/Hash.html | 30 +++++++------ html-test/ref/Test.html | 72 ++++++++++++++++++++----------- 6 files changed, 110 insertions(+), 59 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 55175163..01c08f7a 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -697,7 +697,8 @@ processDeclOneLiner True = Just processDeclOneLiner False = Just . divTopDecl . declElem groupHeading :: Int -> String -> Html -> Html -groupHeading lev id0 = groupTag lev ! [identifier (groupId id0)] +groupHeading lev id0 = linkedAnchor grpId . groupTag lev ! [identifier grpId] + where grpId = groupId id0 groupTag :: Int -> Html -> Html groupTag lev diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html index 23faa420..e6228cad 100644 --- a/html-test/ref/Bug387.html +++ b/html-test/ref/Bug387.html @@ -73,10 +73,12 @@ >

Two

Two

Three

Three

Re-exported from an other package

Re-exported from an other package

Not yet working, see

Operations on HashTables

Operations on HashTables

otherwise.

The Hash class

The Hash class

Type declarations

Data types

Type declarations

Data types

Records

Records

test that we can export record selectors on their own:

Class declarations

Class declarations

method

Function types

Function types

we can export foreign declarations too

Auxiliary stuff

Auxiliary stuff

This is some documentation that is attached to a name ($aux1) @@ -1916,8 +1928,10 @@ test2 each line must begin with > (which isn't significant unless it is at the beginning of the line).

A hidden module

A hidden module

#

A visible module

A visible module

module

nested-style doc comments

Existential / Universal types

Existential / Universal types

Type signatures with argument docs

Type signatures with argument docs

A foreign import with argument docs

A section

A subsection

A section

A subsection

a literal line
Date: Sat, 16 Dec 2017 11:59:42 +0100 Subject: Quickjump: Matches on function names weight more than matches in ... module names. --- haddock-api/resources/html/haddock-bundle.min.js | 2 +- haddock-api/resources/html/js-src/quick-jump.tsx | 10 +++++++++- haddock-api/resources/html/quick-jump.min.js | 2 +- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/haddock-api/resources/html/haddock-bundle.min.js b/haddock-api/resources/html/haddock-bundle.min.js index 82a34ddb..8bf397c7 100644 --- a/haddock-api/resources/html/haddock-bundle.min.js +++ b/haddock-api/resources/html/haddock-bundle.min.js @@ -1,2 +1,2 @@ -!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s element with id '"+e+"'");return t}function r(e){for(var t=e.target,n=t.id,r=o(n),i=r.element.open,s=0,l=r.toggles;s0&&(d[n.id]={element:n,openByDefault:!!n.open,toggles:[]},n.addEventListener("toggle",r))}}function s(e){var t=o(e).element;t.open=!t.open}function a(){var e=Object.keys(p);document.cookie="toggled="+encodeURIComponent(e.join("+"))}function l(){var e=h.getCookie("toggled");if(e)for(var t=0,n=e.split("+");t=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.top=0}function s(e,t){var n=o(e.className||"");n.indexOf(" "+t+" ")<0&&(e.className=r(n+" "+t))}function a(e,t){var n=o(e.className||"");n=n.replace(" "+t+" "," "),e.className=r(n)}function l(e,t,n,o){return null==o&&(o=!i(e,t)),o?(a(e,n),s(e,t)):(a(e,t),s(e,n)),o}function c(e){var t=document.getElementById("page-menu");if(t&&t.firstChild){var n=t.firstChild.cloneNode(!1);n.innerHTML=e,t.appendChild(n)}}function u(){return Array.prototype.slice.call(document.getElementsByTagName("link")).filter(function(e){return-1!=e.rel.indexOf("style")&&e.title})}function h(){var e=u(),t="";e.forEach(function(e){t+="
  • "+e.title+"
    • "}),e.length>1&&c("")}function d(e){for(var t=u(),n=null,o=0;on)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=E;P-=1){var R=P-1,U=n[e.charAt(R)];if(U&&(b[R]=1),j[P]=(j[P+1]<<1|1)&U,0!==I&&(j[P]|=(L[P+1]|L[P])<<1|1|L[P+1]),j[P]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:g,distance:c}))<=y){if(y=C,(_=R)<=g)break;E=Math.max(1,2*g-_)}}if(o(t,{errors:I+1,currentLocation:g,expectedLocation:g,distance:c})>y)break;L=j}return{isMatch:_>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");p=p.name}else a[p]={weight:1};this._analyze({key:p,value:this.options.getFn(u,p),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,d=void 0===h?[]:h,p=t.resultMap,f=void 0===p?{}:p,v=t.results,g=void 0===v?[]:v;if(void 0!==i&&null!==i){var m=!1,y=-1,_=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=d.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(E=(E+y)/2),this._log("Score average:",E);var T=!this.options.tokenize||!this.options.matchAllTokens||_>=u.length;if(this._log("\nCheck Matches: "+T),(m||k.isMatch)&&T){var j=f[l];j?j.output.push({key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}]},g.push(f[l]))}}else if(a(i))for(var P=0,R=i.length;P-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===O?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==j.push(e)&&(I.debounceRendering||E)(i)}function i(){var e,t=j;for(j=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===T.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,p,s):e.removeEventListener(t,p,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)d(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function d(e,t,n){try{e[t]=n}catch(e){}}function p(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=P.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=g(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function g(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0)}var u=i.firstChild,h=i.__preactattr_,d=t.children;if(null==h){h=i.__preactattr_={};for(var p=i.attributes,f=p.length;f--;)h[p[f].name]=p[f].value}return!D&&d&&1===d.length&&"string"==typeof d[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=d[0]&&(u.nodeValue=d[0]):(d&&d.length||null!=u)&&m(i,d,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function m(e,t,n,o,r){var i,a,l,c,h,d=e.childNodes,p=[],f={},v=0,m=0,_=d.length,k=0,b=t?t.length:0;if(0!==_)for(L=0;L<_;L++){var x=d[L],w=x.__preactattr_;null!=(S=b&&w?x._component?x._component.__k:w.key:null)?(v++,f[S]=x):(w||(void 0!==x.splitText?!r||x.nodeValue.trim():r))&&(p[k++]=x)}if(0!==b)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[3]); +!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s element with id '"+e+"'");return t}function r(e){for(var t=e.target,n=t.id,r=o(n),i=r.element.open,s=0,l=r.toggles;s0&&(d[n.id]={element:n,openByDefault:!!n.open,toggles:[]},n.addEventListener("toggle",r))}}function s(e){var t=o(e).element;t.open=!t.open}function a(){var e=Object.keys(p);document.cookie="toggled="+encodeURIComponent(e.join("+"))}function l(){var e=h.getCookie("toggled");if(e)for(var t=0,n=e.split("+");t=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.top=0}function s(e,t){var n=o(e.className||"");n.indexOf(" "+t+" ")<0&&(e.className=r(n+" "+t))}function a(e,t){var n=o(e.className||"");n=n.replace(" "+t+" "," "),e.className=r(n)}function l(e,t,n,o){return null==o&&(o=!i(e,t)),o?(a(e,n),s(e,t)):(a(e,t),s(e,n)),o}function c(e){var t=document.getElementById("page-menu");if(t&&t.firstChild){var n=t.firstChild.cloneNode(!1);n.innerHTML=e,t.appendChild(n)}}function u(){return Array.prototype.slice.call(document.getElementsByTagName("link")).filter(function(e){return-1!=e.rel.indexOf("style")&&e.title})}function h(){var e=u(),t="";e.forEach(function(e){t+="
  • "+e.title+"
    • "}),e.length>1&&c("")}function d(e){for(var t=u(),n=null,o=0;on)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=E;P-=1){var R=P-1,U=n[e.charAt(R)];if(U&&(b[R]=1),j[P]=(j[P+1]<<1|1)&U,0!==I&&(j[P]|=(L[P+1]|L[P])<<1|1|L[P+1]),j[P]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:g,distance:c}))<=y){if(y=C,(_=R)<=g)break;E=Math.max(1,2*g-_)}}if(o(t,{errors:I+1,currentLocation:g,expectedLocation:g,distance:c})>y)break;L=j}return{isMatch:_>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");p=p.name}else a[p]={weight:1};this._analyze({key:p,value:this.options.getFn(u,p),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,d=void 0===h?[]:h,p=t.resultMap,f=void 0===p?{}:p,v=t.results,g=void 0===v?[]:v;if(void 0!==i&&null!==i){var m=!1,y=-1,_=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=d.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(E=(E+y)/2),this._log("Score average:",E);var T=!this.options.tokenize||!this.options.matchAllTokens||_>=u.length;if(this._log("\nCheck Matches: "+T),(m||k.isMatch)&&T){var j=f[l];j?j.output.push({key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}]},g.push(f[l]))}}else if(a(i))for(var P=0,R=i.length;P-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===O?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==j.push(e)&&(I.debounceRendering||E)(i)}function i(){var e,t=j;for(j=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===T.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,p,s):e.removeEventListener(t,p,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)d(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function d(e,t,n){try{e[t]=n}catch(e){}}function p(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=P.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=g(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function g(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0)}var u=i.firstChild,h=i.__preactattr_,d=t.children;if(null==h){h=i.__preactattr_={};for(var p=i.attributes,f=p.length;f--;)h[p[f].name]=p[f].value}return!D&&d&&1===d.length&&"string"==typeof d[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=d[0]&&(u.nodeValue=d[0]):(d&&d.length||null!=u)&&m(i,d,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function m(e,t,n,o,r){var i,a,l,c,h,d=e.childNodes,p=[],f={},v=0,m=0,_=d.length,k=0,b=t?t.length:0;if(0!==_)for(L=0;L<_;L++){var x=d[L],w=x.__preactattr_;null!=(S=b&&w?x._component?x._component.__k:w.key:null)?(v++,f[S]=x):(w||(void 0!==x.splitText?!r||x.nodeValue.trim():r))&&(p[k++]=x)}if(0!==b)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[3]); //# sourceMappingURL=haddock-bundle.min.js.map diff --git a/haddock-api/resources/html/js-src/quick-jump.tsx b/haddock-api/resources/html/js-src/quick-jump.tsx index 97ac14af..12270372 100644 --- a/haddock-api/resources/html/js-src/quick-jump.tsx +++ b/haddock-api/resources/html/js-src/quick-jump.tsx @@ -107,7 +107,15 @@ class QuickJump extends Component { caseSensitive: true, includeScore: true, tokenize: true, - keys: ["name", "module"] + keys: [ { + name: "name", + weight: 0.7 + }, + { + name: "module", + weight: 0.3 + } + ] }), moduleResults: [] }); diff --git a/haddock-api/resources/html/quick-jump.min.js b/haddock-api/resources/html/quick-jump.min.js index f22f8f28..bfdf04a3 100644 --- a/haddock-api/resources/html/quick-jump.min.js +++ b/haddock-api/resources/html/quick-jump.min.js @@ -1,2 +1,2 @@ -!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.topn)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=O;E-=1){var R=E-1,U=n[e.charAt(R)];if(U&&(b[R]=1),P[E]=(P[E+1]<<1|1)&U,0!==I&&(P[E]|=(L[E+1]|L[E])<<1|1|L[E+1]),P[E]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:_,distance:c}))<=m){if(m=C,(y=R)<=_)break;O=Math.max(1,2*_-y)}}if(o(t,{errors:I+1,currentLocation:_,expectedLocation:_,distance:c})>m)break;L=P}return{isMatch:y>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");d=d.name}else a[d]={weight:1};this._analyze({key:d,value:this.options.getFn(u,d),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,p=void 0===h?[]:h,d=t.resultMap,f=void 0===d?{}:d,v=t.results,_=void 0===v?[]:v;if(void 0!==i&&null!==i){var g=!1,m=-1,y=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=p.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(O=(O+m)/2),this._log("Score average:",O);var j=!this.options.tokenize||!this.options.matchAllTokens||y>=u.length;if(this._log("\nCheck Matches: "+j),(g||k.isMatch)&&j){var P=f[l];P?P.output.push({key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}]},_.push(f[l]))}}else if(a(i))for(var E=0,R=i.length;E-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===T?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==P.push(e)&&(I.debounceRendering||O)(i)}function i(){var e,t=P;for(P=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===j.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,d,s):e.removeEventListener(t,d,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)p(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function p(e,t,n){try{e[t]=n}catch(e){}}function d(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=E.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=_(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function _(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0)}var u=i.firstChild,h=i.__preactattr_,p=t.children;if(null==h){h=i.__preactattr_={};for(var d=i.attributes,f=d.length;f--;)h[d[f].name]=d[f].value}return!D&&p&&1===p.length&&"string"==typeof p[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=p[0]&&(u.nodeValue=p[0]):(p&&p.length||null!=u)&&g(i,p,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function g(e,t,n,o,r){var i,a,l,c,h,p=e.childNodes,d=[],f={},v=0,g=0,y=p.length,k=0,b=t?t.length:0;if(0!==y)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[1]); +!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.topn)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=O;E-=1){var R=E-1,U=n[e.charAt(R)];if(U&&(b[R]=1),P[E]=(P[E+1]<<1|1)&U,0!==I&&(P[E]|=(L[E+1]|L[E])<<1|1|L[E+1]),P[E]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:_,distance:c}))<=m){if(m=C,(y=R)<=_)break;O=Math.max(1,2*_-y)}}if(o(t,{errors:I+1,currentLocation:_,expectedLocation:_,distance:c})>m)break;L=P}return{isMatch:y>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");d=d.name}else a[d]={weight:1};this._analyze({key:d,value:this.options.getFn(u,d),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,p=void 0===h?[]:h,d=t.resultMap,f=void 0===d?{}:d,v=t.results,_=void 0===v?[]:v;if(void 0!==i&&null!==i){var g=!1,m=-1,y=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=p.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(O=(O+m)/2),this._log("Score average:",O);var j=!this.options.tokenize||!this.options.matchAllTokens||y>=u.length;if(this._log("\nCheck Matches: "+j),(g||k.isMatch)&&j){var P=f[l];P?P.output.push({key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}]},_.push(f[l]))}}else if(a(i))for(var E=0,R=i.length;E-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===T?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==P.push(e)&&(I.debounceRendering||O)(i)}function i(){var e,t=P;for(P=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===j.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,d,s):e.removeEventListener(t,d,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)p(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function p(e,t,n){try{e[t]=n}catch(e){}}function d(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=E.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=_(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function _(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0)}var u=i.firstChild,h=i.__preactattr_,p=t.children;if(null==h){h=i.__preactattr_={};for(var d=i.attributes,f=d.length;f--;)h[d[f].name]=d[f].value}return!D&&p&&1===p.length&&"string"==typeof p[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=p[0]&&(u.nodeValue=p[0]):(p&&p.length||null!=u)&&g(i,p,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function g(e,t,n,o,r){var i,a,l,c,h,p=e.childNodes,d=[],f={},v=0,g=0,y=p.length,k=0,b=t?t.length:0;if(0!==y)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[1]); //# sourceMappingURL=quick-jump.min.js.map -- cgit v1.2.3 From 56c0e317093d2e25412cfa7dd10099c1fe729640 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 17 Dec 2017 11:40:03 +0100 Subject: Treat escaped \] better in definition lists (#717) This fixes #546. --- .../src/Documentation/Haddock/Parser.hs | 15 +- html-test/ref/Bug546.html | 273 +++++++++++++++++++++ html-test/src/Bug546.hs | 55 +++++ 3 files changed, 342 insertions(+), 1 deletion(-) create mode 100644 html-test/ref/Bug546.html create mode 100644 html-test/src/Bug546.hs diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 8dc2a801..dd1044cb 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -338,7 +338,7 @@ definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do - label <- "[" *> (parseStringBS <$> takeWhile1 (notInClass "]\n")) <* ("]" <* optional ":") + label <- "[" *> (parseStringBS <$> scan False accept) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs @@ -346,6 +346,19 @@ definitionList indent = DocDefList <$> p Left x -> [(label, contents `docAppend` x)] Right i -> (label, contents) : i + -- handle '\]' escapes + accept True ']' = Just False + + -- stop on ']' or '\n' + accept _ ']' = Nothing + accept _ '\n' = Nothing + + -- starting an escape sequence + accept _ '\\' = Just True + + -- anything else + accept _ _ = Just False + -- | Drops all trailing newlines. dropNLs :: String -> String dropNLs = reverse . dropWhile (== '\n') . reverse diff --git a/html-test/ref/Bug546.html b/html-test/ref/Bug546.html new file mode 100644 index 00000000..1ed6657f --- /dev/null +++ b/html-test/ref/Bug546.html @@ -0,0 +1,273 @@ +Bug546
    Safe HaskellSafe

    Bug546

    Synopsis

    Documentation

    x :: Integer #

    Test:

    [code with square \ brackets]
    lorem ipsum

    compile :: String -> String #

    [..]
    Matches any of the enclosed characters. Ranges of characters can + be specified by separating the endpoints with a '-'. '-' or + ']' can be matched by including them as the first character(s) + in the list. Never matches path separators: [/] matches + nothing at all. Named character classes can also be matched: + [:x:] within [] specifies the class named x, which matches + certain predefined characters. See below for a full list.
    [^..] or [!..]
    Like [..], but matches any character not listed. + Note that [^-x] is not the inverse of [-x], but + the range [^-x].
    <m-n>
    Matches any integer in the range m to n, inclusive. The range may + be open-ended by leaving out either number: "<->", for + instance, matches any integer.
    **/
    Matches any number of characters, including path separators, + excluding the empty string.

    Supported character classes:

    [:alnum:]
    Equivalent to "0-9A-Za-z".
    [:alpha:]
    Equivalent to "A-Za-z".
    [:blank:]
    Equivalent to "\t ".
    [:cntrl:]
    Equivalent to "\0-\x1f\x7f".
    [:digit:]
    Equivalent to "0-9".
    [:graph:]
    Equivalent to "!-~".
    [:lower:]
    Equivalent to "a-z".
    [:print:]
    Equivalent to " -~".
    [:punct:]
    Equivalent to "!-/:-@[-`{-~".
    [:space:]
    Equivalent to "\t-\r ".
    [:upper:]
    Equivalent to "A-Z".
    [:xdigit:]
    Equivalent to "0-9A-Fa-f".
    \ No newline at end of file diff --git a/html-test/src/Bug546.hs b/html-test/src/Bug546.hs new file mode 100644 index 00000000..4493b1d9 --- /dev/null +++ b/html-test/src/Bug546.hs @@ -0,0 +1,55 @@ +module Bug546 where + +-- |Test: +-- +-- [@[code with square \\ brackets\]@] lorem ipsum +x = 1 + +-- | +-- +-- [@[..\]@] Matches any of the enclosed characters. Ranges of characters can +-- be specified by separating the endpoints with a @\'-'@. @\'-'@ or +-- @']'@ can be matched by including them as the first character(s) +-- in the list. Never matches path separators: @[\/]@ matches +-- nothing at all. Named character classes can also be matched: +-- @[:x:]@ within @[]@ specifies the class named @x@, which matches +-- certain predefined characters. See below for a full list. +-- +-- [@[^..\]@ or @[!..\]@] Like @[..]@, but matches any character /not/ listed. +-- Note that @[^-x]@ is not the inverse of @[-x]@, but +-- the range @[^-x]@. +-- +-- [@\@] Matches any integer in the range m to n, inclusive. The range may +-- be open-ended by leaving out either number: @\"\<->\"@, for +-- instance, matches any integer. +-- +-- [@**/@] Matches any number of characters, including path separators, +-- excluding the empty string. +-- +-- Supported character classes: +-- +-- [@[:alnum:\]@] Equivalent to @\"0-9A-Za-z\"@. +-- +-- [@[:alpha:\]@] Equivalent to @\"A-Za-z\"@. +-- +-- [@[:blank:\]@] Equivalent to @\"\\t \"@. +-- +-- [@[:cntrl:\]@] Equivalent to @\"\\0-\\x1f\\x7f\"@. +-- +-- [@[:digit:\]@] Equivalent to @\"0-9\"@. +-- +-- [@[:graph:\]@] Equivalent to @\"!-~\"@. +-- +-- [@[:lower:\]@] Equivalent to @\"a-z\"@. +-- +-- [@[:print:\]@] Equivalent to @\" -~\"@. +-- +-- [@[:punct:\]@] Equivalent to @\"!-\/:-\@[-`{-~\"@. +-- +-- [@[:space:\]@] Equivalent to @\"\\t-\\r \"@. +-- +-- [@[:upper:\]@] Equivalent to @\"A-Z\"@. +-- +-- [@[:xdigit:\]@] Equivalent to @\"0-9A-Fa-f\"@. +compile :: String -> String +compile = id \ No newline at end of file -- cgit v1.2.3 From ce30e3449f723cd1ba28d30455dd500e06397168 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sun, 17 Dec 2017 11:50:27 +0100 Subject: Remove scanner, takeWhile1_ already takes care of escaping --- haddock-library/src/Documentation/Haddock/Parser.hs | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index dd1044cb..fcd26f83 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -338,7 +338,7 @@ definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do - label <- "[" *> (parseStringBS <$> scan False accept) <* ("]" <* optional ":") + label <- "[" *> (parseStringBS <$> takeWhile1_ (/= ']')) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs @@ -346,19 +346,6 @@ definitionList indent = DocDefList <$> p Left x -> [(label, contents `docAppend` x)] Right i -> (label, contents) : i - -- handle '\]' escapes - accept True ']' = Just False - - -- stop on ']' or '\n' - accept _ ']' = Nothing - accept _ '\n' = Nothing - - -- starting an escape sequence - accept _ '\\' = Just True - - -- anything else - accept _ _ = Just False - -- | Drops all trailing newlines. dropNLs :: String -> String dropNLs = reverse . dropWhile (== '\n') . reverse -- cgit v1.2.3 From 2cdf1413564b49dcdf63b39d6871155c69b53974 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sun, 17 Dec 2017 11:53:59 +0100 Subject: Take until line feed --- haddock-library/src/Documentation/Haddock/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index fcd26f83..4ea87db7 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -338,7 +338,7 @@ definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do - label <- "[" *> (parseStringBS <$> takeWhile1_ (/= ']')) <* ("]" <* optional ":") + label <- "[" *> (parseStringBS <$> takeWhile1_ (notInClass "]\n")) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs -- cgit v1.2.3 From 11f438ed9161a7dbb5de685fd7f3f18b1942b16e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Dec 2017 17:17:26 +0200 Subject: Add simple framework for running parser fixtures (#668) * Add simple framework for running parser fixtures * Compatible with tree-diff-0.0.0.1 * Use parseParas to parse fixtures This allows to test all syntactic constructs available in haddock markup. --- haddock-library/fixtures/Fixtures.hs | 153 +++++++++++++++++++++ haddock-library/fixtures/examples/identifier.input | 1 + .../fixtures/examples/identifier.parsed | 1 + .../fixtures/examples/identifierBackticks.input | 1 + .../fixtures/examples/identifierBackticks.parsed | 1 + haddock-library/fixtures/examples/url.input | 1 + haddock-library/fixtures/examples/url.parsed | 4 + haddock-library/fixtures/examples/urlLabel.input | 1 + haddock-library/fixtures/examples/urlLabel.parsed | 5 + haddock-library/haddock-library.cabal | 22 +++ 10 files changed, 190 insertions(+) create mode 100644 haddock-library/fixtures/Fixtures.hs create mode 100644 haddock-library/fixtures/examples/identifier.input create mode 100644 haddock-library/fixtures/examples/identifier.parsed create mode 100644 haddock-library/fixtures/examples/identifierBackticks.input create mode 100644 haddock-library/fixtures/examples/identifierBackticks.parsed create mode 100644 haddock-library/fixtures/examples/url.input create mode 100644 haddock-library/fixtures/examples/url.parsed create mode 100644 haddock-library/fixtures/examples/urlLabel.input create mode 100644 haddock-library/fixtures/examples/urlLabel.parsed diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs new file mode 100644 index 00000000..3707e0a8 --- /dev/null +++ b/haddock-library/fixtures/Fixtures.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main (main) where + +import Control.Applicative ((<|>)) +import Control.Exception (IOException, catch) +import Control.Monad (when) +import Data.Foldable (traverse_) +import Data.List (foldl') +import Data.Traversable (for) +import GHC.Generics (Generic) +import Prelude () +import Prelude.Compat +import System.Directory (getDirectoryContents) +import System.Exit (exitFailure) +import System.FilePath + +import Data.TreeDiff +import Data.TreeDiff.Golden + +import qualified Options.Applicative as O + +import Documentation.Haddock.Types +import qualified Documentation.Haddock.Parser as Parse + +type Doc id = DocH () id + +data Fixture = Fixture + { fixtureName :: FilePath + , fixtureOutput :: FilePath + } + deriving Show + +data Result = Result + { _resultSuccess :: !Int + , _resultTotal :: !Int + } + deriving Show + +combineResults :: Result -> Result -> Result +combineResults (Result s t) (Result s' t') = Result (s + s') (t + t') + +readFixtures :: IO [Fixture] +readFixtures = do + let dir = "fixtures/examples" + files <- getDirectoryContents dir + let inputs = filter (\fp -> takeExtension fp == ".input") files + return $ flip map inputs $ \fp -> Fixture + { fixtureName = dir fp + , fixtureOutput = dir fp -<.> "parsed" + } + +goldenFixture + :: String + -> IO Expr + -> IO Expr + -> (Expr -> Expr -> IO (Maybe String)) + -> (Expr -> IO ()) + -> IO Result +goldenFixture name expect actual cmp wrt = do + putStrLn $ "running " ++ name + a <- actual + e <- expect `catch` handler a + mres <- cmp e a + case mres of + Nothing -> return (Result 1 1) + Just str -> do + putStr str + return (Result 0 1) + where + handler :: Expr -> IOException -> IO Expr + handler a exc = do + putStrLn $ "Caught " ++ show exc + putStrLn "Accepting the test" + wrt a + return a + +runFixtures :: [Fixture] -> IO () +runFixtures fixtures = do + results <- for fixtures $ \(Fixture i o) -> do + let name = takeBaseName i + let readDoc = do + input <- readFile i + return (parseString input) + ediffGolden goldenFixture name o readDoc + case foldl' combineResults (Result 0 0) results of + Result s t -> do + putStrLn $ "Fixtures: success " ++ show s ++ "; total " ++ show t + when (s /= t) exitFailure + +listFixtures :: [Fixture] -> IO () +listFixtures = traverse_ $ \(Fixture i _) -> do + let name = takeBaseName i + putStrLn name + +acceptFixtures :: [Fixture] -> IO () +acceptFixtures = traverse_ $ \(Fixture i o) -> do + input <- readFile i + let doc = parseString input + let actual = show (prettyExpr $ toExpr doc) ++ "\n" + writeFile o actual + +parseString :: String -> Doc String +parseString = Parse.toRegular . _doc . Parse.parseParas + +data Cmd = CmdRun | CmdAccept | CmdList + +main :: IO () +main = runCmd =<< O.execParser opts + where + opts = O.info (O.helper <*> cmdParser) O.fullDesc + + cmdParser :: O.Parser Cmd + cmdParser = cmdRun <|> cmdAccept <|> cmdList <|> pure CmdRun + + cmdRun = O.flag' CmdRun $ mconcat + [ O.long "run" + , O.help "Run parser fixtures" + ] + + cmdAccept = O.flag' CmdAccept $ mconcat + [ O.long "accept" + , O.help "Run & accept parser fixtures" + ] + + cmdList = O.flag' CmdList $ mconcat + [ O.long "list" + , O.help "List fixtures" + ] + +runCmd :: Cmd -> IO () +runCmd CmdRun = readFixtures >>= runFixtures +runCmd CmdList = readFixtures >>= listFixtures +runCmd CmdAccept = readFixtures >>= acceptFixtures + +------------------------------------------------------------------------------- +-- Orphans +------------------------------------------------------------------------------- + +deriving instance Generic (DocH mod id) +instance (ToExpr mod, ToExpr id) => ToExpr (DocH mod id) + +deriving instance Generic (Header id) +instance ToExpr id => ToExpr (Header id) + +deriving instance Generic Hyperlink +instance ToExpr Hyperlink + +deriving instance Generic Picture +instance ToExpr Picture + +deriving instance Generic Example +instance ToExpr Example diff --git a/haddock-library/fixtures/examples/identifier.input b/haddock-library/fixtures/examples/identifier.input new file mode 100644 index 00000000..c2c4af01 --- /dev/null +++ b/haddock-library/fixtures/examples/identifier.input @@ -0,0 +1 @@ +'foo' diff --git a/haddock-library/fixtures/examples/identifier.parsed b/haddock-library/fixtures/examples/identifier.parsed new file mode 100644 index 00000000..3405a5c9 --- /dev/null +++ b/haddock-library/fixtures/examples/identifier.parsed @@ -0,0 +1 @@ +DocParagraph (DocIdentifier "foo") diff --git a/haddock-library/fixtures/examples/identifierBackticks.input b/haddock-library/fixtures/examples/identifierBackticks.input new file mode 100644 index 00000000..347253a0 --- /dev/null +++ b/haddock-library/fixtures/examples/identifierBackticks.input @@ -0,0 +1 @@ +`foo` diff --git a/haddock-library/fixtures/examples/identifierBackticks.parsed b/haddock-library/fixtures/examples/identifierBackticks.parsed new file mode 100644 index 00000000..3405a5c9 --- /dev/null +++ b/haddock-library/fixtures/examples/identifierBackticks.parsed @@ -0,0 +1 @@ +DocParagraph (DocIdentifier "foo") diff --git a/haddock-library/fixtures/examples/url.input b/haddock-library/fixtures/examples/url.input new file mode 100644 index 00000000..5bfed0a1 --- /dev/null +++ b/haddock-library/fixtures/examples/url.input @@ -0,0 +1 @@ + diff --git a/haddock-library/fixtures/examples/url.parsed b/haddock-library/fixtures/examples/url.parsed new file mode 100644 index 00000000..0fbbbb30 --- /dev/null +++ b/haddock-library/fixtures/examples/url.parsed @@ -0,0 +1,4 @@ +DocParagraph + (DocHyperlink + Hyperlink + {hyperlinkLabel = Nothing, hyperlinkUrl = "http://example.com/"}) diff --git a/haddock-library/fixtures/examples/urlLabel.input b/haddock-library/fixtures/examples/urlLabel.input new file mode 100644 index 00000000..729812e8 --- /dev/null +++ b/haddock-library/fixtures/examples/urlLabel.input @@ -0,0 +1 @@ + diff --git a/haddock-library/fixtures/examples/urlLabel.parsed b/haddock-library/fixtures/examples/urlLabel.parsed new file mode 100644 index 00000000..d7e3a76c --- /dev/null +++ b/haddock-library/fixtures/examples/urlLabel.parsed @@ -0,0 +1,5 @@ +DocParagraph + (DocHyperlink + Hyperlink + {hyperlinkLabel = Just "some link", + hyperlinkUrl = "http://example.com/"}) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 5b0f1481..3cd4a336 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -124,6 +124,28 @@ test-suite spec build-tool-depends: hspec-discover:hspec-discover ^>= 2.4.4 +test-suite fixtures + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Fixtures.hs + ghc-options: -Wall + hs-source-dirs: fixtures + build-depends: + base-compat ^>= 0.9.3 + , directory ^>= 1.3.0.2 + , filepath ^>= 1.4.1.2 + , optparse-applicative ^>= 0.14.0.0 + , tree-diff ^>= 0.0.0.1 + + -- Depend on the library. + build-depends: + haddock-library + + -- Versions for the dependencies below are transitively pinned by + -- dependency on haddock-library:lib:attoparsec + build-depends: + base + source-repository head type: git subdir: haddock-library -- cgit v1.2.3 From a8f7b19f7cc3c5ac02cd15b4270cad5c869dc0c0 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 24 Dec 2017 09:49:47 -0800 Subject: Patch flaky parser test (#720) * Patch flaky parser test This test was a great idea, but it doesn't port over too well to using the GHC lexer. GHC rewrites its input a bit - nothing surprising, but we need to guard against those cases for the test. * Change instance head * Change use site --- .../Haddock/Backends/Hyperlinker/ParserSpec.hs | 33 ++++++++++++++-------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs index dcb30e41..4639253c 100644 --- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs +++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs @@ -27,16 +27,27 @@ spec :: Spec spec = describe "parse" parseSpec --- | Defined for its instance of 'Arbitrary' -newtype NoTabs = NoTabs String deriving (Show, Eq) - -noTabs :: String -> Bool -noTabs = all (\c -> c `notElem` "\r\t\f\v") - --- | Does not generate content with space characters other than ' ' and '\n' -instance Arbitrary NoTabs where - arbitrary = fmap NoTabs (arbitrary `suchThat` noTabs) - shrink (NoTabs src) = [ NoTabs shrunk | shrunk <- shrink src, noTabs shrunk ] +-- | Defined for its instance of 'Arbitrary'. Represents strings that, when +-- considered as GHC source, won't be rewritten. +newtype NoGhcRewrite = NoGhcRewrite String deriving (Show, Eq) + +-- | Filter out strings where GHC would replace/remove some characters during +-- lexing. +noGhcRewrite :: String -> Bool +noGhcRewrite ('\t':_) = False -- GHC replaces tabs with 8 spaces +noGhcRewrite ('\r':_) = False +noGhcRewrite ('\f':_) = False +noGhcRewrite ('\v':_) = False +noGhcRewrite (' ':'\n':_) = False -- GHC strips whitespace on empty lines +noGhcRewrite (_:s) = noGhcRewrite s +noGhcRewrite "" = True + +instance Arbitrary NoGhcRewrite where + arbitrary = fmap NoGhcRewrite (arbitrary `suchThat` noGhcRewrite) + shrink (NoGhcRewrite src) = [ NoGhcRewrite shrunk + | shrunk <- shrink src + , noGhcRewrite shrunk + ] parseSpec :: Spec @@ -46,7 +57,7 @@ parseSpec = around withDynFlags $ do property $ \src -> length (parse dflags "" src) `shouldSatisfy` (>= 0) it "retains file layout" $ \dflags -> - property $ \(NoTabs src) -> concatMap tkValue (parse dflags "" src) == src + property $ \(NoGhcRewrite src) -> concatMap tkValue (parse dflags "" src) == src context "when parsing single-line comments" $ do -- cgit v1.2.3 From 2e0d7aef60fbb17f29ffa1f363ffc423f31185fc Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Mon, 25 Dec 2017 10:18:10 +0100 Subject: Include secondary LICENSE file in source dist --- haddock-library/haddock-library.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 3cd4a336..2707a928 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -8,7 +8,8 @@ description: Haddock is a documentation-generation tool for Haskell project if you can't release often. For interacting with Haddock itself, see the ‘haddock’ package. license: BSD3 -license-file: LICENSE +license-files: LICENSE + vendor/attoparsec-0.13.1.0/LICENSE maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues -- cgit v1.2.3 From 088b1993fb6c6ed014a95e93d7c07f68218c7777 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Dec 2017 17:13:14 +0200 Subject: Grid Tables (#718) * Add table examples * Add table types and adopt simple parser Simple parser is done by Giovanni Cappellotto (@potomak) in https://github.com/haskell/haddock/pull/577 It seems to support single fine full tables, so far from full RST-grid tables, but it's good start. Table type support row- and colspans, but obviously parser is lacking. Still TODO: - Latex backend. Should we use multirow package https://ctan.org/pkg/multirow?lang=en? - Hoogle backend: ? * Implement grid-tables * Refactor table parser * Add two ill-examples * Update CHANGES.md * Basic documentation for tables * Fix documentation example --- CHANGES.md | 2 + doc/markup.rst | 20 ++ .../resources/html/Classic.theme/xhaddock.css | 14 ++ .../resources/html/Ocean.std-theme/ocean.css | 15 ++ haddock-api/src/Haddock/Backends/Hoogle.hs | 3 +- haddock-api/src/Haddock/Backends/LaTeX.hs | 5 +- .../src/Haddock/Backends/Xhtml/DocMarkup.hs | 19 +- haddock-api/src/Haddock/Interface/LexParseRn.hs | 1 + haddock-api/src/Haddock/InterfaceFile.hs | 32 +++ haddock-api/src/Haddock/Types.hs | 9 + haddock-library/fixtures/Fixtures.hs | 9 + .../fixtures/examples/table-simple.input | 7 + .../fixtures/examples/table-simple.parsed | 52 +++++ haddock-library/fixtures/examples/table1.input | 12 ++ haddock-library/fixtures/examples/table1.parsed | 81 +++++++ haddock-library/fixtures/examples/table2.input | 7 + haddock-library/fixtures/examples/table2.parsed | 46 ++++ haddock-library/fixtures/examples/table3.input | 7 + haddock-library/fixtures/examples/table3.parsed | 50 +++++ haddock-library/fixtures/examples/table4.input | 17 ++ haddock-library/fixtures/examples/table4.parsed | 26 +++ haddock-library/fixtures/examples/table5.input | 8 + haddock-library/fixtures/examples/table5.parsed | 53 +++++ haddock-library/haddock-library.cabal | 3 + .../src/Documentation/Haddock/Markup.hs | 4 +- .../src/Documentation/Haddock/Parser.hs | 196 ++++++++++++++++- haddock-library/src/Documentation/Haddock/Types.hs | 20 ++ html-test/ref/Table.html | 238 +++++++++++++++++++++ html-test/src/Table.hs | 47 ++++ 29 files changed, 996 insertions(+), 7 deletions(-) create mode 100644 haddock-library/fixtures/examples/table-simple.input create mode 100644 haddock-library/fixtures/examples/table-simple.parsed create mode 100644 haddock-library/fixtures/examples/table1.input create mode 100644 haddock-library/fixtures/examples/table1.parsed create mode 100644 haddock-library/fixtures/examples/table2.input create mode 100644 haddock-library/fixtures/examples/table2.parsed create mode 100644 haddock-library/fixtures/examples/table3.input create mode 100644 haddock-library/fixtures/examples/table3.parsed create mode 100644 haddock-library/fixtures/examples/table4.input create mode 100644 haddock-library/fixtures/examples/table4.parsed create mode 100644 haddock-library/fixtures/examples/table5.input create mode 100644 haddock-library/fixtures/examples/table5.parsed create mode 100644 html-test/ref/Table.html create mode 100644 html-test/src/Table.hs diff --git a/CHANGES.md b/CHANGES.md index b4d69ce4..7127df79 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ * to be released + * Haddock now supports tables in documentation inspired by reSTs grid tables + * A --reexport flag, which can be used to add extra modules to the top-level module tree diff --git a/doc/markup.rst b/doc/markup.rst index d0b9392d..acabaa28 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -1078,6 +1078,26 @@ If the output format supports it, the mathematics will be rendered inside the documentation. For example, the HTML backend will display the mathematics via `MathJax `__. +Grid Tables +~~~~~~~~~~~ + +Inspired by reSTs grid tables Haddock supports a complete table representation via a grid-like "ASCII art". Grid tables are described with a visual grid made up of the characters "-", "=", "|", and "+". The hyphen ("-") is used for horizontal lines (row separators). The equals sign ("=") may be used to separate optional header rows from the table body. The vertical bar ("|") is used for vertical lines (column separators). The plus sign ("+") is used for intersections of horizontal and vertical lines. :: + + -- | This is a grid table: + -- + -- +------------------------+------------+----------+----------+ + -- | Header row, column 1 | Header 2 | Header 3 | Header 4 | + -- | (header rows optional) | | | | + -- +========================+============+==========+==========+ + -- | body row 1, column 1 | column 2 | column 3 | column 4 | + -- +------------------------+------------+----------+----------+ + -- | body row 2 | Cells may span columns. | + -- +------------------------+------------+---------------------+ + -- | body row 3 | Cells may | \[ | + -- +------------------------+ span rows. | f(n) = \sum_{i=1} | + -- | body row 4 | | \] | + -- +------------------------+------------+---------------------+ + Anchors ~~~~~~~ diff --git a/haddock-api/resources/html/Classic.theme/xhaddock.css b/haddock-api/resources/html/Classic.theme/xhaddock.css index 1bf668e9..b8164815 100644 --- a/haddock-api/resources/html/Classic.theme/xhaddock.css +++ b/haddock-api/resources/html/Classic.theme/xhaddock.css @@ -392,6 +392,20 @@ td.rdoc p { } +.doc table { + border-collapse: collapse; + border-spacing: 0px; +} + +.doc th, +.doc td { + padding: 5px; + border: 1px solid #ddd; +} + +.doc th { + background-color: #f0f0f0; +} #footer { background-color: #000099; diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 0852dea5..ba6af9ca 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -443,6 +443,21 @@ div#style-menu-holder { margin-top: 0.8em; } +.doc table { + border-collapse: collapse; + border-spacing: 0px; +} + +.doc th, +.doc td { + padding: 5px; + border: 1px solid #ddd; +} + +.doc th { + background-color: #f0f0f0; +} + .clearfix:after { clear: both; content: " "; diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index f1d8ddb2..fc71d4b5 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -328,7 +328,8 @@ markupTag dflags = Markup { markupAName = const $ str "", markupProperty = box TagPre . str, markupExample = box TagPre . str . unlines . map exampleToString, - markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h + markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h, + markupTable = \(Table _ _) -> str "TODO: table" } diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index d79e0e6c..3ac3b405 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -1140,7 +1140,8 @@ parLatexMarkup ppId = Markup { markupAName = \_ _ -> empty, markupProperty = \p _ -> quote $ verb $ text p, markupExample = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e, - markupHeader = \(Header l h) p -> header l (h p) + markupHeader = \(Header l h) p -> header l (h p), + markupTable = \(Table h b) p -> table h b p } where header 1 d = text "\\section*" <> braces d @@ -1149,6 +1150,8 @@ parLatexMarkup ppId = Markup { | l > 0 && l <= 6 = text "\\subsubsection*" <> braces d header l _ = error $ "impossible header level in LaTeX generation: " ++ show l + table _ _ _ = text "{TODO: Table}" + fixString Plain s = latexFilter s fixString Verb s = s fixString Mono s = latexMonoFilter s diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index e63667b0..2990e1e4 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -73,7 +73,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup { markupMathDisplay = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"), markupProperty = pre . toHtml, markupExample = examplesToHtml, - markupHeader = \(Header l t) -> makeHeader l t + markupHeader = \(Header l t) -> makeHeader l t, + markupTable = \(Table h r) -> makeTable h r } where makeHeader :: Int -> Html -> Html @@ -85,6 +86,22 @@ parHtmlMarkup qual insertAnchors ppId = Markup { makeHeader 6 mkup = h6 mkup makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!" + makeTable :: [TableRow Html] -> [TableRow Html] -> Html + makeTable hs bs = table (concatHtml (hs' ++ bs')) + where + hs' | null hs = [] + | otherwise = [thead (concatHtml (map (makeTableRow th) hs))] + + bs' = [tbody (concatHtml (map (makeTableRow td) bs))] + + makeTableRow :: (Html -> Html) -> TableRow Html -> Html + makeTableRow thr (TableRow cs) = tr (concatHtml (map (makeTableCell thr) cs)) + + makeTableCell :: (Html -> Html) -> TableCell Html -> Html + makeTableCell thr (TableCell i j c) = thr c ! (i' ++ j') + where + i' = if i == 1 then [] else [ colspan i ] + j' = if j == 1 then [] else [ rowspan j ] examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"] diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 75b2f223..311301ee 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -144,6 +144,7 @@ rename dflags gre = rn DocEmpty -> pure (DocEmpty) DocString str -> pure (DocString str) DocHeader (Header l t) -> DocHeader . Header l <$> rn t + DocTable t -> DocTable <$> traverse rn t -- | Wrap an identifier that's out of scope (i.e. wasn't found in -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 76bcb4ae..bbd8d04e 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -459,6 +459,32 @@ instance Binary a => Binary (Header a) where t <- get bh return (Header l t) +instance Binary a => Binary (Table a) where + put_ bh (Table h b) = do + put_ bh h + put_ bh b + get bh = do + h <- get bh + b <- get bh + return (Table h b) + +instance Binary a => Binary (TableRow a) where + put_ bh (TableRow cs) = put_ bh cs + get bh = do + cs <- get bh + return (TableRow cs) + +instance Binary a => Binary (TableCell a) where + put_ bh (TableCell i j c) = do + put_ bh i + put_ bh j + put_ bh c + get bh = do + i <- get bh + j <- get bh + c <- get bh + return (TableCell i j c) + instance Binary Meta where put_ bh Meta { _version = v } = put_ bh v get bh = (\v -> Meta { _version = v }) <$> get bh @@ -542,6 +568,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where put_ bh (DocMathDisplay x) = do putByte bh 22 put_ bh x + put_ bh (DocTable x) = do + putByte bh 23 + put_ bh x get bh = do h <- getByte bh @@ -615,6 +644,9 @@ instance (Binary mod, Binary id) => Binary (DocH mod id) where 22 -> do x <- get bh return (DocMathDisplay x) + 23 -> do + x <- get bh + return (DocTable x) _ -> error "invalid binary data found in the interface file" diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index b4cdc343..725606b2 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -454,6 +454,7 @@ instance (NFData a, NFData mod) DocProperty a -> a `deepseq` () DocExamples a -> a `deepseq` () DocHeader a -> a `deepseq` () + DocTable a -> a `deepseq` () #if !MIN_VERSION_ghc(8,0,2) -- These were added to GHC itself in 8.0.2 @@ -474,6 +475,14 @@ instance NFData Picture where instance NFData Example where rnf (Example a b) = a `deepseq` b `deepseq` () +instance NFData id => NFData (Table id) where + rnf (Table h b) = h `deepseq` b `deepseq` () + +instance NFData id => NFData (TableRow id) where + rnf (TableRow cs) = cs `deepseq` () + +instance NFData id => NFData (TableCell id) where + rnf (TableCell i j c) = i `deepseq` j `deepseq` c `deepseq` () exampleToString :: Example -> String exampleToString (Example expression result) = diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs index 3707e0a8..f75ff664 100644 --- a/haddock-library/fixtures/Fixtures.hs +++ b/haddock-library/fixtures/Fixtures.hs @@ -151,3 +151,12 @@ instance ToExpr Picture deriving instance Generic Example instance ToExpr Example + +deriving instance Generic (Table id) +instance ToExpr id => ToExpr (Table id) + +deriving instance Generic (TableRow id) +instance ToExpr id => ToExpr (TableRow id) + +deriving instance Generic (TableCell id) +instance ToExpr id => ToExpr (TableCell id) diff --git a/haddock-library/fixtures/examples/table-simple.input b/haddock-library/fixtures/examples/table-simple.input new file mode 100644 index 00000000..d9c49f87 --- /dev/null +++ b/haddock-library/fixtures/examples/table-simple.input @@ -0,0 +1,7 @@ ++------+--------------+------------------------------------------+ +| code | message | description | ++======+==============+==========================================+ +| 200 | @OK@ | operation successful | ++------+--------------+------------------------------------------+ +| 204 | @No Content@ | operation successful, no body returned | ++------+--------------+------------------------------------------+ diff --git a/haddock-library/fixtures/examples/table-simple.parsed b/haddock-library/fixtures/examples/table-simple.parsed new file mode 100644 index 00000000..b5e62453 --- /dev/null +++ b/haddock-library/fixtures/examples/table-simple.parsed @@ -0,0 +1,52 @@ +DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " 200 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocAppend + (DocString " ") + (DocAppend + (DocMonospaced (DocString "OK")) + (DocString " ")), + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + " operation successful ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " 204 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocAppend + (DocString " ") + (DocAppend + (DocMonospaced (DocString "No Content")) + (DocString " ")), + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + " operation successful, no body returned ", + tableCellRowspan = 1}]], + tableHeaderRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " code ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " message ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + " description ", + tableCellRowspan = 1}]]} diff --git a/haddock-library/fixtures/examples/table1.input b/haddock-library/fixtures/examples/table1.input new file mode 100644 index 00000000..a007020c --- /dev/null +++ b/haddock-library/fixtures/examples/table1.input @@ -0,0 +1,12 @@ ++------------------------+------------+----------+----------+ +| Header row, column 1 | Header 2 | Header 3 | Header 4 | +| (header rows optional) | | | | ++========================+============+==========+==========+ +| body row 1, column 1 | column 2 | column 3 | column 4 | ++------------------------+------------+----------+----------+ +| body row 2 | Cells may span columns. | ++------------------------+------------+---------------------+ +| body row 3 | Cells may | \[ | ++------------------------+ span rows. | f(n) = \sum_{i=1} | +| body row 4 | | \] | ++------------------------+------------+---------------------+ diff --git a/haddock-library/fixtures/examples/table1.parsed b/haddock-library/fixtures/examples/table1.parsed new file mode 100644 index 00000000..2fa58fd8 --- /dev/null +++ b/haddock-library/fixtures/examples/table1.parsed @@ -0,0 +1,81 @@ +DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " body row 1, column 1 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 4 ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " body row 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 3, + tableCellContents = DocString " Cells may span columns. ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " body row 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat + [" Cells may \n", + " span rows. \n", + " "]), + tableCellRowspan = 2}, + TableCell + {tableCellColspan = 2, + tableCellContents = DocAppend + (DocString " ") + (DocAppend + (DocMathDisplay + (concat + [" \n", + " f(n) = \\sum_{i=1} \n", + " "])) + (DocString " ")), + tableCellRowspan = 2}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " body row 4 ", + tableCellRowspan = 1}]], + tableHeaderRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat + [" Header row, column 1 \n", + " (header rows optional) "]), + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat [" Header 2 \n", " "]), + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat [" Header 3 \n", " "]), + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat [" Header 4 \n", " "]), + tableCellRowspan = 1}]]} diff --git a/haddock-library/fixtures/examples/table2.input b/haddock-library/fixtures/examples/table2.input new file mode 100644 index 00000000..aa5d0862 --- /dev/null +++ b/haddock-library/fixtures/examples/table2.input @@ -0,0 +1,7 @@ ++--------------+----------+-----------+-----------+ +| row 1, col 1 | column 2 | column 3 | column 4 | ++--------------+----------+-----------+-----------+ +| row 2 | | ++--------------+----------+-----------+-----------+ +| row 3 | | | | ++--------------+----------+-----------+-----------+ diff --git a/haddock-library/fixtures/examples/table2.parsed b/haddock-library/fixtures/examples/table2.parsed new file mode 100644 index 00000000..e3dbf0b4 --- /dev/null +++ b/haddock-library/fixtures/examples/table2.parsed @@ -0,0 +1,46 @@ +DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 1, col 1 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 4 ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 3, + tableCellContents = DocString " ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}]], + tableHeaderRows = []} diff --git a/haddock-library/fixtures/examples/table3.input b/haddock-library/fixtures/examples/table3.input new file mode 100644 index 00000000..a6ca84ca --- /dev/null +++ b/haddock-library/fixtures/examples/table3.input @@ -0,0 +1,7 @@ ++--------------+----------+-----------+-----------+ +| row 1, col 1 | column 2 | column 3 | column 4 | ++--------------+----------+-----------+-----------+ +| row 2 | Use the command ``ls | more``. | ++--------------+----------+-----------+-----------+ +| row 3 | | | | ++--------------+----------+-----------+-----------+ diff --git a/haddock-library/fixtures/examples/table3.parsed b/haddock-library/fixtures/examples/table3.parsed new file mode 100644 index 00000000..cabff9cb --- /dev/null +++ b/haddock-library/fixtures/examples/table3.parsed @@ -0,0 +1,50 @@ +DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 1, col 1 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 4 ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 2, + tableCellContents = DocString " Use the command ``ls ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " more``. ", + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}]], + tableHeaderRows = []} diff --git a/haddock-library/fixtures/examples/table4.input b/haddock-library/fixtures/examples/table4.input new file mode 100644 index 00000000..2c5611c8 --- /dev/null +++ b/haddock-library/fixtures/examples/table4.input @@ -0,0 +1,17 @@ +Single outer cell: + ++-------------+ +| outer | +| | ++-------+ | +| inner | | ++-------+-----+ + +Broken (only inner cell is rendered): + ++-------+-----+ +| inner | | ++-------+ | +| | +| outer | ++-------------+ diff --git a/haddock-library/fixtures/examples/table4.parsed b/haddock-library/fixtures/examples/table4.parsed new file mode 100644 index 00000000..cfdd6f0f --- /dev/null +++ b/haddock-library/fixtures/examples/table4.parsed @@ -0,0 +1,26 @@ +DocAppend + (DocParagraph (DocString "Single outer cell:")) + (DocAppend + (DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat + [" outer \n", + " \n", + "-------+ \n", + " inner | "]), + tableCellRowspan = 1}]], + tableHeaderRows = []}) + (DocAppend + (DocParagraph (DocString "Broken (only inner cell is rendered):")) + (DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " inner ", + tableCellRowspan = 1}]], + tableHeaderRows = []}))) diff --git a/haddock-library/fixtures/examples/table5.input b/haddock-library/fixtures/examples/table5.input new file mode 100644 index 00000000..7cf26512 --- /dev/null +++ b/haddock-library/fixtures/examples/table5.input @@ -0,0 +1,8 @@ ++--------------+----------+-----------+-----------+ +| row 1, col 1 | column 2 | column 3 | column 4 | ++==============+==========+===========+===========+ +| row 2 | Use the command @ls | more@. | +| | | +| +----------+-----------+-----------+ +| row 3 | | | | ++--------------+----------+-----------+-----------+ diff --git a/haddock-library/fixtures/examples/table5.parsed b/haddock-library/fixtures/examples/table5.parsed new file mode 100644 index 00000000..9a547ad3 --- /dev/null +++ b/haddock-library/fixtures/examples/table5.parsed @@ -0,0 +1,53 @@ +DocTable + Table + {tableBodyRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString + (concat + [" row 2 \n", + " \n", + " \n", + " row 3 "]), + tableCellRowspan = 2}, + TableCell + {tableCellColspan = 3, + tableCellContents = DocAppend + (DocString " Use the command ") + (DocAppend + (DocMonospaced (DocString "ls | more")) + (DocString + (concat + [". \n", + " "]))), + tableCellRowspan = 1}], + TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " ", + tableCellRowspan = 1}]], + tableHeaderRows = [TableRow + [TableCell + {tableCellColspan = 1, + tableCellContents = DocString " row 1, col 1 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 2 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 3 ", + tableCellRowspan = 1}, + TableCell + {tableCellColspan = 1, + tableCellContents = DocString " column 4 ", + tableCellRowspan = 1}]]} diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 2707a928..62df724b 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -18,12 +18,14 @@ build-type: Simple cabal-version: >= 2.0 extra-source-files: CHANGES.md + library default-language: Haskell2010 build-depends: base >= 4.5 && < 4.12 , bytestring >= 0.9.2.1 && < 0.11 + , containers >= 0.4.2.1 && < 0.6 , transformers >= 0.3.0 && < 0.6 -- internal sub-lib @@ -108,6 +110,7 @@ test-suite spec build-depends: base-compat ^>= 0.9.3 + , containers >= 0.4.2.1 && < 0.6 , transformers >= 0.3.0 && < 0.6 , hspec ^>= 2.4.4 , QuickCheck ^>= 2.10 diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index 1bf6c084..da8edcd4 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -30,6 +30,7 @@ markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax markup m (DocProperty p) = markupProperty m p markup m (DocExamples e) = markupExample m e markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t)) +markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a) markupPair m (a,b) = (markup m a, markup m b) @@ -59,5 +60,6 @@ idMarkup = Markup { markupMathDisplay = DocMathDisplay, markupProperty = DocProperty, markupExample = DocExamples, - markupHeader = DocHeader + markupHeader = DocHeader, + markupTable = DocTable } diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 4ea87db7..a1349c95 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -24,15 +24,17 @@ import Control.Arrow (first) import Control.Monad import qualified Data.ByteString.Char8 as BS import Data.Char (chr, isAsciiUpper) -import Data.List (stripPrefix, intercalate, unfoldr) -import Data.Maybe (fromMaybe) +import Data.List (stripPrefix, intercalate, unfoldr, elemIndex) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid +import qualified Data.Set as Set import Documentation.Haddock.Doc import Documentation.Haddock.Parser.Monad hiding (take, endOfLine) import Documentation.Haddock.Parser.Util import Documentation.Haddock.Types import Documentation.Haddock.Utf8 import Prelude hiding (takeWhile) +import qualified Prelude as P -- $setup -- >>> :set -XOverloadedStrings @@ -79,6 +81,7 @@ overIdentifier f d = g d g (DocProperty x) = DocProperty x g (DocExamples x) = DocExamples x g (DocHeader (Header l x)) = DocHeader . Header l $ g x + g (DocTable (Table h b)) = DocTable (Table (map (fmap g) h) (map (fmap g) b)) parse :: Parser a -> BS.ByteString -> (ParserState, a) parse p = either err id . parseOnly (p <* endOfInput) @@ -251,7 +254,7 @@ markdownImage = fromHyperlink <$> ("!" *> linkParser) -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) -paragraph = examples <|> do +paragraph = examples <|> table <|> do indent <- takeIndent choice [ since @@ -266,6 +269,193 @@ paragraph = examples <|> do , docParagraph <$> textParagraph ] +-- | Provides support for grid tables. +-- +-- Tables are composed by an optional header and body. The header is composed by +-- a single row. The body is composed by a non-empty list of rows. +-- +-- Example table with header: +-- +-- > +----------+----------+ +-- > | /32bit/ | 64bit | +-- > +==========+==========+ +-- > | 0x0000 | @0x0000@ | +-- > +----------+----------+ +-- +-- Algorithms loosely follows ideas in +-- http://docutils.sourceforge.net/docutils/parsers/rst/tableparser.py +-- +table :: Parser (DocH mod Identifier) +table = do + -- first we parse the first row, which determines the width of the table + firstRow <- parseFirstRow + let len = BS.length firstRow + + -- then we parse all consequtive rows starting and ending with + or |, + -- of the width `len`. + restRows <- many (parseRestRows len) + + -- Now we gathered the table block, the next step is to split the block + -- into cells. + DocTable <$> tableStepTwo len (firstRow : restRows) + where + parseFirstRow :: Parser BS.ByteString + parseFirstRow = do + skipHorizontalSpace + -- upper-left corner is + + c <- char '+' + cs <- many1 (char '-' <|> char '+') + + -- upper right corner is + too + guard (last cs == '+') + + -- trailing space + skipHorizontalSpace + _ <- char '\n' + + return (BS.cons c $ BS.pack cs) + + parseRestRows :: Int -> Parser BS.ByteString + parseRestRows l = do + skipHorizontalSpace + + c <- char '|' <|> char '+' + bs <- scan (l - 2) predicate + c2 <- char '|' <|> char '+' + + -- trailing space + skipHorizontalSpace + _ <- char '\n' + + return (BS.cons c (BS.snoc bs c2)) + where + predicate n c + | n <= 0 = Nothing + | c == '\n' = Nothing + | otherwise = Just (n - 1) + +-- Second step searchs for row of '+' and '=' characters, records it's index +-- and changes to '=' to '-'. +tableStepTwo + :: Int -- ^ width + -> [BS.ByteString] -- ^ rows + -> Parser (Table (DocH mod Identifier)) +tableStepTwo width = go 0 [] where + go _ left [] = tableStepThree width (reverse left) Nothing + go n left (r : rs) + | BS.all (`elem` ['+', '=']) r = + tableStepThree width (reverse left ++ r' : rs) (Just n) + | otherwise = + go (n + 1) (r : left) rs + where + r' = BS.map (\c -> if c == '=' then '-' else c) r + +-- Third step recognises cells in the table area, returning a list of TC, cells. +tableStepThree + :: Int -- ^ width + -> [BS.ByteString] -- ^ rows + -> Maybe Int -- ^ index of header separator + -> Parser (Table (DocH mod Identifier)) +tableStepThree width rs hdrIndex = do + cells <- loop (Set.singleton (0, 0)) + tableStepFour rs hdrIndex cells + where + height = length rs + + loop :: Set.Set (Int, Int) -> Parser [TC] + loop queue = case Set.minView queue of + Nothing -> return [] + Just ((y, x), queue') + | y + 1 >= height || x + 1 >= width -> loop queue' + | otherwise -> case scanRight x y of + Nothing -> loop queue' + Just (x2, y2) -> do + let tc = TC y x y2 x2 + fmap (tc :) $ loop $ queue' `Set.union` Set.fromList + [(y, x2), (y2, x), (y2, x2)] + + -- scan right looking for +, then try scan down + -- + -- do we need to record + saw on the way left and down? + scanRight :: Int -> Int -> Maybe (Int, Int) + scanRight x y = go (x + 1) where + bs = rs !! y + go x' | x' >= width = fail "overflow right " + | BS.index bs x' == '+' = scanDown x y x' <|> go (x' + 1) + | BS.index bs x' == '-' = go (x' + 1) + | otherwise = fail $ "not a border (right) " ++ show (x,y,x') + + -- scan down looking for + + scanDown :: Int -> Int -> Int -> Maybe (Int, Int) + scanDown x y x2 = go (y + 1) where + go y' | y' >= height = fail "overflow down" + | BS.index (rs !! y') x2 == '+' = scanLeft x y x2 y' <|> go (y' + 1) + | BS.index (rs !! y') x2 == '|' = go (y' + 1) + | otherwise = fail $ "not a border (down) " ++ show (x,y,x2,y') + + -- check that at y2 x..x2 characters are '+' or '-' + scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int) + scanLeft x y x2 y2 + | all (\x' -> BS.index bs x' `elem` ['+', '-']) [x..x2] = scanUp x y x2 y2 + | otherwise = fail $ "not a border (left) " ++ show (x,y,x2,y2) + where + bs = rs !! y2 + + -- check that at y2 x..x2 characters are '+' or '-' + scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int) + scanUp x y x2 y2 + | all (\y' -> BS.index (rs !! y') x `elem` ['+', '|']) [y..y2] = return (x2, y2) + | otherwise = fail $ "not a border (up) " ++ show (x,y,x2,y2) + +-- | table cell: top left bottom right +data TC = TC !Int !Int !Int !Int + deriving Show + +tcXS :: TC -> [Int] +tcXS (TC _ x _ x2) = [x, x2] + +tcYS :: TC -> [Int] +tcYS (TC y _ y2 _) = [y, y2] + +-- | Fourth step. Given the locations of cells, forms 'Table' structure. +tableStepFour :: [BS.ByteString] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier)) +tableStepFour rs hdrIndex cells = case hdrIndex of + Nothing -> return $ Table [] rowsDoc + Just i -> case elemIndex i yTabStops of + Nothing -> return $ Table [] rowsDoc + Just i' -> return $ uncurry Table $ splitAt i' rowsDoc + where + xTabStops = sortNub $ concatMap tcXS cells + yTabStops = sortNub $ concatMap tcYS cells + + sortNub :: Ord a => [a] -> [a] + sortNub = Set.toList . Set.fromList + + init' :: [a] -> [a] + init' [] = [] + init' [_] = [] + init' (x : xs) = x : init' xs + + rowsDoc = (fmap . fmap) parseStringBS rows + + rows = map makeRow (init' yTabStops) + where + makeRow y = TableRow $ mapMaybe (makeCell y) cells + makeCell y (TC y' x y2 x2) + | y /= y' = Nothing + | otherwise = Just $ TableCell xts yts (extract (x + 1) (y + 1) (x2 - 1) (y2 - 1)) + where + xts = length $ P.takeWhile (< x2) $ dropWhile (< x) xTabStops + yts = length $ P.takeWhile (< y2) $ dropWhile (< y) yTabStops + + -- extract cell contents given boundaries + extract :: Int -> Int -> Int -> Int -> BS.ByteString + extract x y x2 y2 = BS.intercalate "\n" + [ BS.take (x2 - x + 1) $ BS.drop x $ rs !! y' + | y' <- [y .. y2] + ] + +-- | Parse \@since annotations. since :: Parser (DocH mod a) since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty where diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 1e76c631..96653864 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -81,6 +81,21 @@ data Example = Example , exampleResult :: [String] } deriving (Eq, Show) +data TableCell id = TableCell + { tableCellColspan :: Int + , tableCellRowspan :: Int + , tableCellContents :: id + } deriving (Eq, Show, Functor, Foldable, Traversable) + +newtype TableRow id = TableRow + { tableRowCells :: [TableCell id] + } deriving (Eq, Show, Functor, Foldable, Traversable) + +data Table id = Table + { tableHeaderRows :: [TableRow id] + , tableBodyRows :: [TableRow id] + } deriving (Eq, Show, Functor, Foldable, Traversable) + data DocH mod id = DocEmpty | DocAppend (DocH mod id) (DocH mod id) @@ -105,6 +120,7 @@ data DocH mod id | DocProperty String | DocExamples [Example] | DocHeader (Header (DocH mod id)) + | DocTable (Table (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) #if MIN_VERSION_base(4,8,0) @@ -132,6 +148,7 @@ instance Bifunctor DocH where bimap _ _ (DocProperty s) = DocProperty s bimap _ _ (DocExamples examples) = DocExamples examples bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title)) + bimap f g (DocTable (Table header body)) = DocTable (Table (map (fmap (bimap f g)) header) (map (fmap (bimap f g)) body)) #endif #if MIN_VERSION_base(4,10,0) @@ -149,6 +166,7 @@ instance Bifoldable DocH where bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title + bifoldr f g z (DocTable (Table header body)) = foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) (foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) z body) header bifoldr _ _ z _ = z instance Bitraversable DocH where @@ -175,6 +193,7 @@ instance Bitraversable DocH where bitraverse _ _ (DocProperty s) = pure (DocProperty s) bitraverse _ _ (DocExamples examples) = pure (DocExamples examples) bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title + bitraverse f g (DocTable (Table header body)) = (\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body #endif -- | 'DocMarkupH' is a set of instructions for marking up documentation. @@ -209,4 +228,5 @@ data DocMarkupH mod id a = Markup , markupProperty :: String -> a , markupExample :: [Example] -> a , markupHeader :: Header a -> a + , markupTable :: Table a -> a } diff --git a/html-test/ref/Table.html b/html-test/ref/Table.html new file mode 100644 index 00000000..959f18b2 --- /dev/null +++ b/html-test/ref/Table.html @@ -0,0 +1,238 @@ +Table
    Safe HaskellSafe

    Table

    Description

    This tests the table markup

    Synopsis

    Documentation

    tableWithHeader :: a -> a #

    Table with header.

    code message description
    200 OK operation successful
    204 No Content operation successful, no body returned

    tableWithoutHeader :: a -> a #

    Table without header.

    200 OK operation successful
    204 No Content operation successful, no body returned
    404 Not Found resource not found

    fancyTable :: a -> a #

    Fancy table.

    Header row, column 1 + (header rows optional) Header 2 + Header 3 + Header 4 +
    body row 1, column 1 column 2 column 3 column 4
    tableWithHeader Cells may span columns.
    body row 3 Cells may + span rows. + \[ + f(n) = \sum_{i=1} + \]
    body row 4
    \ No newline at end of file diff --git a/html-test/src/Table.hs b/html-test/src/Table.hs new file mode 100644 index 00000000..2cf0c662 --- /dev/null +++ b/html-test/src/Table.hs @@ -0,0 +1,47 @@ +-- | This tests the table markup +module Table + ( tableWithHeader + , tableWithoutHeader + , fancyTable + ) where + +-- | Table with header. +-- +-- +------+--------------+------------------------------------------+ +-- | code | message | description | +-- +======+==============+==========================================+ +-- | 200 | @OK@ | operation successful | +-- +------+--------------+------------------------------------------+ +-- | 204 | @No Content@ | operation successful, no body returned | +-- +------+--------------+------------------------------------------+ +tableWithHeader :: a -> a +tableWithHeader a = a + +-- | Table without header. +-- +-- +------+--------------+------------------------------------------+ +-- | 200 | @OK@ | operation successful | +-- +------+--------------+------------------------------------------+ +-- | 204 | @No Content@ | operation successful, no body returned | +-- +------+--------------+------------------------------------------+ +-- | 404 | @Not Found@ | resource not found | +-- +------+--------------+------------------------------------------+ +tableWithoutHeader :: a -> a +tableWithoutHeader a = a + +-- | Fancy table. +-- +-- +------------------------+------------+----------+----------+ +-- | Header row, column 1 | Header 2 | Header 3 | Header 4 | +-- | (header rows optional) | | | | +-- +========================+============+==========+==========+ +-- | body row 1, column 1 | column 2 | column 3 | column 4 | +-- +------------------------+------------+----------+----------+ +-- | 'tableWithHeader' | Cells may span columns. | +-- +------------------------+------------+---------------------+ +-- | body row 3 | Cells may | \[ | +-- +------------------------+ span rows. | f(n) = \sum_{i=1} | +-- | body row 4 | | \] | +-- +------------------------+------------+---------------------+ +fancyTable :: a -> a +fancyTable x = x -- cgit v1.2.3 From 9fd7f8bff6bdb6459fbecdc02db09789cfb6c816 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Fri, 5 Jan 2018 10:43:15 +0100 Subject: Add grid table example to cheatsheet (pdf and svg need to be regenerated thought) --- doc/cheatsheet/haddocks.md | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/doc/cheatsheet/haddocks.md b/doc/cheatsheet/haddocks.md index fbe71392..a3464584 100644 --- a/doc/cheatsheet/haddocks.md +++ b/doc/cheatsheet/haddocks.md @@ -118,3 +118,20 @@ definitions with "[thing]" {-# OPTIONS_HADDOCK show-extensions #-} Show all enabled LANGUAGE extensions ``` + +# Grid tables + +``` ++------------------------+------------+----------+----------+ +| Header row, column 1 | Header 2 | Header 3 | Header 4 | +| (header rows optional) | | | | ++========================+============+==========+==========+ +| body row 1, column 1 | column 2 | column 3 | column 4 | ++------------------------+------------+----------+----------+ +| body row 2 | Cells may span columns. | ++------------------------+------------+---------------------+ +| body row 3 | Cells may | \[ | ++------------------------+ span rows. | f(n) = \sum_{i=1} | +| body row 4 | | \] | ++------------------------+------------+---------------------+ +``` -- cgit v1.2.3 From 6ed6c110c874a746b002aca148192c3cbc819d7f Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Fri, 5 Jan 2018 09:59:59 -0800 Subject: Fix infinite loop when specializing instance heads (#723) * Fix infinite loop when specializing instance heads The bug can only be triggered from TH, hence why it went un-noticed for so long. * Add test for #679 and #710 --- haddock-api/src/Haddock/Interface/Specialize.hs | 20 +-- html-test/ref/Bug679.html | 196 ++++++++++++++++++++++++ html-test/src/Bug679.hs | 24 +++ 3 files changed, 230 insertions(+), 10 deletions(-) create mode 100644 html-test/ref/Bug679.html create mode 100644 html-test/src/Bug679.hs diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 6d2888d3..bb27f10c 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -31,23 +31,23 @@ import qualified Data.Set as Set specialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name)) => Data a => [(IdP name, HsType name)] -> a -> a -specialize specs = go +specialize specs = go spec_map0 where - go :: forall x. Data x => x -> x - go = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var + go :: forall x. Data x => Map name (HsType name) -> x -> x + go spec_map = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map strip_kind_sig :: HsType name -> HsType name strip_kind_sig (HsKindSig (L _ t) _) = t strip_kind_sig typ = typ - specialize_ty_var :: HsType name -> HsType name - specialize_ty_var (HsTyVar _ (L _ name')) + specialize_ty_var :: Map name (HsType name) -> HsType name -> HsType name + specialize_ty_var spec_map (HsTyVar _ (L _ name')) | Just t <- Map.lookup name' spec_map = t - specialize_ty_var typ = typ - -- This is a tricky recursive definition that is guaranteed to terminate - -- because a type binder cannot be instantiated with a type that depends - -- on that binder. i.e. @a -> Maybe a@ is invalid - spec_map = Map.fromList [ (n, go t) | (n, t) <- specs] + specialize_ty_var _ typ = typ + + -- This is a tricky recursive definition. By adding in the specializations + -- one by one, we should avoid infinite loops. + spec_map0 = foldr (\(n,t) acc -> Map.insert n (go acc t) acc) mempty specs -- | Instantiate given binders with corresponding types. diff --git a/html-test/ref/Bug679.html b/html-test/ref/Bug679.html new file mode 100644 index 00000000..ddec7a12 --- /dev/null +++ b/html-test/ref/Bug679.html @@ -0,0 +1,196 @@ +Bug679
    Safe HaskellNone

    Bug679

    Documentation

    data Bar a #

    Constructors

    Bar
    Instances
    Foo (Bar a) #
    Instance details

    Methods

    foo :: Bar a -> Bar a #

    class Foo a where #

    Minimal complete definition

    foo

    Methods

    foo :: a -> a #

    Instances
    Foo (Bar a) #
    Instance details

    Methods

    foo :: Bar a -> Bar a #

    \ No newline at end of file diff --git a/html-test/src/Bug679.hs b/html-test/src/Bug679.hs new file mode 100644 index 00000000..dba194c4 --- /dev/null +++ b/html-test/src/Bug679.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Bug679 where + +import Language.Haskell.TH + +data Bar a = Bar + +$(do + a <- newName "a" + + let classN = mkName "Foo" + let methodN = mkName "foo" + + methodTy <- [t| $(varT a) -> $(varT a) |] + let cla = ClassD [] classN [PlainTV a] [] [SigD methodN methodTy] + + -- Note that we are /reusing/ the same type variable 'a' as in the class + instanceHead <- [t| $(conT classN) (Bar $(varT a)) |] + idCall <- [e| id |] + let ins = InstanceD Nothing [] instanceHead [FunD methodN [Clause [] (NormalB idCall) []]] + + pure [cla,ins]) + -- cgit v1.2.3 From 854083b44b8fe3924e1ee3926192adfae36ea16a Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 7 Jan 2018 03:59:14 -0800 Subject: Filter RTS arguments from 'ghc-options' arguments (#725) This fixes #666. --- haddock-api/src/Haddock.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 3f5e5298..23fefb3b 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -439,13 +439,26 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do _ <- setSessionDynFlags dynflags'' ghcActs dynflags'' where + + -- ignore sublists of flags that start with "+RTS" and end in "-RTS" + -- + -- See https://github.com/haskell/haddock/issues/666 + filterRtsFlags :: [String] -> [String] + filterRtsFlags flgs = foldr go (const []) flgs True + where go "-RTS" func _ = func True + go "+RTS" func _ = func False + go _ func False = func False + go arg func True = arg : func True + + parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags parseGhcFlags dynflags = do -- TODO: handle warnings? - (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags) + let flags' = filterRtsFlags flags + (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags') if not (null rest) - then throwE ("Couldn't parse GHC options: " ++ unwords flags) + then throwE ("Couldn't parse GHC options: " ++ unwords flags') else return dynflags' unsetPatternMatchWarnings :: DynFlags -> DynFlags -- cgit v1.2.3 From 1691a5fc1856fef66ceb81834e985465668a52df Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Mon, 15 Jan 2018 11:30:55 +0100 Subject: Quickjump Scrollable overlay --- haddock-api/resources/html/quick-jump.css | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/haddock-api/resources/html/quick-jump.css b/haddock-api/resources/html/quick-jump.css index ede05042..468d8036 100644 --- a/haddock-api/resources/html/quick-jump.css +++ b/haddock-api/resources/html/quick-jump.css @@ -8,6 +8,7 @@ width: 44em; z-index: 1000; pointer-events: none; + overflow-y: auto; } #search.hidden { @@ -42,7 +43,6 @@ box-sizing: border-box; border: 0.05em solid #b2d5fb; background: #e8f3ff; - overflow-y: auto; } #search-form input + #search-results { @@ -161,4 +161,4 @@ margin: 0 0.1em; } -/* @end */ \ No newline at end of file +/* @end */ -- cgit v1.2.3 From 150c8fc2415ab6cd254c9391d1a00b3d2931927e Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:04:53 +0100 Subject: Hyperlinker: Adjust parser to new PFailed constructor --- haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index da1555b8..0ea3eba2 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -48,23 +48,23 @@ processCPP dflags fpath s = addSrc . go start . splitCPP $ s go pos ls = let (hLinesRight, ls') = span isRight ls (cppLinesLeft, rest) = span isLeft ls' - + hSrc = concat [ hLine | Right hLine <- hLinesRight ] cppSrc = concat [ cppLine | Left cppLine <- cppLinesLeft ] - + in case L.lexTokenStream (stringToStringBuffer hSrc) pos dflags of -- Stuff that fails to lex gets turned into comments - L.PFailed _ss _msg -> + L.PFailed _ _ss _msg -> let (src_pos, failed) = mkToken ITunknown pos hSrc (new_pos, cpp) = mkToken ITlineComment src_pos cppSrc in failed : cpp : go new_pos rest - -- Successfully lexed + -- Successfully lexed L.POk ss toks -> let (new_pos, cpp) = mkToken ITlineComment (L.loc ss) cppSrc in toks ++ [cpp] ++ go new_pos rest - + -- Manually make a token from a 'String', advancing the cursor position mkToken tok start' str = let end = foldl' advanceSrcLoc start' str @@ -107,7 +107,7 @@ isCPPline = isPrefixOf "#" . dropWhile (`elem` " \t") . take 5 -- | Split a "line" off the front of a string, supporting newline escapes. -- -- By "line", we understand: the shortest substring ending in a '\n' that is not --- +-- -- 1. immediately preceded by a '\\' -- 2. not inside some (possibly nested) block comment -- @@ -124,10 +124,10 @@ spanToNewline n ('\\':'\n':str) = in ('\\':'\n':str', rest) spanToNewline n ('{':'-':str) = let (str', rest) = spanToNewline (n+1) str - in ('{':'-':str', rest) + in ('{':'-':str', rest) spanToNewline n ('-':'}':str) = let (str', rest) = spanToNewline (n-1) str - in ('-':'}':str', rest) + in ('-':'}':str', rest) spanToNewline n (c:str) = let (str', rest) = spanToNewline n str in (c:str', rest) -- cgit v1.2.3 From 4157ea0637016b4b65386ddb3eb2b9bcf2aaa0b8 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:05:19 +0100 Subject: Specialize: Add missing IdP annotations --- haddock-api/src/Haddock/Interface/Specialize.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index bb27f10c..a54aad90 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -33,14 +33,14 @@ specialize :: forall name a. (Ord (IdP name), DataId name, NamedThing (IdP name) => [(IdP name, HsType name)] -> a -> a specialize specs = go spec_map0 where - go :: forall x. Data x => Map name (HsType name) -> x -> x + go :: forall x. Data x => Map (IdP name) (HsType name) -> x -> x go spec_map = everywhereButType @name $ mkT $ sugar . strip_kind_sig . specialize_ty_var spec_map strip_kind_sig :: HsType name -> HsType name strip_kind_sig (HsKindSig (L _ t) _) = t strip_kind_sig typ = typ - specialize_ty_var :: Map name (HsType name) -> HsType name -> HsType name + specialize_ty_var :: Map (IdP name) (HsType name) -> HsType name -> HsType name specialize_ty_var spec_map (HsTyVar _ (L _ name')) | Just t <- Map.lookup name' spec_map = t specialize_ty_var _ typ = typ -- cgit v1.2.3 From fb8dd7488f956e42c1dae4d041ca2c7064fb3e78 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:06:52 +0100 Subject: Convert: Correct pass type --- haddock-api/src/Haddock/Convert.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index b712660f..68f39cf2 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE CPP, PatternGuards #-} ----------------------------------------------------------------------------- -- | @@ -268,7 +267,7 @@ synifyTyCon coax tc -- -- Which is entirely wrong (#548). We only want to display the *return* kind, -- which this function obtains. -synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind Name) +synifyDataTyConReturnKind :: TyCon -> Maybe (LHsKind GhcRn) synifyDataTyConReturnKind tc = case splitFunTys (tyConKind tc) of (_, ret_kind) -- cgit v1.2.3 From bfd1b156e9bd4c3b2b70b03cb59f778a1061daed Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:12:57 +0100 Subject: Warning free compilation --- haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 1 - haddock-api/src/Haddock/Convert.hs | 2 +- haddock-api/src/Haddock/Interface/AttachInstances.hs | 1 - haddock-api/src/Haddock/Interface/LexParseRn.hs | 1 - 4 files changed, 1 insertion(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 27bf7605..5291220a 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -15,7 +15,6 @@ import System.FilePath.Posix (()) import Data.List import Data.Maybe -import Data.Monoid import qualified Data.Map as Map import Text.XHtml (Html, HtmlAttr, (!)) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 68f39cf2..8b227c50 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -37,7 +37,7 @@ import Type import TyCoRep import TysPrim ( alphaTyVars ) import TysWiredIn ( listTyConName, starKindTyConName, unitTy ) -import PrelNames ( hasKey, eqTyConKey, funTyConKey, ipClassKey +import PrelNames ( hasKey, eqTyConKey, ipClassKey , tYPETyConKey, liftedRepDataConKey ) import Unique ( getUnique ) import Util ( chkAppend, compareLength, dropList, filterByList, filterOut diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 4fd9d264..ec8b98c8 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -19,7 +19,6 @@ import Haddock.Types import Haddock.Convert import Haddock.GhcUtils -import Control.Applicative import Control.Arrow hiding ((<+>)) import Data.List import Data.Ord (comparing) diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 311301ee..1269df3f 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -18,7 +18,6 @@ module Haddock.Interface.LexParseRn , processModuleHeader ) where -import Data.IntSet (toList) import Data.List import Documentation.Haddock.Doc (metaDocConcat) import DynFlags (languageExtensions) -- cgit v1.2.3 From c7e8c500c1a67a28e571403b58993d22f0c84b43 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:20:29 +0100 Subject: hadock-2.19.0 / haddock-api-2.19.0 / haddock-library-1.5.0 --- haddock-api/haddock-api.cabal | 6 +++--- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 95af5ef5..0acbcb74 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.18.2 +version: 2.19.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -44,7 +44,7 @@ library , Cabal ^>= 2.0.0 , ghc ^>= 8.4 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.4.6 + , haddock-library ^>= 1.5.0 , xhtml ^>= 3000.2.2 -- Versions for the dependencies below are transitively pinned by @@ -169,7 +169,7 @@ test-suite spec build-depends: Cabal ^>= 2.0.0 , ghc ^>= 8.4 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.4.6 + , haddock-library ^>= 1.5.0 , xhtml ^>= 3000.2.2 , hspec ^>= 2.4.4 , QuickCheck ^>= 2.10 diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 62df724b..3d069f07 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.6 +version: 1.5.0 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it diff --git a/haddock.cabal b/haddock.cabal index af7d7b4f..f6d6fa51 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.18.2 +version: 2.19.0 synopsis: A documentation-generation tool for Haskell libraries description: This is Haddock, a tool for automatically generating documentation @@ -153,7 +153,7 @@ executable haddock else -- in order for haddock's advertised version number to have proper meaning, -- we pin down to a single haddock-api version. - build-depends: haddock-api == 2.18.2 + build-depends: haddock-api == 2.19.0 other-modules: ResponseFile -- cgit v1.2.3 From 2ec76bc93bf50fa33039f2ade396005e36d6857f Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 11:57:12 +0100 Subject: Adjust changelogs --- CHANGES.md | 7 ++++--- haddock-library/CHANGES.md | 6 +++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7127df79..38346c00 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,9 +1,10 @@ -## Changes in version 2.18.2 - - * to be released +## Changes in version 2.19.0 * Haddock now supports tables in documentation inspired by reSTs grid tables + * `--quickjump` allows for quick navigation in documentation on hackage and + other documentation hosting sites. + * A --reexport flag, which can be used to add extra modules to the top-level module tree diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index 53d17f5e..59bce67e 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -1,9 +1,9 @@ -## Changes in version 1.4.6 - - * to be released +## Changes in version 1.5.0 * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc + * Support for grid tables + ## Changes in version 1.4.5 * Move markup related data types to haddock-library -- cgit v1.2.3 From d314d0c3c9d6213417954f46757c511864077927 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 1 Feb 2018 14:54:04 +0100 Subject: haddock-library: Info about breaking changes --- haddock-library/CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index 59bce67e..8b7806bc 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -3,6 +3,9 @@ * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc * Support for grid tables + * added `DocTable` constructor to `DocH` + * added `Table`, `TableCell` and `TableRow` data types + * added `markupTable` to `DocMarkupH` data type ## Changes in version 1.4.5 -- cgit v1.2.3 From 97b0189927924b82ee26f762c88ccd965eee8d80 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 22 Jan 2018 11:44:04 -0800 Subject: Properly color pragma contents in hyperlinker The hyperlinker backend now classifies the content of pragmas as 'TkPragma'. That means that in something like '{-# INLINE foo #-}', 'foo' still gets classified as a pragma token. --- .../src/Haddock/Backends/Hyperlinker/Parser.hs | 78 ++++++++++++++++++---- 1 file changed, 65 insertions(+), 13 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index 0ea3eba2..cd2237e9 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -136,22 +136,35 @@ spanToNewline n (c:str) = -- | Turn a list of GHC's 'L.Token' (and their source 'String') into a list of -- Haddock's 'T.Token'. ghcToks :: [(Located L.Token, String)] -> [T.Token] -ghcToks = reverse . snd . foldl' go (start, []) +ghcToks = reverse . (\(_,ts,_) -> ts) . foldl' go (start, [], False) where start = mkRealSrcLoc (mkFastString "lexing") 1 1 - go :: (RealSrcLoc, [T.Token]) -- ^ current position, tokens accumulated - -> (Located L.Token, String) -- ^ next token, its content - -> (RealSrcLoc, [T.Token]) -- ^ new position, new tokens accumulated - go (pos, toks) (L l tok, raw) = ( next_pos - , classifiedTok ++ maybeToList white ++ toks - ) + go :: (RealSrcLoc, [T.Token], Bool) + -- ^ current position, tokens accumulated, currently in pragma (or not) + + -> (Located L.Token, String) + -- ^ next token, its content + + -> (RealSrcLoc, [T.Token], Bool) + -- ^ new position, new tokens accumulated, currently in pragma (or not) + + go (pos, toks, in_prag) (L l tok, raw) = + ( next_pos + , classifiedTok ++ maybeToList white ++ toks + , inPragma in_prag tok + ) where (next_pos, white) = mkWhitespace pos l - classifiedTok = [ Token (classify tok) raw rss + + classifiedTok = [ Token (classify' tok) raw rss | RealSrcSpan rss <- [l] , not (null raw) ] + + classify' | in_prag = const TkPragma + | otherwise = classify + -- | Find the correct amount of whitespace between tokens. mkWhitespace :: RealSrcLoc -> SrcSpan -> (RealSrcLoc, Maybe T.Token) @@ -170,7 +183,7 @@ mkWhitespace prev spn = wsstring = replicate nls '\n' ++ replicate spaces ' ' --- | Classify given string as appropriate Haskell token. +-- | Classify given tokens as appropriate Haskell token type. classify :: L.Token -> TokenType classify tok = case tok of @@ -200,7 +213,7 @@ classify tok = ITtype -> TkKeyword ITwhere -> TkKeyword - ITforall {} -> TkKeyword + ITforall {} -> TkKeyword ITexport -> TkKeyword ITlabel -> TkKeyword ITdynamic -> TkKeyword @@ -235,7 +248,7 @@ classify tok = ITrules_prag {} -> TkPragma ITwarning_prag {} -> TkPragma ITdeprecated_prag {} -> TkPragma - ITline_prag -> TkPragma + ITline_prag {} -> TkPragma ITscc_prag {} -> TkPragma ITgenerated_prag {} -> TkPragma ITcore_prag {} -> TkPragma @@ -331,8 +344,8 @@ classify tok = ITidTyEscape {} -> TkUnknown ITparenTyEscape -> TkSpecial ITtyQuote -> TkSpecial - ITquasiQuote {} -> TkUnknown - ITqQuasiQuote {} -> TkUnknown + ITquasiQuote {} -> TkUnknown + ITqQuasiQuote {} -> TkUnknown ITproc -> TkKeyword ITrec -> TkKeyword @@ -366,3 +379,42 @@ classify tok = | isPrefixOf "{-#" c , isSuffixOf "#-}" c -> TkPragma | otherwise -> TkComment + +-- | Classify given tokens as beginning pragmas (or not). +inPragma :: Bool -- ^ currently in pragma + -> L.Token -- ^ current token + -> Bool -- ^ new information about whether we are in a pragma +inPragma _ ITclose_prag = False +inPragma True _ = True +inPragma False tok = + case tok of + ITinline_prag {} -> True + ITspec_prag {} -> True + ITspec_inline_prag {} -> True + ITsource_prag {} -> True + ITrules_prag {} -> True + ITwarning_prag {} -> True + ITdeprecated_prag {} -> True + ITline_prag {} -> True + ITscc_prag {} -> True + ITgenerated_prag {} -> True + ITcore_prag {} -> True + ITunpack_prag {} -> True + ITnounpack_prag {} -> True + ITann_prag {} -> True + ITcomplete_prag {} -> True + IToptions_prag {} -> True + ITinclude_prag {} -> True + ITlanguage_prag -> True + ITvect_prag {} -> True + ITvect_scalar_prag {} -> True + ITnovect_prag {} -> True + ITminimal_prag {} -> True + IToverlappable_prag {} -> True + IToverlapping_prag {} -> True + IToverlaps_prag {} -> True + ITincoherent_prag {} -> True + ITctype {} -> True + + _ -> False + -- cgit v1.2.3 From ac33472e834d381f95fd56586e57e6653263055c Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sat, 27 Jan 2018 00:42:02 -0800 Subject: Support the new 'ITcolumn_prag' token --- haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index cd2237e9..34512de8 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -249,6 +249,7 @@ classify tok = ITwarning_prag {} -> TkPragma ITdeprecated_prag {} -> TkPragma ITline_prag {} -> TkPragma + ITcolumn_prag {} -> TkPragma ITscc_prag {} -> TkPragma ITgenerated_prag {} -> TkPragma ITcore_prag {} -> TkPragma @@ -396,6 +397,7 @@ inPragma False tok = ITwarning_prag {} -> True ITdeprecated_prag {} -> True ITline_prag {} -> True + ITcolumn_prag {} -> True ITscc_prag {} -> True ITgenerated_prag {} -> True ITcore_prag {} -> True -- cgit v1.2.3 From 86292c54bfee2343aee84559ec01f1fc68f52231 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sat, 3 Feb 2018 11:47:10 +0100 Subject: QuickJump: Mitigate encoding problems on Windows --- haddock-api/src/Haddock/Backends/Xhtml.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 01c08f7a..60d3e985 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -36,11 +36,13 @@ import Text.XHtml hiding ( name, title, p, quote ) import Haddock.GhcUtils import Control.Monad ( when, unless ) +import qualified Data.ByteString.Builder as Builder import Data.Char ( toUpper, isSpace ) import Data.List ( sortBy, isPrefixOf, intercalate, intersperse ) import Data.Maybe -import System.FilePath hiding ( () ) import System.Directory +import System.FilePath hiding ( () ) +import qualified System.IO as IO import Data.Map ( Map ) import qualified Data.Map as Map hiding ( Map ) import qualified Data.Set as Set hiding ( Set ) @@ -353,9 +355,8 @@ ppJsonIndex :: FilePath -> IO () ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual_opt ifaces = do createDirectoryIfMissing True odir - writeFile (joinPath [odir, indexJsonFile]) - (encodeToString modules) - + IO.withFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \h -> do + Builder.hPutBuilder h (encodeToBuilder modules) where modules :: Value modules = Array (concatMap goInterface ifaces) -- cgit v1.2.3 From 4b907bfc8e6655a79e10b6d4850b9430c2f65eeb Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Sun, 4 Feb 2018 18:38:33 +0100 Subject: Use withBinaryFile --- haddock-api/src/Haddock/Backends/Xhtml.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 60d3e985..d03cf0ba 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -355,7 +355,7 @@ ppJsonIndex :: FilePath -> IO () ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual_opt ifaces = do createDirectoryIfMissing True odir - IO.withFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \h -> do + IO.withBinaryFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \h -> do Builder.hPutBuilder h (encodeToBuilder modules) where modules :: Value -- cgit v1.2.3 From 45d7f6388b9badb0eccc64076288137736d5284e Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Mon, 5 Feb 2018 09:48:32 +0100 Subject: Try GHC 8.4.1 for Travis CI job --- .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index f7a9d921..469d1672 100644 --- a/.travis.yml +++ b/.travis.yml @@ -26,9 +26,9 @@ before_cache: matrix: include: - - compiler: "ghc-8.2.1" + - compiler: "ghc-8.4.1" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}} - compiler: "ghc-head" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} -- cgit v1.2.3 From 9618091679cdbbcaac7622c0ff78f90a4fb58d83 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Mon, 5 Feb 2018 10:05:36 +0100 Subject: try harder to build w/ GHC 8.4.1 --- .travis.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index 469d1672..4afc18f4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -51,8 +51,8 @@ install: - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - rm -fv cabal.project.local - rm -f cabal.project.freeze - - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all - - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all + - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all + - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. @@ -69,12 +69,12 @@ script: - rm -fv cabal.project.local # this builds all libraries and executables (without tests/benchmarks) - rm -f cabal.project.freeze - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all # this builds all libraries and executables (including tests/benchmarks) # - rm -rf ./dist-newstyle # build & run tests - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + - cabal new-build -w ${HC} ${TEST} ${BENCH} --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all; fi # EOF -- cgit v1.2.3 From beb5a37119e99b8d414ca8f5729e01af6b767e7e Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Mon, 5 Feb 2018 07:36:03 +0100 Subject: Add `SPDX-License-Identifier` as alised for "license" module header tokens C.f. SPDX 2.1 - Appendix V https://spdx.org/spdx-specification-21-web-version#h.twlc0ztnng3b The tag should appear on its own line in the source file, generally as part of a comment. SPDX-License-Identifier: Cherry-picked from #743 --- CHANGES.md | 3 +++ haddock-api/src/Haddock/Interface/ParseModuleHeader.hs | 11 ++++++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 38346c00..ab2ef01a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,9 @@ * Overhaul Haddock's rendering of kind signatures so that invisible kind parameters are not printed (#681) + * Recognise `SPDX-License-Identifier` as alias for `License` in module header + parser (#743) + ## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs index 768a31ce..6690c22d 100644 --- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs +++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs @@ -37,21 +37,22 @@ parseModuleHeader dflags str0 = (copyrightOpt,str3) = getKey "Copyright" str2 (licenseOpt,str4) = getKey "License" str3 (licenceOpt,str5) = getKey "Licence" str4 - (maintainerOpt,str6) = getKey "Maintainer" str5 - (stabilityOpt,str7) = getKey "Stability" str6 - (portabilityOpt,str8) = getKey "Portability" str7 + (spdxLicenceOpt,str6) = getKey "SPDX-License-Identifier" str5 + (maintainerOpt,str7) = getKey "Maintainer" str6 + (stabilityOpt,str8) = getKey "Stability" str7 + (portabilityOpt,str9) = getKey "Portability" str8 in (HaddockModInfo { hmi_description = parseString dflags <$> descriptionOpt, hmi_copyright = copyrightOpt, - hmi_license = licenseOpt `mplus` licenceOpt, + hmi_license = spdxLicenceOpt `mplus` licenseOpt `mplus` licenceOpt, hmi_maintainer = maintainerOpt, hmi_stability = stabilityOpt, hmi_portability = portabilityOpt, hmi_safety = Nothing, hmi_language = Nothing, -- set in LexParseRn hmi_extensions = [] -- also set in LexParseRn - }, parseParas dflags str8) + }, parseParas dflags str9) -- | This function is how we read keys. -- -- cgit v1.2.3 From 55bd7476bb28dc39fc7dea959fb75f81035d3600 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Mon, 5 Feb 2018 10:24:34 +0100 Subject: Make test-suite SMP compatible --- haddock-library/test/Documentation/Haddock/ParserSpec.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index b63ece92..c605e2c2 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -10,6 +10,8 @@ import Documentation.Haddock.Doc (docAppend) import Test.Hspec import Test.QuickCheck +import Prelude hiding ((<>)) + infixr 6 <> (<>) :: Doc id -> Doc id -> Doc id (<>) = docAppend -- cgit v1.2.3 From 1e335fc0828f6f1927c6d2a125919c59f04c0bc0 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 5 Feb 2018 10:15:39 -0800 Subject: Hyperlink pattern synonyms and 'module' imports (#744) Links to pattern synonyms are now generated, as well as links from modules in import lists. Fixes #731. --- haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 361bc15d..841dff76 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -111,6 +111,8 @@ binds = everythingInRenamedSource fun term = case cast term of (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) -> pure (sspan, RtkBind name) + (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _))) -> + pure (sspan, RtkBind name) _ -> empty pat term = case cast term of (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) -> @@ -147,6 +149,8 @@ decls (group, _, _, _) = concatMap ($ group) fun term = case cast term of (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) | GHC.isExternalName name -> pure (sspan, RtkDecl name) + (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _))) + | GHC.isExternalName name -> pure (sspan, RtkDecl name) _ -> empty con term = case cast term of (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) -> @@ -165,6 +169,7 @@ decls (group, _, _, _) = concatMap ($ group) -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field Nothing -> empty sig (GHC.L _ (GHC.TypeSig names _)) = map decl names + sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names sig _ = [] decl (GHC.L sspan name) = (sspan, RtkDecl name) tyref (GHC.L sspan name) = (sspan, RtkType name) @@ -183,10 +188,11 @@ imports src@(_, imps, _, _) = (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t (Just (GHC.IEThingWith t _ vs _fls)) -> [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs + (Just (GHC.IEModuleContents m)) -> pure $ modu m _ -> empty typ (GHC.L sspan name) = (sspan, RtkType name) var (GHC.L sspan name) = (sspan, RtkVar name) - imp idecl | not . GHC.ideclImplicit $ idecl = - let (GHC.L sspan name) = GHC.ideclName idecl - in Just (sspan, RtkModule name) - imp _ = Nothing + modu (GHC.L sspan name) = (sspan, RtkModule name) + imp idecl + | not . GHC.ideclImplicit $ idecl = Just (modu (GHC.ideclName idecl)) + | otherwise = Nothing -- cgit v1.2.3 From 8bf36bde2892ec0ce21a85fea403a5807f9cdd80 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 5 Feb 2018 22:57:22 -0800 Subject: Don't warn about missing '~' (#746) This manually filters out '~' from the list of things to warn about. It truly makes no sense to warn on this since '~' has nothing it could link to - it is magical. This fixes #532. --- haddock-api/src/Haddock/Interface/Rename.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 7023a908..2d3a28cc 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -21,6 +21,8 @@ import Haddock.Types import Bag (emptyBag) import GHC hiding (NoLink) import Name +import RdrName (RdrName(Exact)) +import PrelNames (eqTyCon_RDR) import Control.Applicative import Control.Monad hiding (mapM) @@ -59,11 +61,18 @@ renameInterface dflags renamingEnv warnings iface = (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4 ++ missingNames5) - -- filter out certain built in type constructors using their string - -- representation. TODO: use the Name constants from the GHC API. --- strings = filter (`notElem` ["()", "[]", "(->)"]) --- (map pretty missingNames) - strings = map (pretty dflags) . filter (\n -> not (isSystemName n || isBuiltInSyntax n)) $ missingNames + -- Filter out certain built in type constructors using their string + -- representation. + -- + -- Note that since the renamed AST represents equality constraints as + -- @HasOpTy t1 eqTyCon_RDR t2@ (and _not_ as @HsEqTy t1 t2@), we need to + -- manually filter out 'eqTyCon_RDR' (aka @~@). + strings = [ pretty dflags n + | n <- missingNames + , not (isSystemName n) + , not (isBuiltInSyntax n) + , Exact n /= eqTyCon_RDR + ] in do -- report things that we couldn't link to. Only do this for non-hidden -- cgit v1.2.3 From 1446450a2e9b4bacf32931ee58199bfc3c6ff3ac Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 5 Feb 2018 22:59:09 -0800 Subject: Don't barf on 'HsSpliceTy' (#745) This handles 'HsSpliceTy's by replacing them with what they expand to. IIUC everything that is happening, 'renameHsSpliceTy' should not be able to fail for the inputs we feed it from GHC. This fixes #574. --- haddock-api/src/Haddock/Interface/Rename.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 2d3a28cc..78ab5a08 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -273,10 +273,21 @@ renameType t = case t of HsCoreTy a -> pure (HsCoreTy a) HsExplicitListTy i a b -> HsExplicitListTy i a <$> mapM renameLType b HsExplicitTupleTy a b -> HsExplicitTupleTy a <$> mapM renameLType b - HsSpliceTy _ _ -> error "renameType: HsSpliceTy" + HsSpliceTy s _ -> renameHsSpliceTy s HsWildCardTy a -> HsWildCardTy <$> renameWildCardInfo a HsAppsTy _ -> error "renameType: HsAppsTy" +-- | Rename splices, but _only_ those that turn out to be for types. +-- I think this is actually safe for our possible inputs: +-- +-- * the input is from after GHC's renamer, so should have an 'HsSpliced' +-- * the input is typechecked, and only 'HsSplicedTy' should get through that +-- +renameHsSpliceTy :: HsSplice Name -> RnM (HsType DocName) +renameHsSpliceTy (HsSpliced _ (HsSplicedTy t)) = renameType t +renameHsSpliceTy (HsSpliced _ _) = error "renameHsSpliceTy: not an HsSplicedTy" +renameHsSpliceTy _ = error "renameHsSpliceTy: not an HsSpliced" + renameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI) renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs }) = do { tvs' <- mapM renameLTyVarBndr tvs -- cgit v1.2.3 From ddd4227d02e829f400ef06c934f75eda4a2dfd93 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 6 Feb 2018 08:28:23 +0100 Subject: Rename: renameHsSpliceTy ttg --- haddock-api/src/Haddock/Interface/Rename.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 78ab5a08..df25e6a7 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -283,7 +283,7 @@ renameType t = case t of -- * the input is from after GHC's renamer, so should have an 'HsSpliced' -- * the input is typechecked, and only 'HsSplicedTy' should get through that -- -renameHsSpliceTy :: HsSplice Name -> RnM (HsType DocName) +renameHsSpliceTy :: HsSplice GhcRn -> RnM (HsType DocNameI) renameHsSpliceTy (HsSpliced _ (HsSplicedTy t)) = renameType t renameHsSpliceTy (HsSpliced _ _) = error "renameHsSpliceTy: not an HsSplicedTy" renameHsSpliceTy _ = error "renameHsSpliceTy: not an HsSpliced" -- cgit v1.2.3 From d73af20636a7f7f9f3022ca19fa5a97e871ddabf Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 6 Feb 2018 09:02:14 +0100 Subject: Expand SigDs --- haddock-api/src/Haddock/Interface/Create.hs | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 4309163f..f905f494 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -497,7 +497,8 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls -- | 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 +topDecls = + filterClasses . filterDecls . collectDocs . sortByLoc . expandSigDecls . ungroup -- | Extract a map of fixity declarations only mkFixMap :: HsGroup GhcRn -> FixMap @@ -557,6 +558,29 @@ filterDecls = filter (isHandled . unL . fst) isHandled (DocD _) = True isHandled _ = False +-- | A type signature can have multiple names, like: +-- foo, bar :: Types.. +-- +-- We go through the list of declarations and expand type signatures, so +-- that every type signature has exactly one name! +expandSigDecls :: [LHsDecl name] -> [LHsDecl name] +expandSigDecls = concatMap f + where + f (L l (SigD sig)) = [ L l (SigD s) | s <- expandSig sig ] + + -- also expand type signatures for class methods + f (L l (TyClD cls@ClassDecl{})) = + [ L l (TyClD cls { tcdSigs = concatMap expandLSig (tcdSigs cls) }) ] + f x = [x] + +expandLSig :: LSig name -> [LSig name] +expandLSig (L l sig) = [ L l s | s <- expandSig sig ] + +expandSig :: Sig name -> [Sig name] +expandSig (TypeSig names t) = [ TypeSig [n] t | n <- names ] +expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ] +expandSig (PatSynSig names t) = [ PatSynSig [n] t | n <- names ] +expandSig x = [x] -- | Go through all class declarations and filter their sub-declarations filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)] @@ -1155,7 +1179,7 @@ mkMaybeTokenizedSrc dflags flags tm mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken] mkTokenizedSrc dflags ms src = do - -- make sure to read the whole file at once otherwise + -- make sure to read the whole file at once otherwise -- we run out of file descriptors (see #495) file <- force <$> readFile (filepath) return $ Hyperlinker.enrich src (Hyperlinker.parse dflags filepath file) -- cgit v1.2.3 From ffee7f80736f91f0f18c787f093b4ca1ae315afa Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 6 Feb 2018 09:20:51 +0100 Subject: fullModuleContents: support named docs --- haddock-api/src/Haddock/Interface/Create.hs | 40 +++++++++++++++++------------ 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index f905f494..7f0594e0 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -647,8 +647,9 @@ mkExportItems instIfaceMap dflags = case exportList of Nothing -> - fullModuleContents is_sig modMap thisMod semMod warnings exportedNames - decls maps fixMap splices instIfaceMap dflags allExports + fullModuleContents is_sig modMap thisMod semMod warnings gre + exportedNames decls maps fixMap splices instIfaceMap dflags + allExports Just exports -> liftM concat $ mapM lookupExport exports where lookupExport (IEGroup lev docStr, _) = liftErrMsg $ do @@ -985,6 +986,7 @@ fullModuleContents :: Bool -- is it a signature -> Module -- this module -> Module -- semantic module -> WarningMap + -> GlobalRdrEnv -- ^ The renaming environment -> [Name] -- exported names (orig) -> [LHsDecl GhcRn] -- renamed source declarations -> Maps @@ -994,23 +996,29 @@ fullModuleContents :: Bool -- is it a signature -> DynFlags -> Avails -> ErrMsgGhc [ExportItem GhcRn] -fullModuleContents is_sig modMap thisMod semMod warnings exportedNames +fullModuleContents is_sig modMap 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 - for (getMainDeclBinder (unLoc decl)) $ \nm -> do - case lookupNameEnv availEnv nm of - Just avail - | L _ (ValD valDecl) <- decl - , (name:_) <- collectHsBindBinders valDecl - , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap - -> pure [] - - | otherwise - -> availExportItem is_sig modMap thisMod - semMod warnings exportedNames maps fixMap - splices instIfaceMap dflags avail - Nothing -> pure []) + 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 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 -- cgit v1.2.3 From e870c70cdbe739693c1eacddc42e64106c8ecfdf Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 6 Feb 2018 13:56:17 +0100 Subject: Hyperlinker: Also link pattern synonym arguments --- haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 841dff76..02c4ca0b 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -111,8 +111,11 @@ binds = everythingInRenamedSource fun term = case cast term of (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) -> pure (sspan, RtkBind name) - (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ _ _ _))) -> - pure (sspan, RtkBind name) + (Just (GHC.PatSynBind (GHC.PSB (GHC.L sspan name) _ args _ _))) -> + pure (sspan, RtkBind name) ++ everythingInRenamedSource patsyn_binds args + _ -> empty + patsyn_binds term = case cast term of + (Just (GHC.L sspan (name :: GHC.Name))) -> pure (sspan, RtkVar name) _ -> empty pat term = case cast term of (Just ((GHC.L sspan (GHC.VarPat name)) :: GHC.LPat GHC.GhcRn)) -> -- cgit v1.2.3 From 4b4733a05c7bf35d98ed82f2a62d4771db1fb788 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Fri, 9 Feb 2018 18:44:23 +0100 Subject: Expand SigD in a better place In https://github.com/haskell/haddock/issues/287 we found that haddock-2.19.0 would miss documentation on class methods with multiples names. This patch uses expandSigDecls in a more sensible place. --- haddock-api/src/Haddock/Interface/Create.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 7f0594e0..75e7e9a1 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -391,7 +391,7 @@ mkMaps dflags gre instances decls = do 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 ] + cm = [ (n, expandSigDecls [ldecl]) | n <- ns ++ subNs ] seqList ns `seq` seqList subNs `seq` @@ -498,7 +498,7 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls -- ordered by source location, with documentation attached if it exists. topDecls :: HsGroup GhcRn -> [(LHsDecl GhcRn, [HsDocString])] topDecls = - filterClasses . filterDecls . collectDocs . sortByLoc . expandSigDecls . ungroup + filterClasses . filterDecls . collectDocs . sortByLoc . ungroup -- | Extract a map of fixity declarations only mkFixMap :: HsGroup GhcRn -> FixMap -- cgit v1.2.3 From 0bffd8bd1105331a6fcf0b7e592358c131de9300 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 11 Feb 2018 03:29:56 -0800 Subject: Add module tooltips to linked identifiers (#753) No more clicking to figure out whether your bytestring is strict or lazy! --- haddock-api/src/Haddock/Backends/Xhtml/Names.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index a84a55e8..574045e0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs @@ -22,7 +22,7 @@ import Haddock.GhcUtils import Haddock.Types import Haddock.Utils -import Text.XHtml hiding ( name, title, p, quote ) +import Text.XHtml hiding ( name, p, quote ) import qualified Data.Map as M import qualified Data.List as List @@ -147,17 +147,19 @@ linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True linkIdOcc :: Module -> Maybe OccName -> Bool -> Html -> Html linkIdOcc mdl mbName insertAnchors = if insertAnchors - then anchor ! [href url] + then anchor ! [href url, title ttl] else id where + ttl = moduleNameString (moduleName mdl) url = case mbName of Nothing -> moduleUrl mdl Just name -> moduleNameUrl mdl name linkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html -linkIdOcc' mdl mbName = anchor ! [href url] +linkIdOcc' mdl mbName = anchor ! [href url, title ttl] where + ttl = moduleNameString mdl url = case mbName of Nothing -> moduleHtmlFile' mdl Just name -> moduleNameUrl' mdl name -- cgit v1.2.3 From 5141e4b76af8462e49abdf48e44bb9cddb183383 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 11 Feb 2018 03:31:44 -0800 Subject: Add 'show' option to complement 'hide' (#752) * Add 'show' option to complement 'hide' The behaviour is for flags passed in the command line to override flags in file headers. In the command line, later flags override earlier ones. Fixes #751 and #266. * Add a '--show-all' option --- haddock-api/src/Haddock/Interface/Create.hs | 21 +++++++++++---------- haddock-api/src/Haddock/Options.hs | 6 ++++++ 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 75e7e9a1..f218853b 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -312,16 +312,17 @@ mkDocOpts mbOpts flags mdl = do [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return [] xs -> liftM catMaybes (mapM parseOption xs) Nothing -> return [] - hm <- if Flag_HideModule (moduleString mdl) `elem` flags - then return $ OptHide : opts - else return opts - ie <- if Flag_IgnoreAllExports `elem` flags - then return $ OptIgnoreExports : hm - else return hm - se <- if Flag_ShowExtensions (moduleString mdl) `elem` flags - then return $ OptShowExtensions : ie - else return ie - return se + pure (foldl go opts flags) + where + mdlStr = moduleString mdl + + -- Later flags override earlier ones + 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 + | otherwise = os parseOption :: String -> ErrMsgM (Maybe DocOption) parseOption "hide" = return (Just OptHide) diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index caf1fefe..0609aa63 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -86,6 +86,8 @@ data Flag | Flag_GenIndex | Flag_IgnoreAllExports | Flag_HideModule String + | Flag_ShowModule String + | Flag_ShowAllModules | Flag_ShowExtensions String | Flag_OptGhc String | Flag_GhcLibDir String @@ -182,6 +184,10 @@ options backwardsCompat = "behave as if all modules have the\nignore-exports atribute", Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") "behave as if MODULE has the hide attribute", + Option [] ["show"] (ReqArg Flag_ShowModule "MODULE") + "behave as if MODULE does not have the hide attribute", + Option [] ["show-all"] (NoArg Flag_ShowAllModules) + "behave as if not modules have the hide attribute", Option [] ["show-extensions"] (ReqArg Flag_ShowExtensions "MODULE") "behave as if MODULE has the show-extensions attribute", Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION") -- cgit v1.2.3 From 6d62c5b79d0f3ce975c087b5176ee53d62122d86 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Mon, 19 Feb 2018 05:56:54 +0100 Subject: Teach the HTML backend how to render methods with multiple names --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 12 ++++++------ haddock-api/src/Haddock/Interface/Create.hs | 26 +------------------------- 2 files changed, 7 insertions(+), 31 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 3b85f96c..6e733373 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -516,14 +516,14 @@ ppClassDecl summary links instances fixities loc d subdocs doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs subfixs = [ f | f@(n',_) <- fixities, n == n' ] ] - methodBit = subMethods [ ppFunSig summary links loc doc names (hsSigType typ) + methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ) subfixs splice unicode qual | L _ (ClassOpSig _ lnames typ) <- lsigs - , let doc = lookupAnySubdoc (head names) subdocs - subfixs = [ f | n <- names - , f@(n',_) <- fixities - , n == n' ] - names = map unLoc lnames ] + , 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. diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index f218853b..a885b298 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -392,7 +392,7 @@ mkMaps dflags gre instances decls = do 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, expandSigDecls [ldecl]) | n <- ns ++ subNs ] + cm = [ (n, [ldecl]) | n <- ns ++ subNs ] seqList ns `seq` seqList subNs `seq` @@ -559,30 +559,6 @@ filterDecls = filter (isHandled . unL . fst) isHandled (DocD _) = True isHandled _ = False --- | A type signature can have multiple names, like: --- foo, bar :: Types.. --- --- We go through the list of declarations and expand type signatures, so --- that every type signature has exactly one name! -expandSigDecls :: [LHsDecl name] -> [LHsDecl name] -expandSigDecls = concatMap f - where - f (L l (SigD sig)) = [ L l (SigD s) | s <- expandSig sig ] - - -- also expand type signatures for class methods - f (L l (TyClD cls@ClassDecl{})) = - [ L l (TyClD cls { tcdSigs = concatMap expandLSig (tcdSigs cls) }) ] - f x = [x] - -expandLSig :: LSig name -> [LSig name] -expandLSig (L l sig) = [ L l s | s <- expandSig sig ] - -expandSig :: Sig name -> [Sig name] -expandSig (TypeSig names t) = [ TypeSig [n] t | n <- names ] -expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ] -expandSig (PatSynSig names t) = [ PatSynSig [n] t | n <- names ] -expandSig x = [x] - -- | 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 -- cgit v1.2.3 From d66092ee99639de628dbc4fce8a9936875f47d8c Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Mon, 19 Feb 2018 10:03:50 +0100 Subject: Hoogle/Latex: Remove use of partial function --- haddock-api/src/Haddock/Backends/Hoogle.hs | 2 +- haddock-api/src/Haddock/Backends/LaTeX.hs | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index fc71d4b5..e002b602 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -141,7 +141,7 @@ ppSigWithDoc dflags (TypeSig names sig) subdocs = concatMap mkDocSig names where mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n) - ++ [pp_sig dflags names (hsSigWcType sig)] + ++ [pp_sig dflags [n] (hsSigWcType sig)] getDoc :: Located Name -> [Documentation Name] getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 3ac3b405..1043453d 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -508,13 +508,11 @@ ppClassDecl instances loc doc subdocs methodTable = text "\\haddockpremethods{}\\textbf{Methods}" $$ - vcat [ ppFunSig loc doc names (hsSigWcType typ) unicode + vcat [ ppFunSig loc doc [name] (hsSigWcType typ) unicode | L _ (TypeSig 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? + , name <- map unLoc lnames + , let doc = lookupAnySubdoc name subdocs + ] instancesBit = ppDocInstances unicode instances -- cgit v1.2.3 From 7a36a41e154f9ff380b10584ec1a9f8bc4003be1 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 25 Feb 2018 07:04:01 -0800 Subject: Fix file handle leak (#763) (#764) Brought back some mistakenly deleted code for handling encoding and eager reading of files from e0ada1743cb722d2f82498a95b201f3ffb303137. --- haddock-api/src/Haddock/Interface/Create.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a885b298..cac1e8b0 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -20,6 +20,7 @@ module Haddock.Interface.Create (createInterface) where import Documentation.Haddock.Doc (metaDocAppend) +import Documentation.Haddock.Utf8 as Utf8 import Haddock.Types import Haddock.Options import Haddock.GhcUtils @@ -32,14 +33,15 @@ import Haddock.Backends.Hyperlinker.Parser as Hyperlinker import Data.Bifunctor import Data.Bitraversable +import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) import Data.List import Data.Maybe import Data.Ord import Control.Applicative +import Control.Exception (evaluate) import Control.Monad -import Control.DeepSeq import Data.Traversable import Avail hiding (avail) @@ -1166,8 +1168,9 @@ mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken] mkTokenizedSrc dflags ms src = do -- make sure to read the whole file at once otherwise -- we run out of file descriptors (see #495) - file <- force <$> readFile (filepath) - return $ Hyperlinker.enrich src (Hyperlinker.parse dflags filepath file) + rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate + let tokens = Hyperlinker.parse dflags filepath (Utf8.decodeUtf8 rawSrc) + return $ Hyperlinker.enrich src tokens where filepath = msHsFilePath ms -- cgit v1.2.3 From 4abf7d4979b5364da59f7412a3d7143aea26cf7e Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Fri, 2 Mar 2018 14:21:23 +0100 Subject: Enable running test suite with stock haddock and ghc using ``` $ cabal new-run -- html-test --haddock-path=$(which haddock) --ghc-path=$(which ghc) ``` --- haddock-test/src/Test/Haddock/Config.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index 988636e4..2d16fa63 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -98,6 +98,7 @@ data Flag = FlagHaddockPath FilePath | FlagHaddockOptions String | FlagHaddockStdOut FilePath + | FlagGhcPath FilePath | FlagDiffTool FilePath | FlagNoDiff | FlagAccept @@ -108,6 +109,8 @@ data Flag flagsHaddockPath :: [Flag] -> Maybe FilePath flagsHaddockPath flags = mlast [ path | FlagHaddockPath path <- flags ] +flagsGhcPath :: [Flag] -> Maybe FilePath +flagsGhcPath flags = mlast [ path | FlagGhcPath path <- flags ] flagsHaddockOptions :: [Flag] -> [String] flagsHaddockOptions flags = concat @@ -130,6 +133,8 @@ options = "additional options to run Haddock with" , Option [] ["haddock-stdout"] (ReqArg FlagHaddockStdOut "FILE") "where to redirect Haddock output" + , Option [] ["ghc-path"] (ReqArg FlagGhcPath "FILE") + "path ghc executable" , Option [] ["diff-tool"] (ReqArg FlagDiffTool "PATH") "diff tool to use when printing failed cases" , Option ['a'] ["accept"] (NoArg FlagAccept) @@ -178,8 +183,11 @@ loadConfig ccfg dcfg flags files = do hPutStrLn stderr "Haddock executable not found" exitFailure - ghcPath <- init <$> rawSystemStdout normal cfgHaddockPath - ["--print-ghc-path"] + ghcPath <- case flagsGhcPath flags of + Just fp -> return fp + Nothing -> init <$> rawSystemStdout normal + cfgHaddockPath + ["--print-ghc-path"] printVersions cfgEnv cfgHaddockPath -- cgit v1.2.3 From 69b98a99ce4de93ea0e6082bd11edb3baaf2fa6e Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Fri, 2 Mar 2018 15:43:21 +0100 Subject: Make testsuite work with haddock-1.19.0 release (#766) --- html-test/Main.hs | 15 + html-test/ref/A.html | 12 +- html-test/ref/Bug1.html | 2 +- html-test/ref/Bug2.html | 2 +- html-test/ref/Bug253.html | 2 +- html-test/ref/Bug26.html | 4 +- html-test/ref/Bug280.html | 2 +- html-test/ref/Bug294.html | 154 +++++- html-test/ref/Bug298.html | 8 +- html-test/ref/Bug3.html | 4 +- html-test/ref/Bug310.html | 16 +- html-test/ref/Bug387.html | 8 +- html-test/ref/Bug4.html | 4 +- html-test/ref/Bug546.html | 12 +- html-test/ref/Bug548.html | 244 +++++----- html-test/ref/Bug6.html | 78 ++-- html-test/ref/Bug613.html | 26 +- html-test/ref/Bug647.html | 2 +- html-test/ref/Bug679.html | 18 +- html-test/ref/Bug7.html | 12 +- html-test/ref/Bug8.html | 16 +- html-test/ref/Bug85.html | 16 +- html-test/ref/BugDeprecated.html | 24 +- html-test/ref/BugExportHeadings.html | 24 +- html-test/ref/Bugs.html | 2 +- html-test/ref/BundledPatterns.html | 64 +-- html-test/ref/BundledPatterns2.html | 98 ++-- html-test/ref/ConstructorPatternExport.html | 18 +- html-test/ref/DeprecatedClass.html | 4 +- html-test/ref/DeprecatedFunction.html | 10 +- html-test/ref/DeprecatedFunction2.html | 4 +- html-test/ref/DeprecatedFunction3.html | 4 +- html-test/ref/DeprecatedModule.html | 2 +- html-test/ref/DeprecatedModule2.html | 2 +- html-test/ref/DeprecatedNewtype.html | 8 +- html-test/ref/DeprecatedReExport.html | 6 +- html-test/ref/DeprecatedRecord.html | 8 +- html-test/ref/DeprecatedTypeFamily.html | 16 +- html-test/ref/DeprecatedTypeSynonym.html | 8 +- html-test/ref/Examples.html | 10 +- html-test/ref/FunArgs.html | 8 +- html-test/ref/GADTRecords.html | 34 +- html-test/ref/Hash.html | 80 ++-- html-test/ref/HiddenInstances.html | 50 +- html-test/ref/HiddenInstancesB.html | 8 +- html-test/ref/Hyperlinks.html | 4 +- html-test/ref/ImplicitParams.html | 14 +- html-test/ref/Instances.html | 566 +++++++++++------------ html-test/ref/Math.html | 4 +- html-test/ref/Minimal.html | 24 +- html-test/ref/ModuleWithWarning.html | 2 +- html-test/ref/NoLayout.html | 6 +- html-test/ref/Operators.html | 40 +- html-test/ref/OrphanInstances.html | 18 +- html-test/ref/OrphanInstancesClass.html | 52 ++- html-test/ref/OrphanInstancesType.html | 50 +- html-test/ref/PatternSyns.html | 72 +-- html-test/ref/PromotedTypes.html | 40 +- html-test/ref/Properties.html | 10 +- html-test/ref/QuasiExpr.html | 54 +-- html-test/ref/QuasiQuote.html | 2 +- html-test/ref/SpuriousSuperclassConstraints.html | 48 +- html-test/ref/Table.html | 2 +- html-test/ref/Test.html | 424 ++++++++++------- html-test/ref/Threaded.html | 4 +- html-test/ref/Ticket112.html | 2 +- html-test/ref/Ticket61.html | 2 +- html-test/ref/Ticket75.html | 6 +- html-test/ref/TitledPicture.html | 12 +- html-test/ref/TypeFamilies.html | 544 +++++++++------------- html-test/ref/TypeFamilies2.html | 50 +- html-test/ref/TypeOperators.html | 14 +- html-test/ref/Unicode.html | 4 +- html-test/ref/Visible.html | 4 +- 74 files changed, 1687 insertions(+), 1536 deletions(-) diff --git a/html-test/Main.hs b/html-test/Main.hs index 67dbeec6..d65a5087 100755 --- a/html-test/Main.hs +++ b/html-test/Main.hs @@ -47,7 +47,22 @@ stripIfRequired mdl = preserveLinksModules :: [String] preserveLinksModules = ["Bug253"] +ingoredTests :: [FilePath] +ingoredTests = + [ + -- Currently some declarations are exported twice + -- 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 +checkIgnore file | takeBaseName file `elem` ingoredTests = True checkIgnore file@(c:_) | takeExtension file == ".html" && isUpper c = False checkIgnore _ = True diff --git a/html-test/ref/A.html b/html-test/ref/A.html index 1fbfb371..e4802966 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -54,13 +54,13 @@ >
  • other :: :: Int
  • test2 :: :: Bool
  • reExport :: :: Int

    • other :: :: Int #

    test2 :: :: Bool #

    reExport :: :: Int #

    We should have different anchors for constructors and types/classes. This hyperlink should point to the type constructor by default: T.

    x :: :: A #This link should generate #v anchor: fakeFakeFake

    Minimal complete definition

    c_f

    C ()

    x :: [ :: [Char] # data DP A

    data DP A = ProblemCtor' A
    data TP TP A
    data TP TP A = ProblemCtor A

    problemField :: TO :: TO A -> -> A #

    problemField' :: DO :: DO A -> -> A #

    gadtField :: ({..} -> GADT :: ({..} -> GADT A) -> ) -> A #

    data family TP t :: * #

    Instances
    data TP A #
    Instance details
    data TP A = ProblemCtor A

    data family DP t :: t :: * # data DP A

    data DP A = ProblemCtor' A

    data family TO' t :: * #

    Instances
    data TO' a #
    Instance details
    data TO' a = PolyCtor
  • test1 :: :: Int
  • test2 :: :: Int

    • test1 :: :: Int #

    test2 :: :: Int #

  • foo :: :: Int

    • foo :: :: Int #

  • x :: :: Integer
  • compile :: :: String -> -> String

    • x :: :: Integer #

    compile :: :: String -> -> String #newtype WrappedArrow (a :: (a :: * -> -> * -> -> *) b c # Generic1 * ( (WrappedArrow a b) a b :: * -> *)

    type Rep1 (WrappedArrow a b) (f :: (WrappedArrow a b -> *) :: k -> a b) :: k -> * #

    from1 :: f a0 -> :: WrappedArrow a b a0 -> Rep1 ( (WrappedArrow a b) f a0 a b) a0 #

    to1 :: :: Rep1 ( (WrappedArrow a b) a0 -> WrappedArrow a b) f a0 -> f a0 a b a0 #

    Arrow a => a => Functor ( (WrappedArrow a b)

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

    (<$) :: a0 -> :: a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b a0 # Arrow a => a => Applicative ( (WrappedArrow a b)

    pure :: a0 -> :: a0 -> WrappedArrow a b a0 #

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

    liftA2 :: (a0 -> b0 -> c) -> :: (a0 -> b0 -> c) -> WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b c #

    (*>) :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b b0 #

    (<*) :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b a0 # ( (ArrowZero a, a, ArrowPlus a) => a) => Alternative ( (WrappedArrow a b)

    empty :: :: WrappedArrow a b a0 #

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

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

    many :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b [a0] # Generic ( (WrappedArrow a b c)

    type Rep ( (WrappedArrow a b c) :: a b c) :: * -> -> * #

    from :: :: WrappedArrow a b c -> a b c -> Rep ( (WrappedArrow a b c) x #

    to :: :: Rep ( (WrappedArrow a b c) x -> a b c) x -> WrappedArrow a b c # type Rep1 * ( (WrappedArrow a b) a b :: * -> *)

    type Rep1 * ( (WrappedArrow a b) = D1 a b :: * ( -> *) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" "WrappedArrow" "Control.Applicative" "base" True) () (C1 * ( (MetaCons "WrapArrow" "WrapArrow" PrefixI True) () (S1 * ( (MetaSel ( (Just Symbol "unwrapArrow") "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) () (Rec1 * (a b))))
    type Rep ( (WrappedArrow a b c)
    type Rep ( (WrappedArrow a b c) = a b c) = D1 * ( (MetaData "WrappedArrow" "Control.Applicative" "base" "WrappedArrow" "Control.Applicative" "base" True) () (C1 * ( (MetaCons "WrapArrow" "WrapArrow" PrefixI True) () (S1 * ( (MetaSel ( (Just Symbol "unwrapArrow") "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) () (Rec0 * (a b c))))
    A = A Int
  • B = B {}
    • Int
  • b :: B -> Int
  • data
  • c1 :: :: Int
  • c2 :: :: Int
    • D = D Int Int
  • E = E Int
    • A IntB Int

    Fields

    b :: B -> Int #

    datac1 :: :: Int

    c2 :: :: Int
    D Int IntE Int

    Minimal complete definition

    fmap

    Functor ( (Either a)

    fmap :: (a0 -> b) -> :: (a0 -> b) -> Either a a0 -> a a0 -> Either a b # Functor ( (ThreeVars a0 a)

    fmap :: (a1 -> b) -> :: (a1 -> b) -> ThreeVars a0 a a1 -> a0 a a1 -> ThreeVars a0 a b # Functor ( (ThreeVars a0 a)

    fmap :: (a1 -> b) -> :: (a1 -> b) -> ThreeVars a0 a a1 -> a0 a a1 -> ThreeVars a0 a b #

    Minimal complete definition

    f

    Foo ( (Bar a)

    foo :: :: Bar a -> a -> Bar a #

    Minimal complete definition

    foo

    Foo ( (Bar a)

    foo :: :: Bar a -> a -> Bar a # Bar Foo Foo Bar Foo Foo Type ( (Typ, [, [Typ])TFree ( (Typ, [, [Typ])

    (-->) :: p1 -> p2 -> :: p1 -> p2 -> Typ infix 9

    (--->) :: :: Foldable t0 => t0 t -> t0 => t0 t -> Typ -> -> Typ infix 9data Foo :: ( :: (* -> -> *) -> ) -> * -> -> * whereBar :: f x -> :: f x -> Foo f (f x)data Baz :: :: * whereBaz' :: :: BazQuux :: :: Qux

  • foo :: :: Int
  • bar :: :: Int
  • baz :: :: Int
  • one :: :: Int
  • two :: :: Int
  • three :: :: Int

    • foo :: :: Int #

    bar :: :: Int #

    baz :: :: Int #

    one :: :: Int #

    two :: :: Int #

    three :: :: Int #

  • foo :: :: Int
  • bar :: :: Int
  • baz :: :: Int
  • one :: :: Int
  • two :: :: Int
  • three :: :: Int

    • foo :: :: Int #

    bar :: :: Int #

    baz :: :: Int #

    one :: :: Int #

    two :: :: Int #

    three :: :: Int #A a (a -> a (a -> Int)data Vec :: :: Nat -> -> * -> -> * where

  • Nil :: :: Vec 0 a
  • pattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a
    • data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 a
  • pattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) a
    • data Vec :: :: Nat -> -> * -> -> * whereLists with their length encoded in their type
  • Vector elements have an subscript starting from 0 and ending at length - 1Nil :: :: Vec 0 apattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a infixr 5data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 apattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) adata Vec :: :: Nat -> -> * -> -> * wherepattern Empty :: (:>) :: a -> Vec 0 a
    • n a -> Vec (n + 1) a
  • pattern (:>) :: a -> Vec n a -> Empty :: Vec (n + 1) a
    • 0 a
  • data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 a
  • pattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) a
    • data Vec :: :: Nat -> -> * -> -> * whereLists with their length encoded in their type
  • Vector elements have an subscript starting from 0 and ending at length - 1Bundled Patterns

    pattern Empty :: Vec 0 a
    pattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a infixr 5
    pattern Empty :: Vec 0 a
    data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 apattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) apattern FooCons :: :: String -> a -> Foo a #pattern MyRecCons :: :: Bool -> -> Int -> MyRec #pattern (:+) :: :: String -> a -> MyInfix a #pattern BlubCons :: () => :: () => Show b => b -> Blub #MyGADTCons :: () => forall a. a. Eq a => a -> a => a -> Int -> MyGADT ( -> MyGADT (Maybe String) #

    Minimal complete definition

    foo

    Minimal complete definition

    bar

  • foo :: :: Int
  • bar :: :: Int

    • foo :: :: Int #

    Deprecated: use bar instead

    bar :: :: Int #

  • foo :: :: Int

    • foo :: :: Int #

  • foo :: :: Integer

    • foo :: :: Integer #

    foo :: :: Int #

    foo :: :: Int #SomeNewType = SomeNewTypeConst String

  • SomeOtherNewType = SomeOtherNewTypeConst String
    • SomeNewTypeConst StringSomeOtherNewTypeConst String
  • foo :: :: Int

    • foo :: :: Int #

    Deprecated: use bar instead

  • fooName :: :: String
  • fooValue :: :: Int
    • fooName :: :: String
    fooValue :: :: Int
    data family SomeTypeFamily k :: k :: * -> -> *
  • data family SomeOtherTypeFamily k :: k :: * -> -> *
    • data family SomeTypeFamily k :: k :: * -> -> * #data family SomeOtherTypeFamily k :: k :: * -> -> * #type TypeSyn = = String
  • type OtherTypeSyn = = String
    • type TypeSyn = = String #type OtherTypeSyn = = String #
  • fib :: :: Integer -> -> Integer

    • fib :: :: Integer -> -> Integer #

    Fibonacci number of given Integer.

    foo :: (LiftedRep -> LiftedRep) a :: (a -> Int -> a0 -> (LiftedRep -> LiftedRep) a a0 ) -> a0 -> a -> a0 #

    foo' :: (LiftedRep -> LiftedRep) a ((LiftedRep -> LiftedRep) a a0) -> :: (a -> a -> a0) -> Int -> (LiftedRep -> LiftedRep) a ((LiftedRep -> LiftedRep) a -> a -> a -> Int) #

    class Foo f => Bar

    bar :: f a -> f :: f a -> f Bool -> a # Bar Maybe Bool

    bar :: :: Maybe Bool -> -> Maybe Bool -> -> Bool #

    bar' :: :: Maybe ( (Maybe Bool) -> ) -> Maybe ( (Maybe ( (Maybe b)) #

    bar0 :: ( :: (Maybe Bool, , Maybe Bool) -> () -> (Maybe b, b, Maybe c) #

    bar1 :: ( :: (Maybe Bool, , Maybe Bool) -> () -> (Maybe b, b, Maybe c) # Bar Maybe [a]

    bar :: :: Maybe [a] -> [a] -> Maybe Bool -> [a] #

    bar' :: :: Maybe ( (Maybe [a]) -> [a]) -> Maybe ( (Maybe ( (Maybe b)) #

    bar0 :: ( :: (Maybe [a], [a], Maybe [a]) -> ( [a]) -> (Maybe b, b, Maybe c) #

    bar1 :: ( :: (Maybe [a], [a], Maybe [a]) -> ( [a]) -> (Maybe b, b, Maybe c) # Bar [] (a, a)

    bar :: [(a, a)] -> [ :: [(a, a)] -> [Bool] -> (a, a) # Foo f => f => Bar ( (Either a) (f a)

    bar :: :: Either a (f a) -> a (f a) -> Either a a Bool -> f a #

    bar' :: :: Either a ( a (Either a (f a)) -> a (f a)) -> Either a ( a (Either a ( a (Either a b)) #

    bar0 :: ( :: (Either a (f a), a (f a), Either a (f a)) -> ( a (f a)) -> (Either a b, a b, Either a c) #

    bar1 :: ( :: (Either a (f a), a (f a), Either a (f a)) -> ( a (f a)) -> (Either a b, a b, Either a c) # Foo ( ((,,) a b) => a b) => Bar ( ((,,) a b) (a, b, a)

    bar :: (a, b, (a, b, a)) -> (a, b, :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a) # Bar ( (Quux a c) ( a c) (Quux a b c)

    bar :: :: Quux a c ( a c (Quux a b c) -> a b c) -> Quux a c a c Bool -> -> Quux a b c #

    bar' :: :: Quux a c ( a c (Quux a c ( a c (Quux a b c)) -> a b c)) -> Quux a c ( a c (Quux a c ( a c (Quux a c b0)) #

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

    bar1 :: ( :: (Quux a c ( a c (Quux a b c), a b c), Quux a c ( a c (Quux a b c)) -> ( a b c)) -> (Quux a c b0, a c b0, Quux a c c0) # Baz [c] Baz (a -> b) Baz (a, b, c) Baz ( (Quux a b c)

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

    foo :: :: Quux a b a b Int -> a0 -> -> a0 -> Quux a b a0 #

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

    bar :: :: Quux a c ( a c (Quux a b c) -> a b c) -> Quux a c a c Bool -> -> Quux a b c #

    bar' :: :: Quux a c ( a c (Quux a c ( a c (Quux a b c)) -> a b c)) -> Quux a c ( a c (Quux a c ( a c (Quux a c b0)) #

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

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

    baz :: :: Quux a b c -> (forall a0. a0 -> a0) -> (b0, forall c0. c0 -> c0. c0 -> Quux a b c) -> (b0, c1) #baz' :: b0 -> (forall b1. b1 -> b1. b1 -> Quux a b c) -> (forall b2. b2 -> b2. b2 -> Quux a b c) -> [(b0, a b c) -> [(b0, Quux a b c)] #forall b1. (forall b2. b2 -> b2. b2 -> Quux a b c) -> c0) -> forall data Thud Int ( (Quux a [a] c)

    data Thud Int ( (Quux a [a] c)

    norf :: :: Plugh a c b -> a -> (a -> c) -> b # Norf Int Bool

    type Plugh Int c c Bool :: :: * #

    data Thud Int c :: c :: * #

    norf :: :: Plugh Int c c Bool -> -> Int -> ( -> (Int -> c) -> -> c) -> Bool # Norf [a] [b]

    type Plugh [a] c [b] :: [a] c [b] :: * #

    data Thud [a] c :: [a] c :: * #

    norf :: :: Plugh [a] c [b] -> [a] -> ([a] -> c) -> [b] #

  • f :: :: Integer

    • f :: :: Integer #

    Minimal complete definition

    foo, , bar | | bar, , bat | | foo, , bat | | fooBarBat

    Minimal complete definition

    x, , y

    Minimal complete definition

    aaa, , bbb

    Minimal complete definition

    ccc, ddd

    foo :: :: Int #

  • g :: :: Int

    • g :: :: Int #

    the function g

    Foo
  • (:<->) :: a -> b -> a :: a -> b -> a <-> b
    • type a <>< b :: b :: *
  • type (>-<) a b = a a b = a <-> b
    • :: :: Ord a
    => => Int
    -> -> Bool:: forall (b :: ()). d ~ (b :: ()). d ~ ()
  • C1 :: :: H1 a b
  • C2 :: :: Ord a => [a] -> a => [a] -> H1 a a
  • C3 :: {..} -> :: {..} -> H1 Int Int
  • C4 :: {..} -> :: {..} -> H1 Int a
    		• C1 :: :: H1 a bC2 :: :: Ord a => [a] -> a => [a] -> H1 a aC3 :: {..} -> :: {..} -> H1 Int Intfield :: :: Int
    		C4 :: {..} -> :: {..} -> H1 Int a
  • new :: ( :: (Eq key, key, Hash key) => key) => Int -> -> IO ( (HashTable key val)
  • insert :: ( :: (Eq key, key, Hash key) => key -> val -> key) => key -> val -> IO ()
  • lookup :: :: Hash key => key -> key => key -> IO ( (Maybe val)
  • key should be an instance of Eq.

    new :: ( :: (Eq key, key, Hash key) => key) => Int -> -> IO ( (HashTable key val) #

    insert :: ( :: (Eq key, key, Hash key) => key -> val -> key) => key -> val -> IO () #

    lookup :: :: Hash key => key -> key => key -> IO ( (Maybe val) #

    Looks up a key in the hash table, returns Just val if the key was found, or Nothing otherwise.

    Minimal complete definition

    hash

    hash :: a -> :: a -> Int #hashes the value of type a into an Int

    Hash Float

    hash :: :: Float -> -> Int # Hash Int

    hash :: :: Int -> -> Int # ( (Hash a, a, Hash b) => b) => Hash (a, b)

    hash :: (a, b) -> :: (a, b) -> Int # VisibleClass Int VisibleClass VisibleData Num VisibleData

    (+) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    (-) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    (*) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    negate :: :: VisibleData -> -> VisibleData #

    abs :: :: VisibleData -> -> VisibleData #

    signum :: :: VisibleData -> -> VisibleData #

    fromInteger :: :: Integer -> -> VisibleData # VisibleClass VisibleData Foo Bar Foo Bar

  • foo :: :: Int

    • foo :: :: Int #

    c :: (?x :: :: (?x :: X) => ) => X #

    d :: (?x :: :: (?x :: X, ?y :: , ?y :: X) => () => (X, , X) #

    f :: ((?x :: :: ((?x :: X) => a) -> a # Foo ( ((<~~) a)

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

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

    foo :: f :: f Int -> a -> f a #

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

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

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

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

    foo' :: :: Maybe ( (Maybe a) -> a) -> Int -> -> Maybe ( (Maybe Int) # Foo ( (Either a)

    foo :: :: Either a a Int -> a0 -> -> a0 -> Either a a0 #

    foo' :: :: Either a ( a (Either a a0) -> a a0) -> Int -> -> Either a ( a (Either a a Int) # ( (Eq a, a, Foo f) => f) => Foo ( ((,) (f a))

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

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

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

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

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

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

    foo :: :: Quux a b a b Int -> a0 -> -> a0 -> Quux a b a0 #

    foo' :: :: Quux a b ( a b (Quux a b a0) -> a b a0) -> Int -> -> Quux a b ( a b (Quux a b a b Int) # Foo ((->) LiftedRep LiftedRep a) ((->) a :: * -> *) #

    Foo `Bar` Foo infixl 3
    Foo :- Foo infixr 5(:<->) :: a -> b -> a :: a -> b -> a <-> b infixr 6

    Minimal complete definition

    (>><), , (<<>), , (**>), , (**<), , (>**), , (<**)

    type a <>< b :: b :: * infixl 2type (>-<) a b = a a b = a <-> b infixl 6
    Synopsis

      Documentation

      Orphan instances

      AClass AType

      aClass :: :: AType -> -> Int #

      Minimal complete definition

      aClass

      aClass :: a -> :: a -> Int #

      Instances
      AClass AType #

      This is an orphan instance.

      Instance details

      Methods

      aClass :: AType -> Int #

      		AType Int
      Instances
      AClass AType #

      This is an orphan instance.

      Instance details

      Methods

      aClass :: AType -> Int #

      Foo :: forall x. x -> x. x -> FooType x
    • Bar :: forall x. x -> x. x -> FooType ( (FooType x)
    • (:<->) :: forall x x1. x -> x1 -> ( x x1. x -> x1 -> (FooType x, x, FooType ( (FooType x1))
    • data BlubType = = Show x => BlubCtorBlub :: () => forall x. x. Show x => x -> x => x -> BlubType
    • data (a :: (a :: *) ><E :: forall k a (b :: k). (><) k a b
      • k a (b :: k). a >< b
    • pattern PatWithExplicitSig :: :: Eq somex => somex -> somex => somex -> FooType somex
      • Foo :: forall x. x -> x. x -> FooType x #

      Pattern synonym for Foo x

      Bar :: forall x. x -> x. x -> FooType ( (FooType x) #

      Pattern synonym for Bar x

      (:<->) :: forall x x1. x -> x1 -> ( x x1. x -> x1 -> (FooType x, x, FooType ( (FooType x1)) #

      Pattern synonym for (:<->)

      This module illustrates & tests most of the features of Haddock. Testing references from the description: T, f, g, visible.

    • = A Int ( (Maybe Float)
    • | B ( (T a b, a b, T Int Float)
    • p :: :: Int
    • r, s :: :: Int
    • t :: T1 -> :: T1 -> T2 Int Int -> -> T3 Bool Bool -> -> T4 Float Float -> -> T5 () ()
    • u, v :: :: Int
    • s1 :: :: Int
    • s2 :: :: Int
    • s3 :: :: Int
      • }
    • p :: R -> Int
    • q :: R -> forall a. a -> a
    • u :: R -> Int
    • class D a => C
    • a :: :: C a => a => IO a
    • f :: :: C a => a -> a => a -> Int
    • g :: :: Int -> -> IO CInt
    • hidden :: :: Int -> -> Int
    • Ex a
      • Show x => BlubCtorBlub :: () => forall x. x. Show x => x -> x => x -> BlubType #

      Pattern synonym for Blub x

      data (a :: (a :: *) ><

      Doc for (><)

      E :: forall k a (b :: k). (><) k a b k a (b :: k). a >< b #

      Pattern for Empty

      pattern PatWithExplicitSig :: :: Eq somex => somex -> somex => somex -> FooType somex #
      ((RevList a) :>data Pattern :: [ :: [*] -> ] -> * whereNil :: :: Pattern '[]Cons :: :: Maybe h -> h -> Pattern t -> t -> Pattern (h ': t)data RevPattern :: :: RevList * -> -> * whereRevNil :: :: RevPattern RNilRevCons :: :: Maybe h -> h -> RevPattern t -> t -> RevPattern (t (t :> h)data Tuple :: ( :: (*, , *) -> ) -> * whereTuple :: a -> b -> :: a -> b -> Tuple '(a, b)
    • fib :: :: Integer -> -> Integer

      • fib :: :: Integer -> -> Integer #

      Fibonacci number of given Integer.

      		IntExpr IntegerAntiIntExpr StringBinopExpr BinOp Expr ExprAntiExpr String Show Expr

      showsPrec :: :: Int -> -> Expr -> -> ShowS #

      show :: :: Expr -> -> String #

      showList :: [ :: [Expr] -> ] -> ShowS # Show BinOp

      showsPrec :: :: Int -> -> BinOp -> -> ShowS #

      show :: :: BinOp -> -> String #

      showList :: [ :: [BinOp] -> ] -> ShowS #

      eval :: :: Expr -> -> Integer #

      parseExprExp :: :: String -> Q Exp #

      val :: :: Integer #data SomeType (f :: (f :: * -> -> *) a # Functor ( (SomeType f)

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

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

      pure :: a -> :: a -> SomeType f a #

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

      liftA2 :: (a -> b -> c) -> :: (a -> b -> c) -> SomeType f a -> f a -> SomeType f b -> f b -> SomeType f c #

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

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

      tableWithHeader A Int ( (Maybe Float)

      This comment describes the A constructor

      		B ( (T a b, a b, T Int Float)

      This comment describes the B constructor

      documents A3

      documents B3

      This is the doc for A4

      This is the doc for B4

      This is the doc for C4

      this is the n3 field

      The N7 constructor

      This is the documentation for the R record, which has four fields, p, q, r, and s.

      This is the C1 record constructor, with the following fields:

      p :: :: Int

      This comment applies to the p field

      This comment applies to the q field

      r, s :: :: Int

      This comment applies to both r and s

      This is the C2 record constructor, also with some fields:

      t :: T1 -> :: T1 -> T2 Int Int -> -> T3 Bool Bool -> -> T4 Float Float -> -> T5 () ()
      u, v :: :: Int

      This is the C3 record constructor

      s1 :: :: Int

      The s1 record selector

      s2 :: :: Int

      The s2 record selector

      s3 :: :: Int

      The s3 record selector

      test that we can export record selectors on their own:

      p :: R -> Int #

      This comment applies to the p field

      q :: R -> forall a. a -> a #

      This comment applies to the q field

      u :: R -> Int #

      Class declarations

      class D a => CThis comment applies to the previous declaration (the C class)

      Minimal complete definition

      a, , b

      a :: :: IO a #

      this is a description of the a method

      this is a description of the b method

      Minimal complete definition

      d, , e

      d :: :: T a b # D Float

      d :: :: T Float b #

      e :: ( :: (Float, , Float) # D Int

      d :: :: T Int b #

      e :: ( :: (Int, , Int) #

      Minimal complete definition

      ff

      a :: :: C a => a => IO a #

      this is a description of the a method

      f :: :: C a => a -> a => a -> Int #

      In a comment string we can refer to identifiers in scope with single quotes like this: T, and we can refer to modules by @@ -1801,7 +1877,7 @@ using double quotes: 

           This is a block of code, which can include other markup: R
@@ -1821,9 +1897,9 @@ using double quotes: 
      g ::  :: Int ->  -> IO CInt #
      hidden ::  :: Int ->  -> Int #
      C b => Ex1
      C a => Ex3
      :: :: T () ()
      This argument has type T
      -> -> T2  Int  Int
      -> (-> (T3  Bool  Bool ->  -> T4  Float  Float)
      -> -> T5 () ()
      -> -> IO ()
      :: (:: (Int, , Int, , Float)
      -> -> Int
      returns an Int
      Instance details
      Defined in Bug7
      Instance details
      Defined in Hash
       
      Methods
      Instance details
      Defined in Hash
       
      Methods
      Instance details
      Defined in Hash
       
      Methods
      Instance details
      Defined in HiddenInstances
      Instance details
      Defined in HiddenInstances
      Instance details
      Defined in HiddenInstances
       
      Methods
      Instance details
      Defined in HiddenInstances
      Instance details
      Defined in HiddenInstancesA
      Instance details
      Defined in HiddenInstancesA
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      Methods
      Instance details
      Defined in Instances
       
      data 
      Instance details
      Defined in Instances
       
      Associated Types
      Instance details
      Defined in Instances
       
      Associated Types
      Instance details
       
      Methods
      Instance details
      Defined in OrphanInstances
       
      Methods
      Instance details
      Defined in OrphanInstances
       
      Methods
      Instance details
      Defined in QuasiExpr
       
      Methods
      Instance details
      Defined in QuasiExpr
       
      Methods
      Instance details
      Defined in SpuriousSuperclassConstraints
       
      Methods
      Instance details
      Defined in SpuriousSuperclassConstraints
       
      Methods
      Instance details
      Defined in Test
       
      Methods
      Instance details
      Defined in Test
       
      Methods
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies
       
      Associated Types
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      Associated Types
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      data 
      Instance details
      Defined in TypeFamilies
       
      Associated Types
      Instance details
      Defined in TypeFamilies
       
      Associated Types
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies
      Instance details
      Defined in TypeFamilies2
       
      data 
      Instance details
      Defined in TypeFamilies2
       
      type 
      Instance details
      Defined in TypeFamilies2
       
      type 
      Instance details
      Defined in TypeFamilies
       
      type 
      Instance details
      Defined in TypeFamilies2
       
      data 
      Instance details
      Defined in TypeFamilies
       
      data 
Date: Wed, 21 Mar 2018 09:20:36 +0100
Subject: Prepare changelog for next release

---
 CHANGES.md | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 359d12b1..7bb439af 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,7 @@
+## Changes in version 2.20.x.x
+
+ * Show where instances are defined (#748)
+
 ## Changes in version 2.19.0.1
 
  * Support for linking unicode operators (#458)
-- 
cgit v1.2.3


From d270aeee23427c8cfe582549ead8f495704603f6 Mon Sep 17 00:00:00 2001
From: Alexander Biehl 
Date: Fri, 23 Mar 2018 15:57:36 +0100
Subject: Useful cost centres, timers and allocation counters (#785)

* Add some useful cost-centres for profiling

* Add withTiming for each haddock phase

Invoking haddock with `--optghc=-ddump-timings` now shows the amount
of time spent and the number of allocated bytes for each phase.
---
 haddock-api/src/Haddock.hs           | 59 ++++++++++++++++++++++++------------
 haddock-api/src/Haddock/Interface.hs | 21 ++++++++-----
 2 files changed, 53 insertions(+), 27 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 23fefb3b..dc903e08 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -Wwarn #-}
-{-# LANGUAGE CPP, ScopedTypeVariables, Rank2Types #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, Rank2Types #-}
 {-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
@@ -238,8 +238,8 @@ renderStep dflags flags qual pkgs interfaces = do
       ((_, Just path), ifile) <- pkgs
       iface <- ifInstalledIfaces ifile
       return (instMod iface, path)
-  render dflags flags qual interfaces installedIfaces extSrcMap
 
+  render dflags flags qual interfaces installedIfaces extSrcMap
 
 -- | Render the interfaces with whatever backend is specified in the flags.
 render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> Map Module FilePath -> IO ()
@@ -323,24 +323,34 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
   let withQuickjump = Flag_QuickJumpIndex `elem` flags
 
   when (Flag_GenIndex `elem` flags) $ do
-    ppHtmlIndex odir title pkgStr
-                themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
-                allVisibleIfaces pretty
+    withTiming (pure dflags') "ppHtmlIndex" (const ()) $ do
+      _ <- {-# SCC ppHtmlIndex #-}
+           ppHtmlIndex odir title pkgStr
+                  themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
+                  allVisibleIfaces pretty
+      return ()
+
     copyHtmlBits odir libDir themes withQuickjump
 
   when (Flag_GenContents `elem` flags) $ do
-    ppHtmlContents dflags' odir title pkgStr
-                   themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
-                   allVisibleIfaces True prologue pretty
-                   (makeContentsQual qual)
+    withTiming (pure dflags') "ppHtmlContents" (const ()) $ do
+      _ <- {-# SCC ppHtmlContents #-}
+           ppHtmlContents dflags' odir title pkgStr
+                     themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
+                     allVisibleIfaces True prologue pretty
+                     (makeContentsQual qual)
+      return ()
     copyHtmlBits odir libDir themes withQuickjump
 
   when (Flag_Html `elem` flags) $ do
-    ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir
-                prologue
-                themes opt_mathjax sourceUrls' opt_wiki_urls
-                opt_contents_url opt_index_url unicode qual
-                pretty withQuickjump
+    withTiming (pure dflags') "ppHtml" (const ()) $ do
+      _ <- {-# SCC ppHtml #-}
+           ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir
+                  prologue
+                  themes opt_mathjax sourceUrls' opt_wiki_urls
+                  opt_contents_url opt_index_url unicode qual
+                  pretty withQuickjump
+      return ()
     copyHtmlBits odir libDir themes withQuickjump
     writeHaddockMeta odir withQuickjump
 
@@ -359,15 +369,24 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
       Just (PackageName pkgNameFS, pkgVer) ->
           let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
                          | otherwise = unpackFS pkgNameFS
-          in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
-               visibleIfaces odir
+          in withTiming (pure dflags') "ppHoogle" (const ()) $ do
+               _ <- {-# SCC ppHoogle #-}
+                    ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
+                      visibleIfaces odir
+               return ()
 
   when (Flag_LaTeX `elem` flags) $ do
-    ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
-                  libDir
+    withTiming (pure dflags') "ppLatex" (const ()) $ do
+      _ <- {-# SCC ppLatex #-}
+           ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
+                   libDir
+      return ()
 
   when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
-    ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
+    withTiming (pure dflags') "ppHyperlinkedSource" (const ()) $ do
+      _ <- {-# SCC ppHyperlinkedSource #-}
+           ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
+      return ()
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
@@ -400,7 +419,7 @@ readInterfaceFiles :: MonadIO m
                    -> [(DocPaths, FilePath)]
                    -> m [(DocPaths, InterfaceFile)]
 readInterfaceFiles name_cache_accessor pairs = do
-  catMaybes `liftM` mapM tryReadIface pairs
+  catMaybes `liftM` mapM ({-# SCC readInterfaceFile #-} tryReadIface) pairs
   where
     -- try to read an interface, warn if we can't
     tryReadIface (paths, file) =
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index cbdf81cb..89064a6c 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, OverloadedStrings #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface
@@ -60,6 +60,7 @@ import FastString (unpackFS)
 import MonadUtils (liftIO)
 import TcRnTypes (tcg_rdr_env)
 import RdrName (plusGlobalRdrEnv)
+import ErrUtils (withTiming)
 
 #if defined(mingw32_HOST_OS)
 import System.IO
@@ -93,13 +94,15 @@ processModules verbosity modules flags extIfaces = do
         filter (\i -> not $ OptHide `elem` ifaceOptions i) interfaces
       mods = Set.fromList $ map ifaceMod interfaces
   out verbosity verbose "Attaching instances..."
-  interfaces' <- attachInstances (exportedNames, mods) interfaces instIfaceMap
+  interfaces' <- {-# SCC attachInstances #-}
+                 withTiming getDynFlags "attachInstances" (const ()) $ do
+                   attachInstances (exportedNames, mods) interfaces instIfaceMap
 
   out verbosity verbose "Building cross-linking environment..."
   -- Combine the link envs of the external packages into one
   let extLinks  = Map.unions (map ifLinkEnv extIfaces)
-      homeLinks = buildHomeLinks interfaces -- Build the environment for the home
-                                            -- package
+      homeLinks = buildHomeLinks interfaces' -- Build the environment for the home
+                                             -- package
       links     = homeLinks `Map.union` extLinks
 
   out verbosity verbose "Renaming interfaces..."
@@ -155,7 +158,9 @@ createIfaces verbosity flags instIfaceMap mods = do
   return (reverse ifaces)
   where
     f (ifaces, ifaceMap) modSummary = do
-      x <- processModule verbosity modSummary flags ifaceMap instIfaceMap
+      x <- {-# SCC processModule #-}
+           withTiming getDynFlags "processModule" (const ()) $ do
+             processModule verbosity modSummary flags ifaceMap instIfaceMap
       return $ case x of
         Just iface -> (iface:ifaces, Map.insert (ifaceMod iface) iface ifaceMap)
         Nothing    -> (ifaces, ifaceMap) -- Boot modules don't generate ifaces.
@@ -164,7 +169,7 @@ createIfaces verbosity flags instIfaceMap mods = do
 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 <- loadModule =<< typecheckModule =<< parseModule modsum
+  tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum
 
   -- We need to modify the interactive context's environment so that when
   -- Haddock later looks for instances, it also looks in the modules it
@@ -179,7 +184,9 @@ processModule verbosity modsum flags modMap instIfaceMap = do
 
   if not $ isBootSummary modsum then do
     out verbosity verbose "Creating interface..."
-    (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
+    (interface, msg) <- {-# SCC createIterface #-}
+                        withTiming getDynFlags "createInterface" (const ()) $ do
+                          runWriterGhc $ createInterface tm flags modMap instIfaceMap
     liftIO $ mapM_ putStrLn msg
     dflags <- getDynFlags
     let (haddockable, haddocked) = ifaceHaddockCoverage interface
-- 
cgit v1.2.3


From 978dbc859df09eb991d9ccc0911276cc9655b783 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Mon, 26 Mar 2018 23:35:59 -0700
Subject: @since includes package name (#749)

* Metadoc stores a package name

This means that '@since' annotations can be package aware.

* Get the package name the right way

This should extract the package name for `@since` annotations the
right way. I had to move `modulePackageInfo` around to do this and,
in the process, I took the liberty to update it.

Since it appears that finding the package name is something that can
fail, I added a warning for this case.

* Silence warnings

* Hide package for local 'since' annotations

As discussed, this is still the usual case (and we should avoid being
noisy for it).

Although this commit is large, it is basically only about threading a
'Maybe Package' from 'Haddock.render' all the way to
'Haddock.Backends.Xhtml.DocMarkup.renderMeta'.

* Bump binary interface version

* Add a '--since-qual' option

This controls when to qualify since annotations with the package they
come from. The default is always, but I've left an 'external' variant
where only those annotations coming from outside of the current
package are qualified.

* Make ParserSpec work

* Make Fixtures work

* Use package name even if package version is not available

The @since stuff needs only the package name passed in, so it
makes sense to not be forced to pass in a version too.
---
 haddock-api/src/Haddock.hs                         |  72 ++++------
 haddock-api/src/Haddock/Backends/Xhtml.hs          | 110 +++++++--------
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs     | 147 +++++++++++----------
 .../src/Haddock/Backends/Xhtml/DocMarkup.hs        |  50 ++++---
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs   |  57 ++++----
 haddock-api/src/Haddock/Interface/Create.hs        |  48 ++++---
 haddock-api/src/Haddock/Interface/LexParseRn.hs    |  21 +--
 .../src/Haddock/Interface/ParseModuleHeader.hs     |   6 +-
 haddock-api/src/Haddock/InterfaceFile.hs           |  11 +-
 haddock-api/src/Haddock/Options.hs                 |  39 +++++-
 haddock-api/src/Haddock/Parser.hs                  |   4 +-
 haddock-api/src/Haddock/Types.hs                   |   6 +
 haddock-library/fixtures/Fixtures.hs               |   2 +-
 haddock-library/src/Documentation/Haddock/Doc.hs   |   8 +-
 .../src/Documentation/Haddock/Parser.hs            |   9 +-
 haddock-library/src/Documentation/Haddock/Types.hs |   5 +-
 .../test/Documentation/Haddock/ParserSpec.hs       |  17 ++-
 17 files changed, 346 insertions(+), 266 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index dc903e08..00eb50f6 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -25,7 +25,6 @@ module Haddock (
   withGhc
 ) where
 
-import Data.Version
 import Haddock.Backends.Xhtml
 import Haddock.Backends.Xhtml.Meta
 import Haddock.Backends.Xhtml.Themes (getThemes)
@@ -42,7 +41,6 @@ import Haddock.Options
 import Haddock.Utils
 
 import Control.Monad hiding (forM_)
-import Control.Applicative
 import Data.Foldable (forM_, foldl')
 import Data.Traversable (for)
 import Data.List (isPrefixOf)
@@ -151,7 +149,8 @@ haddockWithGhc ghc args = handleTopExceptions $ do
   -- or which exits with an error or help message.
   (flags, files) <- parseHaddockOpts args
   shortcutFlags flags
-  qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q}
+  qual <- rightOrThrowE (qualification flags)
+  sinceQual <- rightOrThrowE (sinceQualification flags)
 
   -- inject dynamic-too into flags before we proceed
   flags' <- ghc flags $ do
@@ -184,7 +183,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
           }
 
       -- Render the interfaces.
-      liftIO $ renderStep dflags flags qual packages ifaces
+      liftIO $ renderStep dflags flags sinceQual qual packages ifaces
 
     else do
       when (any (`elem` [Flag_Html, Flag_Hoogle, Flag_LaTeX]) flags) $
@@ -194,7 +193,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
       packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags)
 
       -- Render even though there are no input files (usually contents/index).
-      liftIO $ renderStep dflags flags qual packages []
+      liftIO $ renderStep dflags flags sinceQual qual packages []
 
 -- | Create warnings about potential misuse of -optghc
 warnings :: [String] -> [String]
@@ -228,8 +227,9 @@ readPackagesAndProcessModules flags files = do
     return (packages, ifaces, homeLinks)
 
 
-renderStep :: DynFlags -> [Flag] -> QualOption -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO ()
-renderStep dflags flags qual pkgs interfaces = do
+renderStep :: DynFlags -> [Flag] -> SinceQual -> QualOption
+           -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO ()
+renderStep dflags flags sinceQual nameQual pkgs interfaces = do
   updateHTMLXRefs pkgs
   let
     ifaceFiles = map snd pkgs
@@ -238,12 +238,12 @@ renderStep dflags flags qual pkgs interfaces = do
       ((_, Just path), ifile) <- pkgs
       iface <- ifInstalledIfaces ifile
       return (instMod iface, path)
-
-  render dflags flags qual interfaces installedIfaces extSrcMap
+  render dflags flags sinceQual nameQual interfaces installedIfaces extSrcMap
 
 -- | Render the interfaces with whatever backend is specified in the flags.
-render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> Map Module FilePath -> IO ()
-render dflags flags qual ifaces installedIfaces extSrcMap = do
+render :: DynFlags -> [Flag] -> SinceQual -> QualOption -> [Interface]
+       -> [InstalledInterface] -> Map Module FilePath -> IO ()
+render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
 
   let
     title                = fromMaybe "" (optTitle flags)
@@ -270,6 +270,10 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
     pkgKey           = moduleUnitId pkgMod
     pkgStr           = Just (unitIdString pkgKey)
     pkgNameVer       = modulePackageInfo dflags flags pkgMod
+    pkgName          = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer)
+    sincePkg         = case sinceQual of
+                         External -> pkgName
+                         Always -> Nothing
 
     (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags
 
@@ -338,7 +342,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
            ppHtmlContents dflags' odir title pkgStr
                      themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
                      allVisibleIfaces True prologue pretty
-                     (makeContentsQual qual)
+                     sincePkg (makeContentsQual qual)
       return ()
     copyHtmlBits odir libDir themes withQuickjump
 
@@ -348,7 +352,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
            ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir
                   prologue
                   themes opt_mathjax sourceUrls' opt_wiki_urls
-                  opt_contents_url opt_index_url unicode qual
+                  opt_contents_url opt_index_url unicode sincePkg qual
                   pretty withQuickjump
       return ()
     copyHtmlBits odir libDir themes withQuickjump
@@ -358,7 +362,12 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
   -- might want to fix that if/when these two get some work on them
   when (Flag_Hoogle `elem` flags) $ do
     case pkgNameVer of
-      Nothing -> putStrLn . unlines $
+      (Just (PackageName pkgNameFS), Just pkgVer) ->
+          let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
+                         | otherwise = unpackFS pkgNameFS
+          in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
+               visibleIfaces odir
+      _ -> putStrLn . unlines $
           [ "haddock: Unable to find a package providing module "
             ++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle."
           , ""
@@ -366,14 +375,6 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
             ++ " using the --package-name"
           , "         and --package-version arguments."
           ]
-      Just (PackageName pkgNameFS, pkgVer) ->
-          let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
-                         | otherwise = unpackFS pkgNameFS
-          in withTiming (pure dflags') "ppHoogle" (const ()) $ do
-               _ <- {-# SCC ppHoogle #-}
-                    ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
-                      visibleIfaces odir
-               return ()
 
   when (Flag_LaTeX `elem` flags) $ do
     withTiming (pure dflags') "ppLatex" (const ()) $ do
@@ -388,26 +389,6 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
            ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
       return ()
 
--- | From GHC 7.10, this function has a potential to crash with a
--- nasty message such as @expectJust getPackageDetails@ because
--- package name and versions can no longer reliably be extracted in
--- all cases: if the package is not installed yet then this info is no
--- longer available. The @--package-name@ and @--package-version@
--- Haddock flags allow the user to specify this information and it is
--- returned here if present: if it is not present, the error will
--- occur. Nasty but that's how it is for now. Potential TODO.
-modulePackageInfo :: DynFlags
-                  -> [Flag] -- ^ Haddock flags are checked as they may
-                            -- contain the package name or version
-                            -- provided by the user which we
-                            -- prioritise
-                  -> Module -> Maybe (PackageName, Data.Version.Version)
-modulePackageInfo dflags flags modu =
-    cmdline <|> pkgDb
-  where
-    cmdline = (,) <$> optPackageName flags <*> optPackageVersion flags
-    pkgDb = (\pkg -> (packageName pkg, packageVersion pkg)) <$> lookupPackage dflags (moduleUnitId modu)
-
 
 -------------------------------------------------------------------------------
 -- * Reading and dumping interface files
@@ -628,10 +609,15 @@ getPrologue dflags flags =
       h <- openFile filename ReadMode
       hSetEncoding h utf8
       str <- hGetContents h -- semi-closes the handle
-      return . Just $! parseParas dflags str
+      return . Just $! parseParas dflags Nothing str
     _ -> throwE "multiple -p/--prologue options"
 
 
+rightOrThrowE :: Either String b -> IO b
+rightOrThrowE (Left msg) = throwE msg
+rightOrThrowE (Right x) = pure x
+
+
 #ifdef IN_GHC_TREE
 
 getInTreeDir :: IO String
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index d03cf0ba..c9a262a4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -70,6 +70,7 @@ ppHtml :: DynFlags
        -> Maybe String                 -- ^ The contents URL (--use-contents)
        -> Maybe String                 -- ^ The index URL (--use-index)
        -> Bool                         -- ^ Whether to use unicode in output (--use-unicode)
+       -> Maybe String                 -- ^ Package name
        -> QualOption                   -- ^ How to qualify names
        -> Bool                         -- ^ Output pretty html (newlines and indenting)
        -> Bool                         -- ^ Also write Quickjump index
@@ -78,7 +79,7 @@ ppHtml :: DynFlags
 ppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue
         themes maybe_mathjax_url maybe_source_url maybe_wiki_url
         maybe_contents_url maybe_index_url unicode
-        qual debug withQuickjump =  do
+        pkg qual debug withQuickjump = do
   let
     visible_ifaces = filter visible ifaces
     visible i = OptHide `notElem` ifaceOptions i
@@ -88,7 +89,7 @@ ppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue
         themes maybe_mathjax_url maybe_index_url maybe_source_url maybe_wiki_url
         (map toInstalledIface visible_ifaces ++ reexported_ifaces)
         False -- we don't want to display the packages in a single-package contents
-        prologue debug (makeContentsQual qual)
+        prologue debug pkg (makeContentsQual qual)
 
   when (isNothing maybe_index_url) $ do
     ppHtmlIndex odir doctitle maybe_package
@@ -96,12 +97,12 @@ ppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue
       (map toInstalledIface visible_ifaces ++ reexported_ifaces) debug
 
     when withQuickjump $
-      ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual
+      ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual
         visible_ifaces
 
   mapM_ (ppHtmlModule odir doctitle themes
            maybe_mathjax_url maybe_source_url maybe_wiki_url
-           maybe_contents_url maybe_index_url unicode qual debug) visible_ifaces
+           maybe_contents_url maybe_index_url unicode pkg qual debug) visible_ifaces
 
 
 copyHtmlBits :: FilePath -> FilePath -> Themes -> Bool -> IO ()
@@ -258,11 +259,12 @@ ppHtmlContents
    -> WikiURLs
    -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName)
    -> Bool
+   -> Maybe Package  -- ^ Current package
    -> Qualification  -- ^ How to qualify names
    -> IO ()
 ppHtmlContents dflags odir doctitle _maybe_package
   themes mathjax_url maybe_index_url
-  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do
+  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug pkg qual = do
   let tree = mkModuleTree dflags showPkgs
          [(instMod iface, toInstalledDescription iface)
          | iface <- ifaces
@@ -276,41 +278,41 @@ ppHtmlContents dflags odir doctitle _maybe_package
         bodyHtml doctitle Nothing
           maybe_source_url maybe_wiki_url
           Nothing maybe_index_url << [
-            ppPrologue qual doctitle prologue,
-            ppSignatureTree qual sig_tree,
-            ppModuleTree qual tree
+            ppPrologue pkg qual doctitle prologue,
+            ppSignatureTree pkg qual sig_tree,
+            ppModuleTree pkg qual tree
           ]
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
 
 
-ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
-ppPrologue _ _ Nothing = noHtml
-ppPrologue qual title (Just doc) =
-  divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc))
+ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
+ppPrologue _ _ _ Nothing = noHtml
+ppPrologue pkg qual title (Just doc) =
+  divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml pkg qual doc))
 
 
-ppSignatureTree :: Qualification -> [ModuleTree] -> Html
-ppSignatureTree qual ts =
-  divModuleList << (sectionName << "Signatures" +++ mkNodeList qual [] "n" ts)
+ppSignatureTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
+ppSignatureTree pkg qual ts =
+  divModuleList << (sectionName << "Signatures" +++ mkNodeList pkg qual [] "n" ts)
 
 
-ppModuleTree :: Qualification -> [ModuleTree] -> Html
-ppModuleTree _ [] = mempty
-ppModuleTree qual ts =
-  divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts)
+ppModuleTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
+ppModuleTree _ _ [] = mempty
+ppModuleTree pkg qual ts =
+  divModuleList << (sectionName << "Modules" +++ mkNodeList pkg qual [] "n" ts)
 
 
-mkNodeList :: Qualification -> [String] -> String -> [ModuleTree] -> Html
-mkNodeList qual ss p ts = case ts of
+mkNodeList :: Maybe Package -> Qualification -> [String] -> String -> [ModuleTree] -> Html
+mkNodeList pkg qual ss p ts = case ts of
   [] -> noHtml
-  _ -> unordList (zipWith (mkNode qual ss) ps ts)
+  _ -> unordList (zipWith (mkNode pkg qual ss) ps ts)
   where
     ps = [ p ++ '.' : show i | i <- [(1::Int)..]]
 
 
-mkNode :: Qualification -> [String] -> String -> ModuleTree -> Html
-mkNode qual ss p (Node s leaf _pkg srcPkg short ts) =
+mkNode :: Maybe Package -> Qualification -> [String] -> String -> ModuleTree -> Html
+mkNode pkg qual ss p (Node s leaf _pkg srcPkg short ts) =
   htmlModule <+> shortDescr +++ htmlPkg +++ subtree
   where
     modAttrs = case (ts, leaf) of
@@ -330,14 +332,14 @@ mkNode qual ss p (Node s leaf _pkg srcPkg short ts) =
         Nothing -> toHtml s
       )
 
-    shortDescr = maybe noHtml (origDocToHtml qual) short
+    shortDescr = maybe noHtml (origDocToHtml pkg qual) short
     htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) srcPkg
 
     subtree =
       if null ts then noHtml else
       collapseDetails p DetailsOpen (
         thesummary ! [ theclass "hide-when-js-enabled" ] << "Submodules" +++
-        mkNodeList qual (s:ss) p ts
+        mkNodeList pkg qual (s:ss) p ts
       )
 
 
@@ -350,10 +352,11 @@ ppJsonIndex :: FilePath
            -> SourceURLs                   -- ^ The source URL (--source)
            -> WikiURLs                     -- ^ The wiki URL (--wiki)
            -> Bool
+           -> Maybe Package
            -> QualOption
            -> [Interface]
            -> IO ()
-ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual_opt ifaces = do
+ppJsonIndex odir maybe_source_url maybe_wiki_url unicode pkg qual_opt ifaces = do
   createDirectoryIfMissing True odir
   IO.withBinaryFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \h -> do
     Builder.hPutBuilder h (encodeToBuilder modules)
@@ -371,7 +374,7 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual_opt ifaces = do
 
     goExport :: Module -> Qualification -> ExportItem DocNameI -> [Value]
     goExport mdl qual item
-      | Just item_html <- processExport True links_info unicode qual item
+      | Just item_html <- processExport True links_info unicode pkg qual item
       = [ Object
             [ "display_html" .= String (showHtmlFragment item_html)
             , "name"         .= String (intercalate " " (map nameString names))
@@ -529,11 +532,11 @@ ppHtmlIndex odir doctitle _maybe_package themes
 ppHtmlModule
         :: FilePath -> String -> Themes
         -> Maybe String -> SourceURLs -> WikiURLs
-        -> Maybe String -> Maybe String -> Bool -> QualOption
+        -> Maybe String -> Maybe String -> Bool -> Maybe Package -> QualOption
         -> Bool -> Interface -> IO ()
 ppHtmlModule odir doctitle themes
   maybe_mathjax_url maybe_source_url maybe_wiki_url
-  maybe_contents_url maybe_index_url unicode qual debug iface = do
+  maybe_contents_url maybe_index_url unicode pkg qual debug iface = do
   let
       mdl = ifaceMod iface
       aliases = ifaceModuleAliases iface
@@ -555,7 +558,7 @@ ppHtmlModule odir doctitle themes
           maybe_source_url maybe_wiki_url
           maybe_contents_url maybe_index_url << [
             divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)),
-            ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual
+            ifaceToHtml maybe_source_url maybe_wiki_url iface unicode pkg real_qual
           ]
 
   createDirectoryIfMissing True odir
@@ -565,9 +568,9 @@ signatureDocURL :: String
 signatureDocURL = "https://wiki.haskell.org/Module_signature"
 
 
-ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
-ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
-  = ppModuleContents qual exports (not . null $ ifaceRnOrphanInstances iface) +++
+ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Maybe Package -> Qualification -> Html
+ifaceToHtml maybe_source_url maybe_wiki_url iface unicode pkg qual
+  = ppModuleContents pkg qual exports (not . null $ ifaceRnOrphanInstances iface) +++
     description +++
     synopsis +++
     divInterface (maybe_doc_hdr +++ bdy +++ orphans)
@@ -585,7 +588,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
 
     description | isNoHtml doc = doc
                 | otherwise    = divDescription $ sectionName << "Description" +++ doc
-                where doc = docSection Nothing qual (ifaceRnDoc iface)
+                where doc = docSection Nothing pkg qual (ifaceRnDoc iface)
 
         -- omit the synopsis if there are no documentation annotations at all
     synopsis
@@ -595,7 +598,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
             collapseDetails "syn" DetailsClosed (
               thesummary << "Synopsis" +++
               shortDeclList (
-                  mapMaybe (processExport True linksInfo unicode qual) exports
+                  mapMaybe (processExport True linksInfo unicode pkg qual) exports
               ) ! collapseToggle "syn" ""
             )
 
@@ -609,19 +612,20 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
 
     bdy =
       foldr (+++) noHtml $
-        mapMaybe (processExport False linksInfo unicode qual) exports
+        mapMaybe (processExport False linksInfo unicode pkg qual) exports
 
     orphans =
-      ppOrphanInstances linksInfo (ifaceRnOrphanInstances iface) False unicode qual
+      ppOrphanInstances linksInfo (ifaceRnOrphanInstances iface) False unicode pkg qual
 
     linksInfo = (maybe_source_url, maybe_wiki_url)
 
 
-ppModuleContents :: Qualification
+ppModuleContents :: Maybe Package -- ^ This package
+                 -> Qualification
                  -> [ExportItem DocNameI]
-                 -> Bool -- ^ Orphans sections
+                 -> Bool          -- ^ Orphans sections
                  -> Html
-ppModuleContents qual exports orphan
+ppModuleContents pkg qual exports orphan
   | null sections && not orphan  = noHtml
   | otherwise                    = contentsDiv
  where
@@ -641,7 +645,7 @@ ppModuleContents qual exports orphan
     | otherwise = ( html:secs, rest2 )
     where
       html = linkedAnchor (groupId id0)
-             << docToHtmlNoAnchors (Just id0) qual (mkMeta doc) +++ mk_subsections ssecs
+             << docToHtmlNoAnchors (Just id0) pkg qual (mkMeta doc) +++ mk_subsections ssecs
       (ssecs, rest1) = process lev rest
       (secs,  rest2) = process n   rest1
   process n (_ : rest) = process n rest
@@ -661,22 +665,22 @@ numberSectionHeadings = go 1
           = other : go n es
 
 
-processExport :: Bool -> LinksInfo -> Bool -> Qualification
+processExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification
               -> ExportItem DocNameI -> Maybe Html
-processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
-processExport summary _ _ qual (ExportGroup lev id0 doc)
-  = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) qual (mkMeta doc)
-processExport summary links unicode qual (ExportDecl decl pats doc subdocs insts fixities splice)
-  = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode qual
-processExport summary _ _ qual (ExportNoDecl y [])
+processExport _ _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
+processExport summary _ _ pkg qual (ExportGroup lev id0 doc)
+  = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) pkg qual (mkMeta doc)
+processExport summary links unicode pkg qual (ExportDecl decl pats doc subdocs insts fixities splice)
+  = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode pkg qual
+processExport summary _ _ _ qual (ExportNoDecl y [])
   = processDeclOneLiner summary $ ppDocName qual Prefix True y
-processExport summary _ _ qual (ExportNoDecl y subs)
+processExport summary _ _ _ qual (ExportNoDecl y subs)
   = processDeclOneLiner summary $
       ppDocName qual Prefix True y
       +++ parenList (map (ppDocName qual Prefix True) subs)
-processExport summary _ _ qual (ExportDoc doc)
-  = nothingIf summary $ docSection_ Nothing qual doc
-processExport summary _ _ _ (ExportModule mdl)
+processExport summary _ _ pkg qual (ExportDoc doc)
+  = nothingIf summary $ docSection_ Nothing pkg qual doc
+processExport summary _ _ _ _ (ExportModule mdl)
   = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d92bdd3a..815ecee9 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -43,17 +43,18 @@ import RdrName ( rdrNameOcc )
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocNameI
        -> [(HsDecl DocNameI, DocForDecl DocName)]
        -> DocForDecl DocName ->  [DocInstance DocNameI] -> [(DocName, Fixity)]
-       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
-ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
-  TyClD (FamDecl d)            -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
-  TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode qual
-  TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
-  TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode
+       -> Maybe Package -> Qualification -> Html
+ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of
+  TyClD (FamDecl d)            -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual
+  TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual
+  TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual
+  TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual
   SigD (TypeSig lnames lty)    -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
-                                         (hsSigWcType lty) fixities splice unicode qual
+                                         (hsSigWcType lty) fixities splice unicode pkg qual
   SigD (PatSynSig lnames ty)   -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
-                                         ty fixities splice unicode qual
-  ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
+                                         ty fixities splice unicode pkg qual
+  ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
   InstD _                      -> noHtml
   DerivD _                     -> noHtml
   _                            -> error "declaration not supported by ppDecl"
@@ -61,28 +62,29 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc
 
 ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
-             Splice -> Unicode -> Qualification -> Html
-ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
+             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
-           splice unicode qual
+           splice unicode pkg qual
 
 ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
             [DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
-            Splice -> Unicode -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
+            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)
-            splice unicode qual HideEmptyContexts
+            splice unicode pkg qual HideEmptyContexts
   where
     pp_typ = ppLType unicode qual HideEmptyContexts typ
 
 ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsSigType DocNameI ->
              [(DocName, Fixity)] ->
-             Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode qual
+             Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice
+          unicode pkg qual
   | summary = pref1
   | otherwise = topDeclElem links loc splice (map unLoc docnames) (pref1 <+> ppFixities fixities qual)
-                +++ docSection Nothing qual doc
+                +++ docSection Nothing pkg qual doc
   where
     pref1 = hsep [ keyword "pattern"
                  , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames
@@ -92,15 +94,15 @@ ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode
 
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
              [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
-             Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
+             Splice -> Unicode -> Maybe Package -> Qualification -> HideEmptyContexts -> Html
 ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
-          splice unicode qual emptyCtxts =
+          splice unicode pkg qual emptyCtxts =
   ppTypeOrFunSig summary links loc docnames typ doc
     ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
     , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
     , dcolon unicode
     )
-    splice unicode qual emptyCtxts
+    splice unicode pkg qual emptyCtxts
   where
     occnames = map (nameOccName . getName) docnames
     addFixities html
@@ -110,12 +112,14 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
 
 ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI
                -> DocForDecl DocName -> (Html, Html, Html)
-               -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
-ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts
+               -> Splice -> Unicode -> Maybe Package -> Qualification
+               -> HideEmptyContexts -> Html
+ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
+               splice unicode pkg qual emptyCtxts
   | summary = pref1
-  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName qual doc
+  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc
   | otherwise = topDeclElem links loc splice docnames pref2 +++
-      subArguments qual (do_args 0 sep typ) +++ docSection curName qual doc
+      subArguments pkg qual (do_args 0 sep typ) +++ docSection curName pkg qual doc
   where
     curName = getName <$> listToMaybe docnames
     argDoc n = Map.lookup n argDocs
@@ -181,23 +185,23 @@ tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocNameI -> [(DocName, Fixity)]
-      -> Splice -> Unicode -> Qualification -> Html
+      -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppFor summary links loc doc (ForeignImport (L _ name) typ _ _) fixities
-      splice unicode qual
-  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode qual
-ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
+      splice unicode pkg qual
+  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode pkg qual
+ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
 
 
 -- we skip type patterns for now
 ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan
         -> DocForDecl DocName -> TyClDecl DocNameI
-        -> Splice -> Unicode -> Qualification -> Html
+        -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
                                                 , tcdRhs = ltype })
-        splice unicode qual
+        splice unicode pkg qual
   = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
                    (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
-                   splice unicode qual ShowEmptyToplevelContexts
+                   splice unicode pkg qual ShowEmptyToplevelContexts
   where
     hdr  = hsep ([keyword "type", ppBinder summary occ]
                  ++ ppTyVars unicode qual (hsQTvExplicit ltyvars))
@@ -206,7 +210,7 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars
     fixs
       | summary   = noHtml
       | otherwise = ppFixities fixities qual
-ppTySyn _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
+ppTySyn _ _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
 
 
 ppTypeSig :: Bool -> [OccName] -> Html -> Unicode -> Html
@@ -297,11 +301,13 @@ ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
 
 ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->
            [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
-           FamilyDecl DocNameI -> Splice -> Unicode -> Qualification -> Html
-ppTyFam summary associated links instances fixities loc doc decl splice unicode qual
+           FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->
+           Qualification -> Html
+ppTyFam summary associated links instances fixities loc doc decl splice unicode
+        pkg qual
 
   | summary   = ppTyFamHeader True associated decl unicode qual
-  | otherwise = header_ +++ docSection Nothing qual doc +++ instancesBit
+  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit
 
   where
     docname = unLoc $ fdLName decl
@@ -312,10 +318,10 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
     instancesBit
       | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl
       , not summary
-      = subEquations qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
+      = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
 
       | otherwise
-      = ppInstances links (OriginFamily docname) instances splice unicode qual
+      = ppInstances links (OriginFamily docname) instances splice unicode pkg qual
 
     -- Individual equation of a closed type family
     ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl
@@ -343,9 +349,10 @@ ppPseudoFamilyDecl links splice unicode qual
 
 
 ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI
-            -> [(DocName, Fixity)] -> Splice -> Unicode -> Qualification -> Html
-ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
-   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual
+            -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package
+            -> Qualification -> Html
+ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =
+   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
 
 
 --------------------------------------------------------------------------------
@@ -454,22 +461,22 @@ ppFds fds unicode qual =
 
 ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocNameI -> SrcSpan
                  -> [(DocName, DocForDecl DocName)]
-                 -> Splice -> Unicode -> Qualification -> Html
+                 -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
                                           , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
-    subdocs splice unicode qual =
+    subdocs splice unicode pkg qual =
   if not (any isUserLSig sigs) && null ats
     then (if summary then id else topDeclElem links loc splice [nm]) hdr
     else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
       +++ shortSubDecls False
           (
-            [ ppAssocType summary links doc at [] splice unicode qual | at <- ats
+            [ ppAssocType summary links doc at [] splice unicode pkg qual | at <- ats
               , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++
 
                 -- ToDo: add associated type defaults
 
             [ ppFunSig summary links loc doc names (hsSigWcType typ)
-                       [] splice unicode qual
+                       [] splice unicode pkg qual
               | L _ (TypeSig lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
@@ -480,20 +487,20 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
   where
     hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual
     nm  = unLoc lname
-ppShortClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppShortClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
 
 ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)]
             -> SrcSpan -> Documentation DocName
             -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI
-            -> Splice -> Unicode -> Qualification -> Html
+            -> 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 })
-            splice unicode qual
-  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode qual
-  | otherwise = classheader +++ docSection Nothing qual d
+            splice unicode pkg qual
+  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual
+  | otherwise = classheader +++ docSection Nothing pkg qual d
                   +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
   where
     sigs = map unLoc lsigs
@@ -510,14 +517,14 @@ ppClassDecl summary links instances fixities loc d subdocs
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
     -- ToDo: add assocatied typ defaults
-    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode qual
+    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 qual
+                                      subfixs splice unicode pkg qual
                            | L _ (ClassOpSig _ lnames typ) <- lsigs
                            , name <- map unLoc lnames
                            , let doc = lookupAnySubdoc name subdocs
@@ -551,17 +558,17 @@ ppClassDecl summary links instances fixities loc d subdocs
     ppMinimal p (Parens x) = ppMinimal p (unLoc x)
 
     instancesBit = ppInstances links (OriginClass nm) instances
-        splice unicode qual
+        splice unicode pkg qual
 
-ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppClassDecl _ _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
 ppInstances :: LinksInfo
             -> InstOrigin DocName -> [DocInstance DocNameI]
-            -> Splice -> Unicode -> Qualification
+            -> Splice -> Unicode -> Maybe Package -> Qualification
             -> Html
-ppInstances links origin instances splice unicode qual
-  = subInstances qual instName links True (zipWith instDecl [1..] instances)
+ppInstances links origin instances splice unicode pkg qual
+  = subInstances pkg qual instName links True (zipWith instDecl [1..] instances)
   -- force Splice = True to use line URLs
   where
     instName = getOccString origin
@@ -572,10 +579,10 @@ ppInstances links origin instances splice unicode qual
 
 ppOrphanInstances :: LinksInfo
                   -> [DocInstance DocNameI]
-                  -> Splice -> Unicode -> Qualification
+                  -> Splice -> Unicode -> Maybe Package -> Qualification
                   -> Html
-ppOrphanInstances links instances splice unicode qual
-  = subOrphanInstances qual links True (zipWith instDecl [1..] instances)
+ppOrphanInstances links instances splice unicode pkg qual
+  = subOrphanInstances pkg qual links True (zipWith instDecl [1..] instances)
   where
     instOrigin :: InstHead name -> InstOrigin (IdP name)
     instOrigin inst = OriginClass (ihdClsName inst)
@@ -713,12 +720,12 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)]
               [(DocName, DocForDecl DocName)] ->
               SrcSpan -> Documentation DocName -> TyClDecl DocNameI ->
               [(HsDecl DocNameI, DocForDecl DocName)] ->
-              Splice -> Unicode -> Qualification -> Html
+              Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
-           splice unicode qual
+           splice unicode pkg qual
 
   | summary   = ppShortDataDecl summary False dataDecl pats unicode qual
-  | otherwise = header_ +++ docSection Nothing qual doc +++ constrBit +++ patternBit +++ instancesBit
+  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ constrBit +++ patternBit +++ instancesBit
 
   where
     docname   = tcdName dataDecl
@@ -738,14 +745,14 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
       | null cons = keyword "where"
       | otherwise = if isH98 then noHtml else keyword "where"
 
-    constrBit = subConstructors qual
-      [ ppSideBySideConstr subdocs subfixs unicode qual c
+    constrBit = subConstructors pkg qual
+      [ ppSideBySideConstr subdocs subfixs unicode pkg qual c
       | c <- cons
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
                                      (map unLoc (getConNames (unLoc c)))) fixities
       ]
 
-    patternBit = subPatterns qual
+    patternBit = subPatterns pkg qual
       [ (hsep [ keyword "pattern"
               , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames
               , dcolon unicode
@@ -757,7 +764,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
       ]
 
     instancesBit = ppInstances links (OriginData docname) instances
-        splice unicode qual
+        splice unicode pkg qual
 
 
 
@@ -824,8 +831,8 @@ ppConstrHdr forall_ tvs ctxt unicode qual
              | otherwise = noHtml
 
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
-                   -> Unicode -> Qualification -> LConDecl DocNameI -> SubDecl
-ppSideBySideConstr subdocs fixities unicode qual (L _ con)
+                   -> Unicode -> Maybe Package -> Qualification -> LConDecl DocNameI -> SubDecl
+ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
  = (decl, mbDoc, fieldPart)
  where
     decl = case con of
@@ -851,7 +858,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
         RecCon (L _ fields) -> [doRecordFields fields]
         _ -> []
 
-    doRecordFields fields = subFields qual
+    doRecordFields fields = subFields pkg qual
       (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))
 
     doGADTCon :: Located (HsType DocNameI) -> Html
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 2990e1e4..ed323a90 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -171,10 +171,10 @@ flatten x = [x]
 -- extract/append the underlying 'Doc' and convert it to 'Html'. For
 -- 'CollapsingHeader', we attach extra info to the generated 'Html'
 -- that allows us to expand/collapse the content.
-hackMarkup :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> Html
-hackMarkup fmt' h' =
+hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (ModuleName, OccName) id -> Html
+hackMarkup fmt' currPkg h' =
   let (html, ms) = hackMarkup' fmt' h'
-  in html +++ renderMeta fmt' (metaConcat ms)
+  in html +++ renderMeta fmt' currPkg (metaConcat ms)
   where
     hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id
                 -> (Html, [Meta])
@@ -193,45 +193,50 @@ hackMarkup fmt' h' =
                              (y, m') = hackMarkup' fmt d'
                          in (markupAppend fmt x y, m ++ m')
 
-renderMeta :: DocMarkup id Html -> Meta -> Html
-renderMeta fmt (Meta { _version = Just x }) =
+renderMeta :: DocMarkup id Html -> Maybe Package -> Meta -> Html
+renderMeta fmt currPkg (Meta { _version = Just x, _package = pkg }) =
   markupParagraph fmt . markupEmphasis fmt . toHtml $
-    "Since: " ++ formatVersion x
+    "Since: " ++ formatPkgMaybe pkg ++ formatVersion x
   where
     formatVersion v = concat . intersperse "." $ map show v
-renderMeta _ _ = noHtml
+    formatPkgMaybe (Just p) | Just p /= currPkg = p ++ "-"
+    formatPkgMaybe _ = ""
+renderMeta _ _ _ = noHtml
 
 -- | Goes through 'hackMarkup' to generate the 'Html' rather than
 -- skipping straight to 'markup': this allows us to employ XHtml
 -- specific hacks to the tree first.
 markupHacked :: DocMarkup id Html
+             -> Maybe Package      -- this package
              -> Maybe String
              -> MDoc id
              -> Html
-markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten
+markupHacked fmt currPkg n = hackMarkup fmt currPkg . toHack 0 n . flatten
 
 -- If the doc is a single paragraph, don't surround it with 
       (this causes
 -- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
-docToHtml :: Maybe String -- ^ Name of the thing this doc is for. See
-                          -- comments on 'toHack' for details.
+docToHtml :: Maybe String  -- ^ Name of the thing this doc is for. See
+                           -- comments on 'toHack' for details.
+          -> Maybe Package -- ^ Current package
           -> Qualification -> MDoc DocName -> Html
-docToHtml n qual = markupHacked fmt n . cleanup
+docToHtml n pkg qual = markupHacked fmt pkg n . cleanup
   where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
 
 -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
 -- in links. This is used to generate the Contents box elements.
-docToHtmlNoAnchors :: Maybe String -- ^ See 'toHack'
+docToHtmlNoAnchors :: Maybe String  -- ^ See 'toHack'
+                   -> Maybe Package -- ^ Current package
                    -> Qualification -> MDoc DocName -> Html
-docToHtmlNoAnchors n qual = markupHacked fmt n . cleanup
+docToHtmlNoAnchors n pkg qual = markupHacked fmt pkg n . cleanup
   where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
 
-origDocToHtml :: Qualification -> MDoc Name -> Html
-origDocToHtml qual = markupHacked fmt Nothing . cleanup
+origDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html
+origDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const $ ppName Raw)
 
 
-rdrDocToHtml :: Qualification -> MDoc RdrName -> Html
-rdrDocToHtml qual = markupHacked fmt Nothing . cleanup
+rdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html
+rdrDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const ppRdrName)
 
 
@@ -243,14 +248,17 @@ docElement el content_ =
 
 
 docSection :: Maybe Name -- ^ Name of the thing this doc is for
+           -> Maybe Package -- ^ Current package
            -> Qualification -> Documentation DocName -> Html
-docSection n qual = maybe noHtml (docSection_ n qual) . combineDocumentation
+docSection n pkg qual =
+  maybe noHtml (docSection_ n pkg qual) . combineDocumentation
 
 
-docSection_ :: Maybe Name -- ^ Name of the thing this doc is for
+docSection_ :: Maybe Name    -- ^ Name of the thing this doc is for
+            -> Maybe Package -- ^ Current package
             -> Qualification -> MDoc DocName -> Html
-docSection_ n qual =
-  (docElement thediv <<) . docToHtml (getOccString <$> n) qual
+docSection_ n pkg qual =
+  (docElement thediv <<) . docToHtml (getOccString <$> n) pkg qual
 
 
 cleanup :: MDoc a -> MDoc a
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 217ca2af..501caa4b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -128,38 +128,39 @@ divSubDecls cssClass captionName = maybe noHtml wrap
     subCaption = paragraph ! [theclass "caption"] << captionName
 
 
-subDlist :: Qualification -> [SubDecl] -> Maybe Html
-subDlist _ [] = Nothing
-subDlist qual decls = Just $ ulist << map subEntry decls
+subDlist :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
+subDlist _ _ [] = Nothing
+subDlist pkg qual decls = Just $ ulist << map subEntry decls
   where
     subEntry (decl, mdoc, subs) =
       li <<
         (define ! [theclass "src"] << decl +++
-         docElement thediv << (fmap (docToHtml Nothing qual) mdoc +++ subs))
+         docElement thediv << (fmap (docToHtml Nothing pkg qual) mdoc +++ subs))
 
 
-subTable :: Qualification -> [SubDecl] -> Maybe Html
-subTable _ [] = Nothing
-subTable qual decls = Just $ table << aboves (concatMap subRow decls)
+subTable :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
+subTable _ _ [] = Nothing
+subTable pkg qual decls = Just $ table << aboves (concatMap subRow decls)
   where
     subRow (decl, mdoc, subs) =
       (td ! [theclass "src"] << decl
        <->
-       docElement td << fmap (docToHtml Nothing qual) mdoc)
+       docElement td << fmap (docToHtml Nothing pkg qual) mdoc)
       : map (cell . (td <<)) subs
 
 
 -- | Sub table with source information (optional).
-subTableSrc :: Qualification -> LinksInfo -> Bool -> [(SubDecl,Located DocName)] -> Maybe Html
-subTableSrc _ _  _ [] = Nothing
-subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
+subTableSrc :: Maybe Package -> Qualification -> LinksInfo -> Bool
+            -> [(SubDecl,Located DocName)] -> Maybe Html
+subTableSrc _ _ _ _ [] = Nothing
+subTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
   where
     subRow ((decl, mdoc, subs),L loc dn) =
       (td ! [theclass "src clearfix"] <<
         (thespan ! [theclass "inst-left"] << decl)
         <+> linkHtml loc dn
       <->
-      docElement td << fmap (docToHtml Nothing qual) mdoc
+      docElement td << fmap (docToHtml Nothing pkg qual) mdoc
       )
       : map (cell . (td <<)) subs
     linkHtml loc@(RealSrcSpan _) dn = links lnks loc splice dn
@@ -170,49 +171,49 @@ subBlock [] = Nothing
 subBlock hs = Just $ toHtml hs
 
 
-subArguments :: Qualification -> [SubDecl] -> Html
-subArguments qual = divSubDecls "arguments" "Arguments" . subTable qual
+subArguments :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subArguments pkg qual = divSubDecls "arguments" "Arguments" . subTable pkg qual
 
 
 subAssociatedTypes :: [Html] -> Html
 subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock
 
 
-subConstructors :: Qualification -> [SubDecl] -> Html
-subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
+subConstructors :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subConstructors pkg qual = divSubDecls "constructors" "Constructors" . subTable pkg qual
 
-subPatterns :: Qualification -> [SubDecl] -> Html
-subPatterns qual = divSubDecls "bundled-patterns" "Bundled Patterns" . subTable qual
+subPatterns :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subPatterns pkg qual = divSubDecls "bundled-patterns" "Bundled Patterns" . subTable pkg qual
 
-subFields :: Qualification -> [SubDecl] -> Html
-subFields qual = divSubDecls "fields" "Fields" . subDlist qual
+subFields :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subFields pkg qual = divSubDecls "fields" "Fields" . subDlist pkg qual
 
 
-subEquations :: Qualification -> [SubDecl] -> Html
-subEquations qual = divSubDecls "equations" "Equations" . subTable qual
+subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subEquations pkg qual = divSubDecls "equations" "Equations" . subTable pkg qual
 
 
 -- | Generate sub table for instance declarations, with source
-subInstances :: Qualification
+subInstances :: Maybe Package -> Qualification
              -> String -- ^ Class name, used for anchor generation
              -> LinksInfo -> Bool
              -> [(SubDecl,Located DocName)] -> Html
-subInstances qual nm lnks splice = maybe noHtml wrap . instTable
+subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable
   where
     wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents))
-    instTable = subTableSrc qual lnks splice
+    instTable = subTableSrc pkg qual lnks splice
     subSection = thediv ! [theclass "subs instances"]
     summary = thesummary << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
 
 
-subOrphanInstances :: Qualification
+subOrphanInstances :: Maybe Package -> Qualification
                    -> LinksInfo -> Bool
                    -> [(SubDecl,Located DocName)] -> Html
-subOrphanInstances qual lnks splice  = maybe noHtml wrap . instTable
+subOrphanInstances pkg qual lnks splice  = maybe noHtml wrap . instTable
   where
     wrap = ((h1 << "Orphan instances") +++)
-    instTable = fmap (thediv ! [ identifier ("section." ++ id_) ] <<) . subTableSrc qual lnks splice
+    instTable = fmap (thediv ! [ identifier ("section." ++ id_) ] <<) . subTableSrc pkg qual lnks splice
     id_ = makeAnchorId $ "orphans"
 
 
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index deef7ad3..a35e2053 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -46,7 +46,6 @@ import Data.Traversable
 
 import Avail hiding (avail)
 import qualified Avail
-import qualified Packages
 import qualified Module
 import qualified SrcLoc
 import ConLike (ConLike(..))
@@ -55,13 +54,14 @@ import HscTypes
 import Name
 import NameSet
 import NameEnv
+import Packages   ( lookupModuleInAllPackages, PackageName(..) )
 import Bag
 import RdrName
 import TcRnTypes
-import FastString (concatFS)
+import FastString ( concatFS, unpackFS )
 import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
-import HsDecls ( getConDetails )
+import HsDecls    ( getConDetails )
 
 
 -- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -85,12 +85,22 @@ createInterface tm flags modMap instIfaceMap = do
       !instances     = modInfoInstances mi
       !fam_instances = md_fam_insts md
       !exportedNames = modInfoExportsWithSelectors mi
+      (pkgNameFS, _) = modulePackageInfo dflags flags mdl
+      pkgName        = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS
 
       (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) <-
@@ -103,7 +113,7 @@ createInterface tm flags modMap instIfaceMap = do
   opts <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl
 
   -- Process the top-level module header documentation.
-  (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader
+  (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags pkgName gre safety mayDocHeader
 
   let declsWithDocs = topDecls group_
 
@@ -130,13 +140,13 @@ createInterface tm flags modMap instIfaceMap = do
   warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)
 
   maps@(!docMap, !argMap, !declMap, _) <-
-    liftErrMsg (mkMaps dflags gre localInsts declsWithDocs)
+    liftErrMsg (mkMaps dflags pkgName gre localInsts declsWithDocs)
 
   let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
 
   -- The MAIN functionality: compute the export items which will
   -- each be the actual documentation of this module.
-  exportItems <- mkExportItems is_sig modMap mdl sem_mdl allWarnings gre
+  exportItems <- mkExportItems is_sig modMap pkgName mdl sem_mdl allWarnings gre
                    exportedNames decls maps fixMap unrestrictedImportedMods
                    splices exports all_exports instIfaceMap dflags
 
@@ -190,6 +200,7 @@ createInterface tm flags modMap instIfaceMap = do
   , ifaceTokenizedSrc      = tokenizedSrc
   }
 
+
 -- | 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
@@ -266,7 +277,7 @@ lookupModuleDyn ::
 lookupModuleDyn _ (Just pkgId) mdlName =
   Module.mkModule pkgId mdlName
 lookupModuleDyn dflags Nothing mdlName =
-  case Packages.lookupModuleInAllPackages dflags mdlName of
+  case lookupModuleInAllPackages dflags mdlName of
     (m,_):_ -> m
     [] -> Module.mkModule Module.mainUnitId mdlName
 
@@ -346,11 +357,12 @@ type Maps = (DocMap Name, ArgMap Name, DeclMap, InstMap)
 -- 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 gre instances decls = do
+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)
@@ -377,8 +389,8 @@ mkMaps dflags gre instances decls = do
           declDoc :: [HsDocString] -> Map Int HsDocString
                   -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
           declDoc strs m = do
-            doc' <- processDocStrings dflags gre strs
-            m'   <- traverse (processDocStringParas dflags gre) m
+            doc' <- processDocStrings dflags pkgName gre strs
+            m'   <- traverse (processDocStringParas dflags pkgName gre) m
             pure (doc', m')
 
       (doc, args) <- declDoc docStrs (typeDocs decl)
@@ -605,12 +617,13 @@ collectDocs = go Nothing []
 mkExportItems
   :: Bool               -- is it a signature
   -> IfaceMap
+  -> Maybe Package      -- this package
   -> Module             -- this module
   -> Module             -- semantic module
   -> WarningMap
   -> GlobalRdrEnv
   -> [Name]             -- exported names (orig)
-  -> [LHsDecl GhcRn]     -- renamed source declarations
+  -> [LHsDecl GhcRn]    -- renamed source declarations
   -> Maps
   -> FixMap
   -> M.Map ModuleName [ModuleName]
@@ -621,12 +634,12 @@ mkExportItems
   -> DynFlags
   -> ErrMsgGhc [ExportItem GhcRn]
 mkExportItems
-  is_sig modMap thisMod semMod warnings gre exportedNames decls
+  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 thisMod semMod warnings gre
+      fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre
         exportedNames decls maps fixMap splices instIfaceMap dflags
         allExports
     Just exports -> liftM concat $ mapM lookupExport exports
@@ -636,14 +649,14 @@ mkExportItems
       return [ExportGroup lev "" doc]
 
     lookupExport (IEDoc docStr, _)        = liftErrMsg $ do
-      doc <- processDocStringParas dflags gre docStr
+      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 gre docStr
+          doc <- processDocStringParas dflags pkgName gre docStr
           return [ExportDoc doc]
 
     lookupExport (IEModuleContents (L _ mod_name), _)
@@ -962,6 +975,7 @@ moduleExport thisMod dflags ifaceMap instIfaceMap expMod =
 
 fullModuleContents :: Bool               -- is it a signature
                    -> IfaceMap
+                   -> Maybe Package      -- this package
                    -> Module             -- this module
                    -> Module             -- semantic module
                    -> WarningMap
@@ -975,7 +989,7 @@ fullModuleContents :: Bool               -- is it a signature
                    -> DynFlags
                    -> Avails
                    -> ErrMsgGhc [ExportItem GhcRn]
-fullModuleContents is_sig modMap thisMod semMod warnings gre exportedNames
+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
@@ -984,7 +998,7 @@ fullModuleContents is_sig modMap thisMod semMod warnings gre exportedNames
         doc <- liftErrMsg (processDocString dflags gre docStr)
         return [[ExportGroup lev "" doc]]
       (L _ (DocD (DocCommentNamed _ docStr))) -> do
-        doc <- liftErrMsg (processDocStringParas dflags gre docStr)
+        doc <- liftErrMsg (processDocStringParas dflags pkgName gre docStr)
         return [[ExportDoc doc]]
       (L _ (ValD valDecl))
         | name:_ <- collectHsBindBinders valDecl
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 1269df3f..9a978f9f 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -33,34 +33,35 @@ import RdrName
 import EnumSet
 import RnEnv (dataTcOccs)
 
-processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString]
+processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]
                   -> ErrMsgM (Maybe (MDoc Name))
-processDocStrings dflags gre strs = do
-  mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags gre) strs
+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 { _version = Nothing }, _doc = DocEmpty } -> pure Nothing
+    MetaDoc { _meta = Meta Nothing Nothing, _doc = DocEmpty } -> pure Nothing
     x -> pure (Just x)
 
-processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name)
-processDocStringParas dflags gre (HsDocString fs) =
-  overDocF (rename dflags gre) $ parseParas dflags (unpackFS fs)
+processDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString
+                      -> ErrMsgM (MDoc Name)
+processDocStringParas dflags pkg gre (HsDocString fs) =
+  overDocF (rename dflags gre) $ parseParas dflags pkg (unpackFS fs)
 
 processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
 processDocString dflags gre (HsDocString fs) =
   rename dflags gre $ parseString dflags (unpackFS fs)
 
-processModuleHeader :: DynFlags -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
+processModuleHeader :: DynFlags -> Maybe Package -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
                     -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
-processModuleHeader dflags gre safety mayStr = do
+processModuleHeader dflags pkgName gre safety mayStr = do
   (hmi, doc) <-
     case mayStr of
       Nothing -> return failure
       Just (L _ (HsDocString fs)) -> do
         let str = unpackFS fs
-            (hmi, doc) = parseModuleHeader dflags str
+            (hmi, doc) = parseModuleHeader dflags pkgName str
         !descr <- case hmi_description hmi of
                     Just hmi_descr -> Just <$> rename dflags gre hmi_descr
                     Nothing        -> pure Nothing
diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
index 6690c22d..050901b6 100644
--- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs
@@ -24,8 +24,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 -> String -> (HaddockModInfo RdrName, MDoc RdrName)
-parseModuleHeader dflags str0 =
+parseModuleHeader :: DynFlags -> Maybe Package -> String -> (HaddockModInfo RdrName, MDoc RdrName)
+parseModuleHeader dflags pkgName str0 =
    let
       getKey :: String -> String -> (Maybe String,String)
       getKey key str = case parseKey key str of
@@ -52,7 +52,7 @@ parseModuleHeader dflags str0 =
           hmi_safety = Nothing,
           hmi_language = Nothing, -- set in LexParseRn
           hmi_extensions = [] -- also set in LexParseRn
-          }, parseParas dflags str9)
+          }, parseParas dflags pkgName str9)
 
 -- | This function is how we read keys.
 --
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index bbd8d04e..d5bbce2c 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -83,7 +83,7 @@ binaryInterfaceMagic = 0xD0Cface
 --
 binaryInterfaceVersion :: Word16
 #if (__GLASGOW_HASKELL__ >= 803) && (__GLASGOW_HASKELL__ < 805)
-binaryInterfaceVersion = 32
+binaryInterfaceVersion = 33
 
 binaryInterfaceVersionCompatibility :: [Word16]
 binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
@@ -486,8 +486,13 @@ instance Binary a => Binary (TableCell a) where
         return (TableCell i j c)
 
 instance Binary Meta where
-  put_ bh Meta { _version = v } = put_ bh v
-  get bh = (\v -> Meta { _version = v }) <$> get bh
+    put_ bh (Meta v p) = do
+        put_ bh v
+        put_ bh p
+    get bh = do
+        v <- get bh
+        p <- get bh
+        return (Meta v p)
 
 instance (Binary mod, Binary id) => Binary (MetaDoc mod id) where
   put_ bh MetaDoc { _meta = m, _doc = d } = do
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index 0609aa63..b5e987d8 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -29,19 +29,23 @@ module Haddock.Options (
   optLaTeXStyle,
   optMathjax,
   qualification,
+  sinceQualification,
   verbosity,
   ghcFlags,
   reexportFlags,
   readIfaceArgs,
   optPackageName,
-  optPackageVersion
+  optPackageVersion,
+  modulePackageInfo
 ) where
 
 
 import qualified Data.Char as Char
 import           Data.Version
+import           Control.Applicative
 import           Distribution.Verbosity
 import           FastString
+import           GHC ( DynFlags, Module, moduleUnitId )
 import           Haddock.Types
 import           Haddock.Utils
 import           Packages
@@ -103,6 +107,7 @@ data Flag
   | Flag_PackageName String
   | Flag_PackageVersion String
   | Flag_Reexport String
+  | Flag_SinceQualification String
   deriving (Eq, Show)
 
 
@@ -210,7 +215,9 @@ options backwardsCompat =
     Option [] ["package-name"] (ReqArg Flag_PackageName "NAME")
       "name of the package being documented",
     Option [] ["package-version"] (ReqArg Flag_PackageVersion "VERSION")
-      "version of the package being documented in usual x.y.z.w format"
+      "version of the package being documented in usual x.y.z.w format",
+    Option []  ["since-qual"] (ReqArg Flag_SinceQualification "QUAL")
+      "package qualification of @since, one of\n'always' (default) or 'only-external'"
   ]
 
 
@@ -310,6 +317,14 @@ qualification flags =
       [arg]          -> Left $ "unknown qualification type " ++ show arg
       _:_            -> Left "qualification option given multiple times"
 
+sinceQualification :: [Flag] -> Either String SinceQual
+sinceQualification flags =
+  case map (map Char.toLower) [ str | Flag_SinceQualification str <- flags ] of
+      []             -> Right Always
+      ["always"]     -> Right Always
+      ["external"]   -> Right External
+      [arg]          -> Left $ "unknown since-qualification type " ++ show arg
+      _:_            -> Left "since-qualification option given multiple times"
 
 verbosity :: [Flag] -> Verbosity
 verbosity flags =
@@ -344,3 +359,23 @@ readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ]
 optLast :: [a] -> Maybe a
 optLast [] = Nothing
 optLast xs = Just (last xs)
+
+
+-- | This function has a potential to return 'Nothing' because package name and
+-- versions can no longer reliably be extracted in all cases: if the package is
+-- not installed yet then this info is no longer available.
+--
+-- The @--package-name@ and @--package-version@ Haddock flags allow the user to
+-- specify this information manually and it is returned here if present.
+modulePackageInfo :: DynFlags
+                  -> [Flag] -- ^ Haddock flags are checked as they may contain
+                            -- the package name or version provided by the user
+                            -- which we prioritise
+                  -> Module
+                  -> (Maybe PackageName, Maybe Data.Version.Version)
+modulePackageInfo dflags flags modu =
+  ( optPackageName flags    <|> fmap packageName pkgDb
+  , optPackageVersion flags <|> fmap packageVersion pkgDb
+  )
+  where
+    pkgDb = lookupPackage dflags (moduleUnitId modu)
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
index 47bf814b..58500f1b 100644
--- a/haddock-api/src/Haddock/Parser.hs
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -28,8 +28,8 @@ import RdrName (RdrName)
 import SrcLoc (mkRealSrcLoc, unLoc)
 import StringBuffer (stringToStringBuffer)
 
-parseParas :: DynFlags -> String -> MetaDoc mod RdrName
-parseParas d = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas
+parseParas :: DynFlags -> Maybe Package -> String -> MetaDoc mod RdrName
+parseParas d p = overDoc (P.overIdentifier (parseIdent d)) . P.parseParas p
 
 parseString :: DynFlags -> String -> DocH mod RdrName
 parseString d = P.overIdentifier (parseIdent d) . P.parseString
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 2810862f..36ed7baf 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -578,6 +578,12 @@ data HideEmptyContexts
   = HideEmptyContexts
   | ShowEmptyToplevelContexts
 
+-- | When to qualify @since@ annotations with their package
+data SinceQual
+  = Always
+  | External -- ^ only qualify when the thing being annotated is from
+             -- an external package
+
 -----------------------------------------------------------------------------
 -- * Error handling
 -----------------------------------------------------------------------------
diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs
index 282fd10d..a4e4321f 100644
--- a/haddock-library/fixtures/Fixtures.hs
+++ b/haddock-library/fixtures/Fixtures.hs
@@ -102,7 +102,7 @@ acceptFixtures = traverse_ $ \(Fixture i o) -> do
     writeFile o actual
 
 parseString :: String -> Doc String
-parseString = Parse.toRegular . _doc . Parse.parseParas
+parseString = Parse.toRegular . _doc . Parse.parseParas Nothing
 
 data Cmd = CmdRun | CmdAccept | CmdList
 
diff --git a/haddock-library/src/Documentation/Haddock/Doc.hs b/haddock-library/src/Documentation/Haddock/Doc.hs
index 66bd1c97..297d30d6 100644
--- a/haddock-library/src/Documentation/Haddock/Doc.hs
+++ b/haddock-library/src/Documentation/Haddock/Doc.hs
@@ -27,16 +27,16 @@ metaDocAppend (MetaDoc { _meta = m, _doc = d })
               (MetaDoc { _meta = m', _doc = d' }) =
   MetaDoc { _meta = m' `metaAppend` m, _doc = d `docAppend` d' }
 
--- | This is not a monoidal append, it uses '<|>' for the '_version'.
+-- | This is not a monoidal append, it uses '<|>' for the '_version' and
+-- '_package'.
 metaAppend :: Meta -> Meta -> Meta
-metaAppend (Meta { _version = v }) (Meta { _version = v' }) =
-  Meta { _version = v <|> v' }
+metaAppend (Meta v1 p1) (Meta v2 p2) = Meta (v1 <|> v2) (p1 <|> p2)
 
 emptyMetaDoc :: MetaDoc mod id
 emptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty }
 
 emptyMeta :: Meta
-emptyMeta = Meta { _version = empty }
+emptyMeta = Meta empty empty
 
 docAppend :: DocH mod id -> DocH mod id -> DocH mod id
 docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2)
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 6cbc3922..4921b3a7 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -116,10 +116,13 @@ parse p = either err id . parseOnly (p <* endOfInput)
 
 -- | Main entry point to the parser. Appends the newline character
 -- to the input string.
-parseParas :: String -- ^ String to parse
+parseParas :: Maybe Package
+           -> String -- ^ String to parse
            -> MetaDoc mod Identifier
-parseParas input = case parseParasState input of
-  (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state }
+parseParas pkg input = case parseParasState input of
+  (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state
+                                       , _package = pkg
+                                       }
                         , _doc = a
                         }
 
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 209f26e8..005ec186 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -34,7 +34,9 @@ import Data.Bitraversable
 -- meta-data to comments. We make a structure for this ahead of time
 -- so we don't have to gut half the core each time we want to add such
 -- info.
-newtype Meta = Meta { _version :: Maybe Version } deriving (Eq, Show)
+data Meta = Meta { _version :: Maybe Version
+                 , _package :: Maybe Package
+                 } deriving (Eq, Show)
 
 data MetaDoc mod id =
   MetaDoc { _meta :: Meta
@@ -61,6 +63,7 @@ overDocF :: Functor f => (DocH a b -> f (DocH c d)) -> MetaDoc a b -> f (MetaDoc
 overDocF f d = (\x -> d { _doc = x }) <$> f (_doc d)
 
 type Version = [Int]
+type Package = String
 
 data Hyperlink = Hyperlink
   { hyperlinkUrl   :: String
diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
index c605e2c2..86ed3b35 100644
--- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs
+++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
@@ -24,8 +24,15 @@ instance IsString (Doc String) where
 instance IsString a => IsString (Maybe a) where
   fromString = Just . fromString
 
+emptyMeta :: Meta
+emptyMeta =
+  Meta {
+    _version = Nothing
+  , _package = Nothing
+  }
+
 parseParas :: String -> MetaDoc () String
-parseParas = overDoc Parse.toRegular . Parse.parseParas
+parseParas = overDoc Parse.toRegular . Parse.parseParas Nothing
 
 parseString :: String -> Doc String
 parseString = Parse.toRegular . Parse.parseString
@@ -375,17 +382,17 @@ spec = do
     context "when parsing @since" $ do
       it "adds specified version to the result" $ do
         parseParas "@since 0.5.0" `shouldBe`
-          MetaDoc { _meta = Meta { _version = Just [0,5,0] }
+          MetaDoc { _meta = emptyMeta { _version = Just [0,5,0] }
                   , _doc = DocEmpty }
 
       it "ignores trailing whitespace" $ do
         parseParas "@since 0.5.0 \t " `shouldBe`
-          MetaDoc { _meta = Meta { _version = Just [0,5,0] }
+          MetaDoc { _meta = emptyMeta { _version = Just [0,5,0] }
                   , _doc = DocEmpty }
 
       it "does not allow trailing input" $ do
         parseParas "@since 0.5.0 foo" `shouldBe`
-          MetaDoc { _meta = Meta { _version = Nothing }
+          MetaDoc { _meta = emptyMeta { _version = Nothing }
                   , _doc = DocParagraph "@since 0.5.0 foo" }
 
 
@@ -395,7 +402,7 @@ spec = do
               "@since 0.5.0"
             , "@since 0.6.0"
             , "@since 0.7.0"
-            ] `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,7,0] }
+            ] `shouldBe` MetaDoc { _meta = emptyMeta { _version = Just [0,7,0] }
                                  , _doc = DocEmpty }
 
 
-- 
cgit v1.2.3


From 7064cd54e016b2f8e0a8c2ba8d3dd5edea9071ca Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Tue, 27 Mar 2018 08:42:50 +0200
Subject: haddock-2.19.1, haddock-api-2.19.1, haddock-library-1.6.0

---
 CHANGES.md                            | 4 +++-
 haddock-api/haddock-api.cabal         | 4 ++--
 haddock-library/CHANGES.md            | 4 ++++
 haddock-library/haddock-library.cabal | 2 +-
 4 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 7bb439af..fa59b9d7 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,7 +1,9 @@
-## Changes in version 2.20.x.x
+## Changes in version 2.19.1
 
  * Show where instances are defined (#748)
 
+ * `@since` includes package name (#452, #550, #749)
+
 ## Changes in version 2.19.0.1
 
  * Support for linking unicode operators (#458)
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 8d9db877..da5d6f66 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -1,6 +1,6 @@
 cabal-version:        2.0
 name:                 haddock-api
-version:              2.19.0.1
+version:              2.19.1
 synopsis:             A documentation-generation tool for Haskell libraries
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries
@@ -44,7 +44,7 @@ library
                , Cabal           ^>= 2.2.0
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
-               , haddock-library ^>= 1.5.0.1
+               , haddock-library ^>= 1.6.0
                , xhtml           ^>= 3000.2.2
 
   -- Versions for the dependencies below are transitively pinned by
diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md
index 1f44f5bf..e41b8087 100644
--- a/haddock-library/CHANGES.md
+++ b/haddock-library/CHANGES.md
@@ -1,3 +1,7 @@
+## Changes in version 1.6.0
+
+ * `MetaDoc` stores package name for since annotations
+
 ## Changes in version 1.5.0.1
 
  * Support for parsing unicode operators (#458)
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index 5e4b42f6..deeaa98d 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -1,6 +1,6 @@
 cabal-version:        2.0
 name:                 haddock-library
-version:              1.5.0.1
+version:              1.6.0
 synopsis:             Library exposing some functionality of Haddock.
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries. These modules expose some functionality of it
-- 
cgit v1.2.3


From 37e93411ef8ee673eebd6c56b8db3f2e851572c9 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Wed, 28 Mar 2018 10:15:16 +0200
Subject: Bump haddock and haddock-api to 2.20.0

---
 haddock-api/haddock-api.cabal | 2 +-
 haddock.cabal                 | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index da5d6f66..f5803e09 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -1,6 +1,6 @@
 cabal-version:        2.0
 name:                 haddock-api
-version:              2.19.1
+version:              2.20.0
 synopsis:             A documentation-generation tool for Haskell libraries
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries
diff --git a/haddock.cabal b/haddock.cabal
index 3f6e76c4..7ae252c2 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -1,6 +1,6 @@
 cabal-version:        2.0
 name:                 haddock
-version:              2.19.0.1
+version:              2.20.0
 synopsis:             A documentation-generation tool for Haskell libraries
 description:
   This is Haddock, a tool for automatically generating documentation
@@ -153,7 +153,7 @@ executable haddock
   else
     -- in order for haddock's advertised version number to have proper meaning,
     -- we pin down to a single haddock-api version.
-    build-depends:  haddock-api == 2.19.0.1
+    build-depends:  haddock-api == 2.20.0
 
     other-modules:
       ResponseFile
-- 
cgit v1.2.3


From 59812a09eb69cbf12407206381f4c214987b1efd Mon Sep 17 00:00:00 2001
From: Jack Henahan 
Date: Tue, 3 Apr 2018 07:28:12 -0400
Subject: Clear search string on hide for #781 (#789)

---
 haddock-api/resources/html/haddock-bundle.min.js | 2 +-
 haddock-api/resources/html/js-src/quick-jump.tsx | 4 ++--
 haddock-api/resources/html/quick-jump.min.js     | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/haddock-api/resources/html/haddock-bundle.min.js b/haddock-api/resources/html/haddock-bundle.min.js
index 8bf397c7..1061714b 100644
--- a/haddock-api/resources/html/haddock-bundle.min.js
+++ b/haddock-api/resources/html/haddock-bundle.min.js
@@ -1,2 +1,2 @@
-!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s element with id '"+e+"'");return t}function r(e){for(var t=e.target,n=t.id,r=o(n),i=r.element.open,s=0,l=r.toggles;s0&&(d[n.id]={element:n,openByDefault:!!n.open,toggles:[]},n.addEventListener("toggle",r))}}function s(e){var t=o(e).element;t.open=!t.open}function a(){var e=Object.keys(p);document.cookie="toggled="+encodeURIComponent(e.join("+"))}function l(){var e=h.getCookie("toggled");if(e)for(var t=0,n=e.split("+");t=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.top=0}function s(e,t){var n=o(e.className||"");n.indexOf(" "+t+" ")<0&&(e.className=r(n+" "+t))}function a(e,t){var n=o(e.className||"");n=n.replace(" "+t+" "," "),e.className=r(n)}function l(e,t,n,o){return null==o&&(o=!i(e,t)),o?(a(e,n),s(e,t)):(a(e,t),s(e,n)),o}function c(e){var t=document.getElementById("page-menu");if(t&&t.firstChild){var n=t.firstChild.cloneNode(!1);n.innerHTML=e,t.appendChild(n)}}function u(){return Array.prototype.slice.call(document.getElementsByTagName("link")).filter(function(e){return-1!=e.rel.indexOf("style")&&e.title})}function h(){var e=u(),t="";e.forEach(function(e){t+="
    • "+e.title+"
      • "}),e.length>1&&c("")}function d(e){for(var t=u(),n=null,o=0;on)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=E;P-=1){var R=P-1,U=n[e.charAt(R)];if(U&&(b[R]=1),j[P]=(j[P+1]<<1|1)&U,0!==I&&(j[P]|=(L[P+1]|L[P])<<1|1|L[P+1]),j[P]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:g,distance:c}))<=y){if(y=C,(_=R)<=g)break;E=Math.max(1,2*g-_)}}if(o(t,{errors:I+1,currentLocation:g,expectedLocation:g,distance:c})>y)break;L=j}return{isMatch:_>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");p=p.name}else a[p]={weight:1};this._analyze({key:p,value:this.options.getFn(u,p),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,d=void 0===h?[]:h,p=t.resultMap,f=void 0===p?{}:p,v=t.results,g=void 0===v?[]:v;if(void 0!==i&&null!==i){var m=!1,y=-1,_=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=d.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(E=(E+y)/2),this._log("Score average:",E);var T=!this.options.tokenize||!this.options.matchAllTokens||_>=u.length;if(this._log("\nCheck Matches: "+T),(m||k.isMatch)&&T){var j=f[l];j?j.output.push({key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}]},g.push(f[l]))}}else if(a(i))for(var P=0,R=i.length;P-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===O?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==j.push(e)&&(I.debounceRendering||E)(i)}function i(){var e,t=j;for(j=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===T.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,p,s):e.removeEventListener(t,p,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)d(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function d(e,t,n){try{e[t]=n}catch(e){}}function p(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=P.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=g(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function g(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0)}var u=i.firstChild,h=i.__preactattr_,d=t.children;if(null==h){h=i.__preactattr_={};for(var p=i.attributes,f=p.length;f--;)h[p[f].name]=p[f].value}return!D&&d&&1===d.length&&"string"==typeof d[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=d[0]&&(u.nodeValue=d[0]):(d&&d.length||null!=u)&&m(i,d,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function m(e,t,n,o,r){var i,a,l,c,h,d=e.childNodes,p=[],f={},v=0,m=0,_=d.length,k=0,b=t?t.length:0;if(0!==_)for(L=0;L<_;L++){var x=d[L],w=x.__preactattr_;null!=(S=b&&w?x._component?x._component.__k:w.key:null)?(v++,f[S]=x):(w||(void 0!==x.splitText?!r||x.nodeValue.trim():r))&&(p[k++]=x)}if(0!==b)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[3]);
+!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s element with id '"+e+"'");return t}function r(e){for(var t=e.target,n=t.id,r=o(n),i=r.element.open,s=0,l=r.toggles;s0&&(d[n.id]={element:n,openByDefault:!!n.open,toggles:[]},n.addEventListener("toggle",r))}}function s(e){var t=o(e).element;t.open=!t.open}function a(){var e=Object.keys(p);document.cookie="toggled="+encodeURIComponent(e.join("+"))}function l(){var e=h.getCookie("toggled");if(e)for(var t=0,n=e.split("+");t=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1,searchString:""})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.top=0}function s(e,t){var n=o(e.className||"");n.indexOf(" "+t+" ")<0&&(e.className=r(n+" "+t))}function a(e,t){var n=o(e.className||"");n=n.replace(" "+t+" "," "),e.className=r(n)}function l(e,t,n,o){return null==o&&(o=!i(e,t)),o?(a(e,n),s(e,t)):(a(e,t),s(e,n)),o}function c(e){var t=document.getElementById("page-menu");if(t&&t.firstChild){var n=t.firstChild.cloneNode(!1);n.innerHTML=e,t.appendChild(n)}}function u(){return Array.prototype.slice.call(document.getElementsByTagName("link")).filter(function(e){return-1!=e.rel.indexOf("style")&&e.title})}function h(){var e=u(),t="";e.forEach(function(e){t+="
    • "+e.title+"
      • "}),e.length>1&&c("")}function d(e){for(var t=u(),n=null,o=0;on)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=E;P-=1){var R=P-1,U=n[e.charAt(R)];if(U&&(b[R]=1),j[P]=(j[P+1]<<1|1)&U,0!==I&&(j[P]|=(L[P+1]|L[P])<<1|1|L[P+1]),j[P]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:g,distance:c}))<=y){if(y=C,(_=R)<=g)break;E=Math.max(1,2*g-_)}}if(o(t,{errors:I+1,currentLocation:g,expectedLocation:g,distance:c})>y)break;L=j}return{isMatch:_>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");p=p.name}else a[p]={weight:1};this._analyze({key:p,value:this.options.getFn(u,p),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,d=void 0===h?[]:h,p=t.resultMap,f=void 0===p?{}:p,v=t.results,g=void 0===v?[]:v;if(void 0!==i&&null!==i){var m=!1,y=-1,_=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=d.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(E=(E+y)/2),this._log("Score average:",E);var T=!this.options.tokenize||!this.options.matchAllTokens||_>=u.length;if(this._log("\nCheck Matches: "+T),(m||k.isMatch)&&T){var j=f[l];j?j.output.push({key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:E,matchedIndices:k.matchedIndices}]},g.push(f[l]))}}else if(a(i))for(var P=0,R=i.length;P-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===O?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==j.push(e)&&(I.debounceRendering||E)(i)}function i(){var e,t=j;for(j=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===T.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,p,s):e.removeEventListener(t,p,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)d(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function d(e,t,n){try{e[t]=n}catch(e){}}function p(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=P.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=g(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function g(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),y(e,!0)}var u=i.firstChild,h=i.__preactattr_,d=t.children;if(null==h){h=i.__preactattr_={};for(var p=i.attributes,f=p.length;f--;)h[p[f].name]=p[f].value}return!D&&d&&1===d.length&&"string"==typeof d[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=d[0]&&(u.nodeValue=d[0]):(d&&d.length||null!=u)&&m(i,d,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function m(e,t,n,o,r){var i,a,l,c,h,d=e.childNodes,p=[],f={},v=0,m=0,_=d.length,k=0,b=t?t.length:0;if(0!==_)for(L=0;L<_;L++){var x=d[L],w=x.__preactattr_;null!=(S=b&&w?x._component?x._component.__k:w.key:null)?(v++,f[S]=x):(w||(void 0!==x.splitText?!r||x.nodeValue.trim():r))&&(p[k++]=x)}if(0!==b)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[3]);
 //# sourceMappingURL=haddock-bundle.min.js.map
diff --git a/haddock-api/resources/html/js-src/quick-jump.tsx b/haddock-api/resources/html/js-src/quick-jump.tsx
index 12270372..e64dae0b 100644
--- a/haddock-api/resources/html/js-src/quick-jump.tsx
+++ b/haddock-api/resources/html/js-src/quick-jump.tsx
@@ -151,7 +151,7 @@ class QuickJump extends Component {
   }
 
   hide() {
-    this.setState({ isVisible: false });
+    this.setState({ isVisible: false, searchString: '' });
   }
 
   show() {
@@ -417,4 +417,4 @@ export function init(docBaseUrl?: string, showHide?: (action: () => void) => voi
 }
 
 // export to global object
-(window as any).quickNav = { init: init };
\ No newline at end of file
+(window as any).quickNav = { init: init };
diff --git a/haddock-api/resources/html/quick-jump.min.js b/haddock-api/resources/html/quick-jump.min.js
index bfdf04a3..c03e0836 100644
--- a/haddock-api/resources/html/quick-jump.min.js
+++ b/haddock-api/resources/html/quick-jump.min.js
@@ -1,2 +1,2 @@
-!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.topn)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=O;E-=1){var R=E-1,U=n[e.charAt(R)];if(U&&(b[R]=1),P[E]=(P[E+1]<<1|1)&U,0!==I&&(P[E]|=(L[E+1]|L[E])<<1|1|L[E+1]),P[E]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:_,distance:c}))<=m){if(m=C,(y=R)<=_)break;O=Math.max(1,2*_-y)}}if(o(t,{errors:I+1,currentLocation:_,expectedLocation:_,distance:c})>m)break;L=P}return{isMatch:y>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");d=d.name}else a[d]={weight:1};this._analyze({key:d,value:this.options.getFn(u,d),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,p=void 0===h?[]:h,d=t.resultMap,f=void 0===d?{}:d,v=t.results,_=void 0===v?[]:v;if(void 0!==i&&null!==i){var g=!1,m=-1,y=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=p.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(O=(O+m)/2),this._log("Score average:",O);var j=!this.options.tokenize||!this.options.matchAllTokens||y>=u.length;if(this._log("\nCheck Matches: "+j),(g||k.isMatch)&&j){var P=f[l];P?P.output.push({key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}]},_.push(f[l]))}}else if(a(i))for(var E=0,R=i.length;E-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===T?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==P.push(e)&&(I.debounceRendering||O)(i)}function i(){var e,t=P;for(P=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===j.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,d,s):e.removeEventListener(t,d,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)p(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function p(e,t,n){try{e[t]=n}catch(e){}}function d(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=E.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=_(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function _(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0)}var u=i.firstChild,h=i.__preactattr_,p=t.children;if(null==h){h=i.__preactattr_={};for(var d=i.attributes,f=d.length;f--;)h[d[f].name]=d[f].value}return!D&&p&&1===p.length&&"string"==typeof p[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=p[0]&&(u.nodeValue=p[0]):(p&&p.length||null!=u)&&g(i,p,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function g(e,t,n,o,r){var i,a,l,c,h,p=e.childNodes,d=[],f={},v=0,g=0,y=p.length,k=0,b=t?t.length:0;if(0!==y)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[1]);
+!function e(t,n,o){function r(s,a){if(!n[s]){if(!t[s]){var l="function"==typeof require&&require;if(!a&&l)return l(s,!0);if(i)return i(s,!0);var c=new Error("Cannot find module '"+s+"'");throw c.code="MODULE_NOT_FOUND",c}var u=n[s]={exports:{}};t[s][0].call(u.exports,function(e){var n=t[s][1][e];return r(n||e)},u,u.exports,e,t,n,o)}return n[s].exports}for(var i="function"==typeof require&&require,s=0;s=0&&e.followActiveLink()),"s"===t.key&&"input"!==t.target.tagName.toLowerCase()&&(t.preventDefault(),e.show())})},t.prototype.hide=function(){this.setState({isVisible:!1,searchString:""})},t.prototype.show=function(){this.state.isVisible||(this.focusPlease=!0,this.setState({isVisible:!0,activeLinkIndex:-1}))},t.prototype.toggleVisibility=function(){this.state.isVisible?this.hide():this.show()},t.prototype.navigateLinks=function(e){var t=Math.max(-1,Math.min(this.linkIndex-1,this.state.activeLinkIndex+e));this.navigatedByKeyboard=!0,this.setState({activeLinkIndex:t})},t.prototype.followActiveLink=function(){this.activeLinkAction&&this.activeLinkAction()},t.prototype.updateResults=function(){var e=this.input&&this.input.value||"",t={};this.state.fuse.search(e).forEach(function(e){var n=e.item.module;(t[n]||(t[n]=[])).push(e)});var n=[];for(var o in t)!function(e){var o=t[e],r=0;o.forEach(function(e){r+=1/e.score}),n.push({module:e,totalScore:1/r,items:o})}(o);n.sort(function(e,t){return e.totalScore-t.totalScore}),this.setState({searchString:e,isVisible:!0,moduleResults:n})},t.prototype.componentDidUpdate=function(){if(this.searchResults&&this.activeLink&&this.navigatedByKeyboard){var e=this.activeLink.getClientRects()[0],t=this.searchResults.getClientRects()[0].top;e.bottom>window.innerHeight?this.searchResults.scrollTop+=e.bottom-window.innerHeight+80:e.topn)return i(e,this.pattern,o);var r=this.options,a=r.location,l=r.distance,c=r.threshold,u=r.findAllMatches,h=r.minMatchCharLength;return s(e,this.pattern,this.patternAlphabet,{location:a,distance:l,threshold:c,findAllMatches:u,minMatchCharLength:h})}}]),e}();e.exports=l},function(e,t,n){"use strict";var o=n(0),r=function e(t,n,r){if(n){var i=n.indexOf("."),s=n,a=null;-1!==i&&(s=n.slice(0,i),a=n.slice(i+1));var l=t[s];if(null!==l&&void 0!==l)if(a||"string"!=typeof l&&"number"!=typeof l)if(o(l))for(var c=0,u=l.length;c0&&void 0!==arguments[0]?arguments[0]:[],t=arguments.length>1&&void 0!==arguments[1]?arguments[1]:1,n=[],o=-1,r=-1,i=0,s=e.length;i=t&&n.push([o,r]),o=-1)}return e[i-1]&&i-o>=t&&n.push([o,i-1]),n}},function(e,t,n){"use strict";e.exports=function(e){for(var t={},n=e.length,o=0;o2&&void 0!==arguments[2]?arguments[2]:/ +/g,r=new RegExp(t.replace(o,"\\$&").replace(n,"|")),i=e.match(r),s=!!i,a=[];if(s)for(var l=0,c=i.length;l=O;E-=1){var R=E-1,U=n[e.charAt(R)];if(U&&(b[R]=1),P[E]=(P[E+1]<<1|1)&U,0!==I&&(P[E]|=(L[E+1]|L[E])<<1|1|L[E+1]),P[E]&N&&(C=o(t,{errors:I,currentLocation:R,expectedLocation:_,distance:c}))<=m){if(m=C,(y=R)<=_)break;O=Math.max(1,2*_-y)}}if(o(t,{errors:I+1,currentLocation:_,expectedLocation:_,distance:c})>m)break;L=P}return{isMatch:y>=0,score:0===C?.001:C,matchedIndices:r(b,v)}}},function(e,t,n){"use strict";function o(e,t){if(!(e instanceof t))throw new TypeError("Cannot call a class as a function")}var r=function(){function e(e,t){for(var n=0;n0&&void 0!==arguments[0]?arguments[0]:"",t=[];if(this.options.tokenize)for(var n=e.split(this.options.tokenSeparator),o=0,r=n.length;o0&&void 0!==arguments[0]?arguments[0]:[],t=arguments[1],n=this.list,o={},r=[];if("string"==typeof n[0]){for(var i=0,s=n.length;i1)throw new Error("Key weight has to be > 0 and <= 1");d=d.name}else a[d]={weight:1};this._analyze({key:d,value:this.options.getFn(u,d),record:u,index:l},{resultMap:o,results:r,tokenSearchers:e,fullSearcher:t})}return{weights:a,results:r}}},{key:"_analyze",value:function(e,t){var n=e.key,o=e.arrayIndex,r=void 0===o?-1:o,i=e.value,s=e.record,l=e.index,c=t.tokenSearchers,u=void 0===c?[]:c,h=t.fullSearcher,p=void 0===h?[]:h,d=t.resultMap,f=void 0===d?{}:d,v=t.results,_=void 0===v?[]:v;if(void 0!==i&&null!==i){var g=!1,m=-1,y=0;if("string"==typeof i){this._log("\nKey: "+(""===n?"-":n));var k=p.search(i);if(this._log('Full text: "'+i+'", score: '+k.score),this.options.tokenize){for(var b=i.split(this.options.tokenSeparator),x=[],w=0;w-1&&(O=(O+m)/2),this._log("Score average:",O);var j=!this.options.tokenize||!this.options.matchAllTokens||y>=u.length;if(this._log("\nCheck Matches: "+j),(g||k.isMatch)&&j){var P=f[l];P?P.output.push({key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}):(f[l]={item:s,output:[{key:n,arrayIndex:r,value:i,score:O,matchedIndices:k.matchedIndices}]},_.push(f[l]))}}else if(a(i))for(var E=0,R=i.length;E-1&&(s.arrayIndex=i.arrayIndex),t.matches.push(s)}}}),this.options.includeScore&&n.push(function(e,t){t.score=e.score});for(var o=0,r=e.length;o2;)A.push(arguments[s]);for(n&&null!=n.children&&(A.length||A.push(n.children),delete n.children);A.length;)if((r=A.pop())&&void 0!==r.pop)for(s=r.length;s--;)A.push(r[s]);else"boolean"==typeof r&&(r=null),(i="function"!=typeof t)&&(null==r?r="":"number"==typeof r?r=String(r):"string"!=typeof r&&(i=!1)),i&&o?a[a.length-1]+=r:a===T?a=[r]:a.push(r),o=i;var l=new e;return l.nodeName=t,l.children=a,l.attributes=null==n?void 0:n,l.key=null==n?void 0:n.key,void 0!==I.vnode&&I.vnode(l),l}function o(e,t){for(var n in t)e[n]=t[n];return e}function r(e){!e.__d&&(e.__d=!0)&&1==P.push(e)&&(I.debounceRendering||O)(i)}function i(){var e,t=P;for(P=[];e=t.pop();)e.__d&&L(e)}function s(e,t,n){return"string"==typeof t||"number"==typeof t?void 0!==e.splitText:"string"==typeof t.nodeName?!e._componentConstructor&&a(e,t.nodeName):n||e._componentConstructor===t.nodeName}function a(e,t){return e.__n===t||e.nodeName.toLowerCase()===t.toLowerCase()}function l(e){var t=o({},e.attributes);t.children=e.children;var n=e.nodeName.defaultProps;if(void 0!==n)for(var r in n)void 0===t[r]&&(t[r]=n[r]);return t}function c(e,t){var n=t?document.createElementNS("http://www.w3.org/2000/svg",e):document.createElement(e);return n.__n=e,n}function u(e){var t=e.parentNode;t&&t.removeChild(e)}function h(e,t,n,o,r){if("className"===t&&(t="class"),"key"===t);else if("ref"===t)n&&n(null),o&&o(e);else if("class"!==t||r)if("style"===t){if(o&&"string"!=typeof o&&"string"!=typeof n||(e.style.cssText=o||""),o&&"object"==typeof o){if("string"!=typeof n)for(var i in n)i in o||(e.style[i]="");for(var i in o)e.style[i]="number"==typeof o[i]&&!1===j.test(i)?o[i]+"px":o[i]}}else if("dangerouslySetInnerHTML"===t)o&&(e.innerHTML=o.__html||"");else if("o"==t[0]&&"n"==t[1]){var s=t!==(t=t.replace(/Capture$/,""));t=t.toLowerCase().substring(2),o?n||e.addEventListener(t,d,s):e.removeEventListener(t,d,s),(e.__l||(e.__l={}))[t]=o}else if("list"!==t&&"type"!==t&&!r&&t in e)p(e,t,null==o?"":o),null!=o&&!1!==o||e.removeAttribute(t);else{var a=r&&t!==(t=t.replace(/^xlink\:?/,""));null==o||!1===o?a?e.removeAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase()):e.removeAttribute(t):"function"!=typeof o&&(a?e.setAttributeNS("http://www.w3.org/1999/xlink",t.toLowerCase(),o):e.setAttribute(t,o))}else e.className=o||""}function p(e,t,n){try{e[t]=n}catch(e){}}function d(e){return this.__l[e.type](I.event&&I.event(e)||e)}function f(){for(var e;e=E.pop();)I.afterMount&&I.afterMount(e),e.componentDidMount&&e.componentDidMount()}function v(e,t,n,o,r,i){R++||(U=null!=r&&void 0!==r.ownerSVGElement,D=null!=e&&!("__preactattr_"in e));var s=_(e,t,n,o,i);return r&&s.parentNode!==r&&r.appendChild(s),--R||(D=!1,i||f()),s}function _(e,t,n,o,r){var i=e,s=U;if(null!=t&&"boolean"!=typeof t||(t=""),"string"==typeof t||"number"==typeof t)return e&&void 0!==e.splitText&&e.parentNode&&(!e._component||r)?e.nodeValue!=t&&(e.nodeValue=t):(i=document.createTextNode(t),e&&(e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0))),i.__preactattr_=!0,i;var l=t.nodeName;if("function"==typeof l)return C(e,t,n,o);if(U="svg"===l||"foreignObject"!==l&&U,l=String(l),(!e||!a(e,l))&&(i=c(l,U),e)){for(;e.firstChild;)i.appendChild(e.firstChild);e.parentNode&&e.parentNode.replaceChild(i,e),m(e,!0)}var u=i.firstChild,h=i.__preactattr_,p=t.children;if(null==h){h=i.__preactattr_={};for(var d=i.attributes,f=d.length;f--;)h[d[f].name]=d[f].value}return!D&&p&&1===p.length&&"string"==typeof p[0]&&null!=u&&void 0!==u.splitText&&null==u.nextSibling?u.nodeValue!=p[0]&&(u.nodeValue=p[0]):(p&&p.length||null!=u)&&g(i,p,n,o,D||null!=h.dangerouslySetInnerHTML),k(i,t.attributes,h),U=s,i}function g(e,t,n,o,r){var i,a,l,c,h,p=e.childNodes,d=[],f={},v=0,g=0,y=p.length,k=0,b=t?t.length:0;if(0!==y)for(L=0;L2?[].slice.call(arguments,2):e.children)},Component:N,render:function(e,t,n){return v(n,e,{},!1,t,!1)},rerender:i,options:I};void 0!==t?t.exports=F:self.preact=F}()},{}]},{},[1]);
 //# sourceMappingURL=quick-jump.min.js.map
-- 
cgit v1.2.3


From 256b908e0e2bf65812258c21b74d280f9a021cd4 Mon Sep 17 00:00:00 2001
From: Alexander Biehl 
Date: Tue, 3 Apr 2018 16:35:50 +0200
Subject: Travis: Build with ghc-8.4.2 (#793)

---
 .travis.yml                   | 4 ++--
 haddock-api/haddock-api.cabal | 2 +-
 html-test/ref/Bug310.html     | 4 ++--
 html-test/ref/Bug548.html     | 8 ++++----
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 4afc18f4..39135739 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -26,9 +26,9 @@ before_cache:
 
 matrix:
   include:
-    - compiler: "ghc-8.4.1"
+    - compiler: "ghc-8.4.2"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.2], sources: [hvr-ghc]}}
     - compiler: "ghc-head"
     # env: TEST=--disable-tests BENCH=--disable-benchmarks
       addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index f5803e09..acb4d9e4 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -169,7 +169,7 @@ test-suite spec
   build-depends: Cabal           ^>= 2.0.0
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
-               , haddock-library ^>= 1.5.0
+               , haddock-library ^>= 1.6.0
                , xhtml           ^>= 3000.2.2
                , hspec           ^>= 2.4.4
                , QuickCheck      ^>= 2.11
diff --git a/html-test/ref/Bug310.html b/html-test/ref/Bug310.html
index e8ce24f8..47da5387 100644
--- a/html-test/ref/Bug310.html
+++ b/html-test/ref/Bug310.html
@@ -89,7 +89,7 @@
 	    >Addition of type-level naturals.
      Since: 4.7.0.0Since: base-4.7.0.0
      
\ No newline at end of file
+>
diff --git a/html-test/ref/Bug548.html b/html-test/ref/Bug548.html
index 29216433..b32f8c8c 100644
--- a/html-test/ref/Bug548.html
+++ b/html-test/ref/Bug548.html
@@ -183,7 +183,7 @@
 		  >
      
\ No newline at end of file
+>
-- 
cgit v1.2.3


From 7fb3dc8ed5b04dce61c83ec482683c646bf788a5 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Fri, 20 Apr 2018 07:31:44 +0200
Subject: Don't treat fixity signatures like declarations

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 3c96db98..c4a9091f 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -180,7 +180,7 @@ decls (group, _, _, _) = concatMap ($ group)
         Nothing -> empty
     fix term = case cast term of
         Just ((GHC.FixitySig names _) :: GHC.FixitySig GHC.GhcRn)
-          -> map decl names
+          -> map (\(GHC.L sspan x) -> (sspan, RtkVar x)) names
         Nothing -> empty
     tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
     sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
-- 
cgit v1.2.3


From b347a8c47edafa6bb3df7d35f0189619294831c4 Mon Sep 17 00:00:00 2001
From: Ryan Scott 
Date: Tue, 24 Apr 2018 11:20:09 -0400
Subject: Add regression test for #413

Fixes #413.
---
 hoogle-test/ref/type-sigs/test.txt           | 16 ++++++++++++++++
 hoogle-test/src/type-sigs/ReaderT.hs         |  3 +++
 hoogle-test/src/type-sigs/ReaderTReexport.hs |  3 +++
 3 files changed, 22 insertions(+)
 create mode 100644 hoogle-test/ref/type-sigs/test.txt
 create mode 100644 hoogle-test/src/type-sigs/ReaderT.hs
 create mode 100644 hoogle-test/src/type-sigs/ReaderTReexport.hs

diff --git a/hoogle-test/ref/type-sigs/test.txt b/hoogle-test/ref/type-sigs/test.txt
new file mode 100644
index 00000000..ec5f5043
--- /dev/null
+++ b/hoogle-test/ref/type-sigs/test.txt
@@ -0,0 +1,16 @@
+-- Hoogle documentation, generated by Haddock
+-- See Hoogle, http://www.haskell.org/hoogle/
+
+@package test
+@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
+
+module ReaderTReexport
+newtype ReaderT r m a
+ReaderT :: r -> m a -> ReaderT r m a
+[runReaderT] :: ReaderT r m a -> r -> m a
+runReaderT :: ReaderT r m a -> r -> m a
diff --git a/hoogle-test/src/type-sigs/ReaderT.hs b/hoogle-test/src/type-sigs/ReaderT.hs
new file mode 100644
index 00000000..009c7ed2
--- /dev/null
+++ b/hoogle-test/src/type-sigs/ReaderT.hs
@@ -0,0 +1,3 @@
+module ReaderT where
+
+newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
diff --git a/hoogle-test/src/type-sigs/ReaderTReexport.hs b/hoogle-test/src/type-sigs/ReaderTReexport.hs
new file mode 100644
index 00000000..21fa44ee
--- /dev/null
+++ b/hoogle-test/src/type-sigs/ReaderTReexport.hs
@@ -0,0 +1,3 @@
+module ReaderTReexport (ReaderT(..), runReaderT) where
+
+import ReaderT
-- 
cgit v1.2.3


From 979c7338cfcdc59f0b0dda562a53558c416cc362 Mon Sep 17 00:00:00 2001
From: Ryan Scott 
Date: Tue, 24 Apr 2018 16:51:06 -0400
Subject: Improve the Hoogle backend's treatment of type families (#808)

Fixes parts 1 and 2 of #806.
---
 haddock-api/src/Haddock/Backends/Hoogle.hs | 26 ++++++++++++++++++++------
 hoogle-test/ref/Bug806/test.txt            | 24 ++++++++++++++++++++++++
 hoogle-test/src/Bug806/Bug806.hs           | 23 +++++++++++++++++++++++
 3 files changed, 67 insertions(+), 6 deletions(-)
 create mode 100644 hoogle-test/ref/Bug806/test.txt
 create mode 100644 hoogle-test/src/Bug806/Bug806.hs

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index e002b602..e7ce9d30 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -128,6 +128,7 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl
         f (TyClD d@DataDecl{})  = ppData dflags d subdocs
         f (TyClD d@SynDecl{})   = ppSynonym dflags d
         f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs
+        f (TyClD (FamDecl d))   = ppFam dflags d
         f (ForD (ForeignImport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
         f (ForD (ForeignExport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)]
         f (SigD sig) = ppSig dflags sig ++ ppFixities
@@ -140,11 +141,7 @@ ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
 ppSigWithDoc dflags (TypeSig names sig) subdocs
     = concatMap mkDocSig names
     where
-        mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n)
-                     ++ [pp_sig dflags [n] (hsSigWcType sig)]
-
-        getDoc :: Located Name -> [Documentation Name]
-        getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs)
+        mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)]
 
 ppSigWithDoc _ _ _ = []
 
@@ -172,10 +169,14 @@ ppClass dflags decl subdocs =
         ppTyFams
             | null $ tcdATs decl = ""
             | otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat
-                [ map ppr (tcdATs decl)
+                [ map pprTyFam (tcdATs decl)
                 , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl)
                 ]
 
+        pprTyFam :: LFamilyDecl GhcRn -> SDoc
+        pprTyFam (L _ at) = vcat' $ map text $
+            mkSubdoc dflags (fdLName at) subdocs (ppFam dflags at)
+
         whereWrapper elems = vcat'
             [ text "where" <+> lbrace
             , nest 4 . vcat . map (Outputable.<> semi) $ elems
@@ -191,6 +192,15 @@ ppClass dflags decl subdocs =
             , tcdFVs    = emptyNameSet
             }
 
+ppFam :: DynFlags -> FamilyDecl GhcRn -> [String]
+ppFam dflags decl@(FamilyDecl { fdInfo = info })
+  = [out dflags decl']
+  where
+    decl' = case info of
+              -- We don't need to print out a closed type family's equations
+              -- for Hoogle, so pretend it doesn't have any.
+              ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily }
+              _                  -> decl
 
 ppInstance :: DynFlags -> ClsInst -> [String]
 ppInstance dflags x =
@@ -285,6 +295,10 @@ docWith dflags header d
     lines header ++ ["" | header /= "" && isJust d] ++
     maybe [] (showTags . markup (markupTag dflags)) d
 
+mkSubdoc :: DynFlags -> Located Name -> [(Name, DocForDecl Name)] -> [String] -> [String]
+mkSubdoc dflags n subdocs s = concatMap (ppDocumentation dflags) getDoc ++ s
+ where
+   getDoc = maybe [] (return . fst) (lookup (unL n) subdocs)
 
 data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String
            deriving Show
diff --git a/hoogle-test/ref/Bug806/test.txt b/hoogle-test/ref/Bug806/test.txt
new file mode 100644
index 00000000..d9a908b3
--- /dev/null
+++ b/hoogle-test/ref/Bug806/test.txt
@@ -0,0 +1,24 @@
+-- Hoogle documentation, generated by Haddock
+-- See Hoogle, http://www.haskell.org/hoogle/
+
+@package test
+@version 0.0.0
+
+module Bug806
+
+-- | F1 docs
+type family F1 a b :: * -> *
+
+-- | F2 docs
+type family F2 a b :: * -> *
+
+-- | D docs
+data family D a :: * -> *
+v :: Int
+
+-- | C docs
+class C a where {
+    
+    -- | AT docs
+    type family AT a;
+}
diff --git a/hoogle-test/src/Bug806/Bug806.hs b/hoogle-test/src/Bug806/Bug806.hs
new file mode 100644
index 00000000..6efcb5cf
--- /dev/null
+++ b/hoogle-test/src/Bug806/Bug806.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Bug806 where
+
+import Data.Proxy
+
+-- | 'F1' docs
+type family F1 a b :: * -> *
+-- | 'F2' docs
+type family F2 a b :: * -> * where
+  F2 Int b = Maybe
+  F2 a   b = []
+-- | 'D' docs
+data family D a :: * -> *
+
+v :: Int
+v = 42
+
+-- | 'C' docs
+class C a where
+  -- | 'AT' docs
+  type AT a
-- 
cgit v1.2.3


From 79c7159101c03bbbc7350e07963896ca2bb97c02 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Wed, 25 Apr 2018 11:24:07 -0700
Subject: Replace 'attoparsec' with 'parsec' (#799)

* Remove attoparsec with parsec and start fixing failed parses

* Make tests pass

* Fix encoding issues

The Haddock parser no longer needs to worry about bytestrings. All
the internal parsing work in haddock-library happens over 'Text'.

* Remove attoparsec vendor

* Fix stuff broken in 'attoparsec' -> 'parsec'

* hyperlinks
* codeblocks
* examples

Pretty much all issues are due to attoparsec's backtracking failure
behaviour vs. parsec's non-backtracking failure behaviour.

* Fix small TODOs

* Missing quote + Haddocks

* Better handle spaces before/after paragraphs

* Address review comments
---
 haddock-library/haddock-library.cabal              |  64 +--
 .../src/Documentation/Haddock/Parser.hs            | 428 ++++++++--------
 .../src/Documentation/Haddock/Parser/Monad.hs      | 225 +++------
 .../src/Documentation/Haddock/Parser/Util.hs       |  82 ++--
 .../vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs  |  23 -
 .../Data/Attoparsec/ByteString.hs                  | 230 ---------
 .../Data/Attoparsec/ByteString/Buffer.hs           | 156 ------
 .../Data/Attoparsec/ByteString/Char8.hs            | 464 ------------------
 .../Data/Attoparsec/ByteString/FastSet.hs          | 115 -----
 .../Data/Attoparsec/ByteString/Internal.hs         | 536 ---------------------
 .../Data/Attoparsec/Combinator.hs                  | 233 ---------
 .../Data/Attoparsec/Internal.hs                    | 157 ------
 .../Data/Attoparsec/Internal/Fhthagn.hs            |  18 -
 .../Data/Attoparsec/Internal/Types.hs              | 243 ----------
 .../attoparsec-0.13.1.0/Data/Attoparsec/Number.hs  | 137 ------
 haddock-library/vendor/attoparsec-0.13.1.0/LICENSE |  30 --
 haddock.cabal                                      |  18 +-
 17 files changed, 363 insertions(+), 2796 deletions(-)
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs
 delete mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/LICENSE

diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index deeaa98d..49ec826c 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -10,7 +10,6 @@ description:          Haddock is a documentation-generation tool for Haskell
                       itself, see the ‘haddock’ package.
 license:              BSD3
 license-files:        LICENSE
-                      vendor/attoparsec-0.13.1.0/LICENSE
 maintainer:           Alex Biehl , Simon Hengel , Mateusz Kowalczyk 
 homepage:             http://www.haskell.org/haddock/
 bug-reports:          https://github.com/haskell/haddock/issues
@@ -27,9 +26,8 @@ library
     , bytestring   >= 0.9.2.1 && < 0.11
     , containers   >= 0.4.2.1 && < 0.6
     , transformers >= 0.3.0   && < 0.6
-
-  -- internal sub-lib
-  build-depends:        attoparsec
+    , text         >= 1.2.3.0  && < 1.3
+    , parsec       >= 3.1.13.0 && < 3.2
 
   hs-source-dirs:       src
 
@@ -48,39 +46,6 @@ library
   if impl(ghc >= 8.0)
     ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
 
-library attoparsec
-  default-language:     Haskell2010
-
-  build-depends:
-      base         >= 4.5     && < 4.12
-    , bytestring   >= 0.9.2.1 && < 0.11
-    , deepseq      >= 1.3     && < 1.5
-
-  hs-source-dirs:       vendor/attoparsec-0.13.1.0
-
-  -- NB: haddock-library needs only small part of lib:attoparsec
-  --     internally, so we only bundle that subset here
-  exposed-modules:
-    Data.Attoparsec.ByteString
-    Data.Attoparsec.ByteString.Char8
-    Data.Attoparsec.Combinator
-
-  other-modules:
-    Data.Attoparsec
-    Data.Attoparsec.ByteString.Buffer
-    Data.Attoparsec.ByteString.FastSet
-    Data.Attoparsec.ByteString.Internal
-    Data.Attoparsec.Internal
-    Data.Attoparsec.Internal.Fhthagn
-    Data.Attoparsec.Internal.Types
-    Data.Attoparsec.Number
-
-  ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2
-  if impl(ghc >= 8.0)
-    ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
-  else
-    build-depends: semigroups ^>= 0.18.3, fail ^>= 4.9.0.0
-
 
 test-suite spec
   type:             exitcode-stdio-1.0
@@ -106,21 +71,16 @@ test-suite spec
       Documentation.Haddock.Utf8Spec
 
   build-depends:
-      base-compat   ^>= 0.9.3
+      base         >= 4.5     && < 4.12
+    , base-compat   ^>= 0.9.3
+    , bytestring   >= 0.9.2.1 && < 0.11
     , containers   >= 0.4.2.1 && < 0.6
     , transformers   >= 0.3.0   && < 0.6
     , hspec         ^>= 2.4.4
     , QuickCheck    ^>= 2.11
-
-  -- internal sub-lib
-  build-depends: attoparsec
-
-  -- Versions for the dependencies below are transitively pinned by
-  -- dependency on haddock-library:lib:attoparsec
-  build-depends:
-      base
-    , bytestring
-    , deepseq
+    , text         >= 1.2.3.0  && < 1.3
+    , parsec       >= 3.1.13.0 && < 3.2
+    , deepseq      >= 1.3     && < 1.5
 
   build-tool-depends:
     hspec-discover:hspec-discover ^>= 2.4.4
@@ -132,7 +92,8 @@ test-suite fixtures
   ghc-options:      -Wall -O0
   hs-source-dirs:   fixtures
   build-depends:
-      base-compat           ^>= 0.9.3
+      base         >= 4.5     && < 4.12
+    , base-compat           ^>= 0.9.3
     , directory             ^>= 1.3.0.2
     , filepath              ^>= 1.4.1.2
     , optparse-applicative  ^>= 0.14.0.0
@@ -142,11 +103,6 @@ test-suite fixtures
   build-depends:
     haddock-library
 
-  -- Versions for the dependencies below are transitively pinned by
-  -- dependency on haddock-library:lib:attoparsec
-  build-depends:
-      base
-
 source-repository head
   type:     git
   subdir:   haddock-library
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 4921b3a7..d79da40b 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -16,27 +16,35 @@
 -- to be
 --
 -- @'toRegular' . '_doc' . 'parseParas'@
-module Documentation.Haddock.Parser ( parseString, parseParas
-                                    , overIdentifier, toRegular, Identifier
-                                    ) where
+module Documentation.Haddock.Parser (
+  parseString,
+  parseParas,
+  overIdentifier,
+  toRegular,
+  Identifier
+) where
 
 import           Control.Applicative
 import           Control.Arrow (first)
 import           Control.Monad
-import qualified Data.ByteString.Char8 as BS
-import           Data.Char (chr, isUpper, isAlpha, isAlphaNum)
-import           Data.List (stripPrefix, intercalate, unfoldr, elemIndex)
+import           Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace)
+import           Data.List (intercalate, unfoldr, elemIndex, notElem)
 import           Data.Maybe (fromMaybe, mapMaybe)
 import           Data.Monoid
 import qualified Data.Set as Set
 import           Documentation.Haddock.Doc
-import           Documentation.Haddock.Parser.Monad hiding (take, endOfLine)
+import           Documentation.Haddock.Parser.Monad
 import           Documentation.Haddock.Parser.Util
 import           Documentation.Haddock.Types
-import           Documentation.Haddock.Utf8
 import           Prelude hiding (takeWhile)
 import qualified Prelude as P
 
+import qualified Text.Parsec as Parsec
+import           Text.Parsec (try)
+
+import qualified Data.Text as T
+import           Data.Text (Text)
+
 #if MIN_VERSION_base(4,9,0)
 import           Text.Read.Lex                      (isSymbolChar)
 #else
@@ -56,7 +64,7 @@ isSymbolChar c = not (isPuncChar c) && case generalCategory c of
     ModifierSymbol       -> True
     OtherSymbol          -> True
     DashPunctuation      -> True
-    OtherPunctuation     -> not (c `elem` ("'\"" :: String))
+    OtherPunctuation     -> c `notElem` ("'\"" :: String)
     ConnectorPunctuation -> c /= '_'
     _                    -> False
   where
@@ -109,8 +117,14 @@ overIdentifier f d = g d
     g (DocHeader (Header l x)) = DocHeader . Header l $ g x
     g (DocTable (Table h b)) = DocTable (Table (map (fmap g) h) (map (fmap g) b))
 
-parse :: Parser a -> BS.ByteString -> (ParserState, a)
-parse p = either err id . parseOnly (p <* endOfInput)
+
+choice' :: [Parser a] -> Parser a
+choice' [] = empty
+choice' [p] = p
+choice' (p : ps) = try p <|> choice' ps
+
+parse :: Parser a -> Text -> (ParserState, a)
+parse p = either err id . parseOnly (p <* Parsec.eof)
   where
     err = error . ("Haddock.Parser.parse: " ++)
 
@@ -127,31 +141,46 @@ parseParas pkg input = case parseParasState input of
                         }
 
 parseParasState :: String -> (ParserState, DocH mod Identifier)
-parseParasState =
-    parse (p <* skipSpace) . encodeUtf8 . (++ "\n") . filter (/= '\r')
+parseParasState = parse (emptyLines *> p) . T.pack . (++ "\n") . filter (/= '\r')
   where
     p :: Parser (DocH mod Identifier)
-    p = docConcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n")
+    p = docConcat <$> many (paragraph <* emptyLines)
+
+    emptyLines :: Parser ()
+    emptyLines = void $ many (try (skipHorizontalSpace *> "\n"))
 
 parseParagraphs :: String -> Parser (DocH mod Identifier)
 parseParagraphs input = case parseParasState input of
-  (state, a) -> setParserState state >> return a
+  (state, a) -> Parsec.putState state *> pure a
 
--- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which
--- drops leading whitespace and encodes the string to UTF8 first.
+-- | Variant of 'parseText' for 'String' instead of 'Text'
 parseString :: String -> DocH mod Identifier
-parseString = parseStringBS . encodeUtf8 . dropWhile isSpace . filter (/= '\r')
+parseString = parseText . T.pack
 
-parseStringBS :: BS.ByteString -> DocH mod Identifier
-parseStringBS = snd . parse p
+-- | Parse a text paragraph. Actually just a wrapper over 'parseParagraph' which
+-- drops leading whitespace.
+parseText :: Text -> DocH mod Identifier
+parseText = parseParagraph . T.dropWhile isSpace . T.filter (/= '\r')
+
+parseParagraph :: Text -> DocH mod Identifier
+parseParagraph = snd . parse p
   where
     p :: Parser (DocH mod Identifier)
-    p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName
-                            <|> picture <|> mathDisplay <|> mathInline
-                            <|> markdownImage
-                            <|> hyperlink <|> bold
-                            <|> emphasis <|> encodedChar <|> string'
-                            <|> skipSpecialChar)
+    p = docConcat <$> many (choice' [ monospace
+                                    , anchor
+                                    , identifier
+                                    , moduleName
+                                    , picture
+                                    , mathDisplay
+                                    , mathInline
+                                    , markdownImage
+                                    , hyperlink
+                                    , bold
+                                    , emphasis
+                                    , encodedChar
+                                    , string'
+                                    , skipSpecialChar
+                                    ])
 
 -- | Parses and processes
 -- 
@@ -175,7 +204,7 @@ specialChar = "_/<@\"&'`# "
 -- to ensure that we have already given a chance to more meaningful parsers
 -- before capturing their characers.
 string' :: Parser (DocH mod a)
-string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (notInClass specialChar)
+string' = DocString . unescape . T.unpack <$> takeWhile1_ (`notElem` specialChar)
   where
     unescape "" = ""
     unescape ('\\':x:xs) = x : unescape xs
@@ -185,45 +214,45 @@ string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (notInClass specialC
 -- This is done to skip over any special characters belonging to other
 -- elements but which were not deemed meaningful at their positions.
 skipSpecialChar :: Parser (DocH mod a)
-skipSpecialChar = DocString . return <$> satisfy (inClass specialChar)
+skipSpecialChar = DocString . return <$> Parsec.oneOf specialChar
 
 -- | Emphasis parser.
 --
 -- >>> parseString "/Hello world/"
 -- DocEmphasis (DocString "Hello world")
 emphasis :: Parser (DocH mod Identifier)
-emphasis = DocEmphasis . parseStringBS <$>
-  mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/")
+emphasis = DocEmphasis . parseParagraph <$>
+  disallowNewline ("/" *> takeWhile1_ (/= '/') <* "/")
 
 -- | Bold parser.
 --
 -- >>> parseString "__Hello world__"
 -- DocBold (DocString "Hello world")
 bold :: Parser (DocH mod Identifier)
-bold = DocBold . parseStringBS <$> disallowNewline ("__" *> takeUntil "__")
+bold = DocBold . parseParagraph <$> disallowNewline ("__" *> takeUntil "__")
 
-disallowNewline :: Parser BS.ByteString -> Parser BS.ByteString
-disallowNewline = mfilter ('\n' `BS.notElem`)
+disallowNewline :: Parser Text -> Parser Text
+disallowNewline = mfilter (T.all (/= '\n'))
 
 -- | Like `takeWhile`, but unconditionally take escaped characters.
-takeWhile_ :: (Char -> Bool) -> Parser BS.ByteString
-takeWhile_ p = scan False p_
+takeWhile_ :: (Char -> Bool) -> Parser Text
+takeWhile_ p = scan p_ False
   where
     p_ escaped c
       | escaped = Just False
       | not $ p c = Nothing
       | otherwise = Just (c == '\\')
 
--- | Like `takeWhile1`, but unconditionally take escaped characters.
-takeWhile1_ :: (Char -> Bool) -> Parser BS.ByteString
-takeWhile1_ = mfilter (not . BS.null) . takeWhile_
+-- | Like 'takeWhile1', but unconditionally take escaped characters.
+takeWhile1_ :: (Char -> Bool) -> Parser Text
+takeWhile1_ = mfilter (not . T.null) . takeWhile_
 
 -- | Text anchors to allow for jumping around the generated documentation.
 --
 -- >>> parseString "#Hello world#"
 -- DocAName "Hello world"
 anchor :: Parser (DocH mod a)
-anchor = DocAName . decodeUtf8 <$>
+anchor = DocAName . T.unpack <$>
          disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#")
 
 -- | Monospaced strings.
@@ -231,7 +260,7 @@ anchor = DocAName . decodeUtf8 <$>
 -- >>> parseString "@cruel@"
 -- DocMonospaced (DocString "cruel")
 monospace :: Parser (DocH mod Identifier)
-monospace = DocMonospaced . parseStringBS
+monospace = DocMonospaced . parseParagraph
             <$> ("@" *> takeWhile1_ (/= '@') <* "@")
 
 -- | Module names.
@@ -239,14 +268,14 @@ monospace = DocMonospaced . parseStringBS
 -- Note that we allow '#' and '\' to support anchors (old style anchors are of
 -- the form "SomeModule\#anchor").
 moduleName :: Parser (DocH mod a)
-moduleName = DocModule <$> (char '"' *> modid <* char '"')
+moduleName = DocModule <$> ("\"" *> modid <* "\"")
   where
-    modid = intercalate "." <$> conid `sepBy1` "."
+    modid = intercalate "." <$> conid `Parsec.sepBy1` "."
     conid = (:)
-      <$> satisfyUnicode (\c -> isAlpha c && isUpper c)
-      <*> many (satisfyUnicode conChar <|> char '\\' <|> char '#')
+      <$> Parsec.satisfy (\c -> isAlpha c && isUpper c)
+      <*> many (conChar <|> Parsec.oneOf "\\#")
 
-    conChar c = isAlphaNum c || c == '_'
+    conChar = Parsec.alphaNum <|> Parsec.char '_'
 
 -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify
 -- a title for the picture.
@@ -256,7 +285,7 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"')
 -- >>> parseString "<>"
 -- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Just "world"})
 picture :: Parser (DocH mod a)
-picture = DocPic . makeLabeled Picture . decodeUtf8
+picture = DocPic . makeLabeled Picture
           <$> disallowNewline ("<<" *> takeUntil ">>")
 
 -- | Inline math parser, surrounded by \\( and \\).
@@ -264,7 +293,7 @@ picture = DocPic . makeLabeled Picture . decodeUtf8
 -- >>> parseString "\\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)"
 -- DocMathInline "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"
 mathInline :: Parser (DocH mod a)
-mathInline = DocMathInline . decodeUtf8
+mathInline = DocMathInline . T.unpack 
              <$> disallowNewline  ("\\(" *> takeUntil "\\)")
 
 -- | Display math parser, surrounded by \\[ and \\].
@@ -272,7 +301,7 @@ mathInline = DocMathInline . decodeUtf8
 -- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]"
 -- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}"
 mathDisplay :: Parser (DocH mod a)
-mathDisplay = DocMathDisplay . decodeUtf8
+mathDisplay = DocMathDisplay . T.unpack 
               <$> ("\\[" *> takeUntil "\\]")
 
 markdownImage :: Parser (DocH mod a)
@@ -282,20 +311,21 @@ markdownImage = fromHyperlink <$> ("!" *> linkParser)
 
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
-paragraph = examples <|> table <|> do
-  indent <- takeIndent
-  choice
-    [ since
-    , unorderedList indent
-    , orderedList indent
-    , birdtracks
-    , codeblock
-    , property
-    , header
-    , textParagraphThatStartsWithMarkdownLink
-    , definitionList indent
-    , docParagraph <$> textParagraph
-    ]
+paragraph = choice' [ examples
+                    , table
+                    , do indent <- takeIndent
+                         choice' [ since
+                                 , unorderedList indent
+                                 , orderedList indent
+                                 , birdtracks
+                                 , codeblock
+                                 , property
+                                 , header
+                                 , textParagraphThatStartsWithMarkdownLink
+                                 , definitionList indent
+                                 , docParagraph <$> textParagraph
+                                 ]
+                    ]
 
 -- | Provides support for grid tables.
 --
@@ -317,45 +347,45 @@ table :: Parser (DocH mod Identifier)
 table = do
     -- first we parse the first row, which determines the width of the table
     firstRow <- parseFirstRow
-    let len = BS.length firstRow
+    let len = T.length firstRow
 
     -- then we parse all consequtive rows starting and ending with + or |,
     -- of the width `len`.
-    restRows <- many (parseRestRows len)
+    restRows <- many (try (parseRestRows len))
 
     -- Now we gathered the table block, the next step is to split the block
     -- into cells.
     DocTable <$> tableStepTwo len (firstRow : restRows)
   where
-    parseFirstRow :: Parser BS.ByteString
+    parseFirstRow :: Parser Text
     parseFirstRow = do
         skipHorizontalSpace
         -- upper-left corner is +
-        c <- char '+'
-        cs <- many1 (char '-' <|> char '+')
+        c <- Parsec.char '+'
+        cs <- some (Parsec.char '-' <|> Parsec.char '+')
 
         -- upper right corner is + too
         guard (last cs == '+')
 
         -- trailing space
         skipHorizontalSpace
-        _ <- char '\n'
+        _ <- Parsec.newline
 
-        return (BS.cons c $ BS.pack cs)
+        return (T.cons c $ T.pack cs)
 
-    parseRestRows :: Int -> Parser BS.ByteString
+    parseRestRows :: Int -> Parser Text
     parseRestRows l = do
         skipHorizontalSpace
 
-        c <- char '|' <|> char '+'
-        bs <- scan (l - 2) predicate
-        c2 <- char '|' <|> char '+'
+        c <- Parsec.char '|' <|> Parsec.char '+'
+        bs <- scan predicate (l - 2)
+        c2 <- Parsec.char '|' <|> Parsec.char '+'
 
         -- trailing space
         skipHorizontalSpace
-        _ <- char '\n'
+        _ <- Parsec.newline
 
-        return (BS.cons c (BS.snoc bs c2))
+        return (T.cons c (T.snoc bs c2))
       where
         predicate n c
             | n <= 0    = Nothing
@@ -366,22 +396,22 @@ table = do
 -- and changes to '=' to '-'.
 tableStepTwo
     :: Int              -- ^ width
-    -> [BS.ByteString]  -- ^ rows
+    -> [Text]           -- ^ rows
     -> Parser (Table (DocH mod Identifier))
 tableStepTwo width = go 0 [] where
     go _ left [] = tableStepThree width (reverse left) Nothing
     go n left (r : rs)
-        | BS.all (`elem` ['+', '=']) r =
+        | T.all (`elem` ['+', '=']) r =
             tableStepThree width (reverse left ++ r' : rs) (Just n)
         | otherwise =
             go (n + 1) (r :  left) rs
       where
-        r' = BS.map (\c -> if c == '=' then '-' else c) r
+        r' = T.map (\c -> if c == '=' then '-' else c) r
 
 -- Third step recognises cells in the table area, returning a list of TC, cells.
 tableStepThree
     :: Int              -- ^ width
-    -> [BS.ByteString]  -- ^ rows
+    -> [Text]           -- ^ rows
     -> Maybe Int        -- ^ index of header separator
     -> Parser (Table (DocH mod Identifier))
 tableStepThree width rs hdrIndex = do
@@ -408,32 +438,32 @@ tableStepThree width rs hdrIndex = do
     scanRight :: Int -> Int -> Maybe (Int, Int)
     scanRight x y = go (x + 1) where
         bs = rs !! y
-        go x' | x' >= width           = fail "overflow right "
-              | BS.index bs x' == '+' = scanDown x y x' <|> go (x' + 1)
-              | BS.index bs x' == '-' = go (x' + 1)
-              | otherwise             = fail $ "not a border (right) " ++ show (x,y,x')
+        go x' | x' >= width          = fail "overflow right "
+              | T.index bs x' == '+' = scanDown x y x' <|> go (x' + 1)
+              | T.index bs x' == '-' = go (x' + 1)
+              | otherwise            = fail $ "not a border (right) " ++ show (x,y,x')
 
     -- scan down looking for +
     scanDown :: Int -> Int -> Int -> Maybe (Int, Int)
     scanDown x y x2 = go (y + 1) where
-        go y' | y' >= height                  = fail "overflow down"
-              | BS.index (rs !! y') x2 == '+' = scanLeft x y x2 y' <|> go (y' + 1)
-              | BS.index (rs !! y') x2 == '|' = go (y' + 1)
-              | otherwise                     = fail $ "not a border (down) " ++ show (x,y,x2,y')
+        go y' | y' >= height                 = fail "overflow down"
+              | T.index (rs !! y') x2 == '+' = scanLeft x y x2 y' <|> go (y' + 1)
+              | T.index (rs !! y') x2 == '|' = go (y' + 1)
+              | otherwise                    = fail $ "not a border (down) " ++ show (x,y,x2,y')
 
     -- check that at y2 x..x2 characters are '+' or '-'
     scanLeft :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
     scanLeft x y x2 y2
-        | all (\x' -> BS.index bs x' `elem` ['+', '-']) [x..x2] = scanUp x y x2 y2
-        | otherwise                                             = fail $ "not a border (left) " ++ show (x,y,x2,y2)
+        | all (\x' -> T.index bs x' `elem` ['+', '-']) [x..x2] = scanUp x y x2 y2
+        | otherwise                                            = fail $ "not a border (left) " ++ show (x,y,x2,y2)
       where
         bs = rs !! y2
 
     -- check that at y2 x..x2 characters are '+' or '-'
     scanUp :: Int -> Int -> Int -> Int -> Maybe (Int, Int)
     scanUp x y x2 y2
-        | all (\y' -> BS.index (rs !! y') x `elem` ['+', '|']) [y..y2] = return (x2, y2)
-        | otherwise                                                    = fail $ "not a border (up) " ++ show (x,y,x2,y2)
+        | all (\y' -> T.index (rs !! y') x `elem` ['+', '|']) [y..y2] = return (x2, y2)
+        | otherwise                                                   = fail $ "not a border (up) " ++ show (x,y,x2,y2)
 
 -- | table cell: top left bottom right
 data TC = TC !Int !Int !Int !Int
@@ -446,7 +476,7 @@ tcYS :: TC -> [Int]
 tcYS (TC y _ y2 _) = [y, y2]
 
 -- | Fourth step. Given the locations of cells, forms 'Table' structure.
-tableStepFour :: [BS.ByteString] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
+tableStepFour :: [Text] -> Maybe Int -> [TC] -> Parser (Table (DocH mod Identifier))
 tableStepFour rs hdrIndex cells =  case hdrIndex of
     Nothing -> return $ Table [] rowsDoc
     Just i  -> case elemIndex i yTabStops of
@@ -464,7 +494,7 @@ tableStepFour rs hdrIndex cells =  case hdrIndex of
     init' [_]      = []
     init' (x : xs) = x : init' xs
 
-    rowsDoc = (fmap . fmap) parseStringBS rows
+    rowsDoc = (fmap . fmap) parseParagraph rows
 
     rows = map makeRow (init' yTabStops)
       where
@@ -477,9 +507,9 @@ tableStepFour rs hdrIndex cells =  case hdrIndex of
             yts = length $ P.takeWhile (< y2) $ dropWhile (< y) yTabStops
 
     -- extract cell contents given boundaries
-    extract :: Int -> Int -> Int -> Int -> BS.ByteString
-    extract x y x2 y2 = BS.intercalate "\n"
-        [ BS.take (x2 - x + 1) $ BS.drop x $ rs !! y'
+    extract :: Int -> Int -> Int -> Int -> Text
+    extract x y x2 y2 = T.intercalate "\n"
+        [ T.take (x2 - x + 1) $ T.drop x $ rs !! y'
         | y' <- [y .. y2]
         ]
 
@@ -487,7 +517,7 @@ tableStepFour rs hdrIndex cells =  case hdrIndex of
 since :: Parser (DocH mod a)
 since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty
   where
-    version = decimal `sepBy1'` "."
+    version = decimal `Parsec.sepBy1` "."
 
 -- | Headers inside the comment denoted with @=@ signs, up to 6 levels
 -- deep.
@@ -498,38 +528,39 @@ since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince
 -- Right (DocHeader (Header {headerLevel = 2, headerTitle = DocString "World"}))
 header :: Parser (DocH mod Identifier)
 header = do
-  let psers = map (string . encodeUtf8 . concat . flip replicate "=") [6, 5 .. 1]
-      pser = foldl1 (<|>) psers
-  delim <- decodeUtf8 <$> pser
-  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString
-  rest <- paragraph <|> return DocEmpty
+  let psers = map (string . flip T.replicate "=") [6, 5 .. 1]
+      pser = choice' psers
+  delim <- T.unpack <$> pser
+  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseText
+  rest <- try paragraph <|> return DocEmpty
   return $ DocHeader (Header (length delim) line) `docAppend` rest
 
 textParagraph :: Parser (DocH mod Identifier)
-textParagraph = parseString . intercalate "\n" <$> many1 nonEmptyLine
+textParagraph = parseText . T.intercalate "\n" <$> some nonEmptyLine
 
 textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)
 textParagraphThatStartsWithMarkdownLink = docParagraph <$> (docAppend <$> markdownLink <*> optionalTextParagraph)
   where
     optionalTextParagraph :: Parser (DocH mod Identifier)
-    optionalTextParagraph = (docAppend <$> whitespace <*> textParagraph) <|> pure DocEmpty
+    optionalTextParagraph = choice' [ docAppend <$> whitespace <*> textParagraph
+                                    , pure DocEmpty ]
 
     whitespace :: Parser (DocH mod a)
     whitespace = DocString <$> (f <$> takeHorizontalSpace <*> optional "\n")
       where
-        f :: BS.ByteString -> Maybe BS.ByteString -> String
+        f :: Text -> Maybe Text -> String
         f xs (fromMaybe "" -> x)
-          | BS.null (xs <> x) = ""
+          | T.null (xs <> x) = ""
           | otherwise = " "
 
 -- | Parses unordered (bullet) lists.
-unorderedList :: BS.ByteString -> Parser (DocH mod Identifier)
+unorderedList :: Text -> Parser (DocH mod Identifier)
 unorderedList indent = DocUnorderedList <$> p
   where
     p = ("*" <|> "-") *> innerList indent p
 
 -- | Parses ordered lists (numbered or dashed).
-orderedList :: BS.ByteString -> Parser (DocH mod Identifier)
+orderedList :: Text -> Parser (DocH mod Identifier)
 orderedList indent = DocOrderedList <$> p
   where
     p = (paren <|> dot) *> innerList indent p
@@ -541,104 +572,110 @@ orderedList indent = DocOrderedList <$> p
 -- same paragraph. Usually used as
 --
 -- > someListFunction = listBeginning *> innerList someListFunction
-innerList :: BS.ByteString -> Parser [DocH mod Identifier]
+innerList :: Text -> Parser [DocH mod Identifier]
           -> Parser [DocH mod Identifier]
 innerList indent item = do
   c <- takeLine
   (cs, items) <- more indent item
-  let contents = docParagraph . parseString . dropNLs . unlines $ c : cs
+  let contents = docParagraph . parseText . dropNLs . T.unlines $ c : cs
   return $ case items of
     Left p -> [contents `docAppend` p]
     Right i -> contents : i
 
 -- | Parses definition lists.
-definitionList :: BS.ByteString -> Parser (DocH mod Identifier)
+definitionList :: Text -> Parser (DocH mod Identifier)
 definitionList indent = DocDefList <$> p
   where
     p = do
-      label <- "[" *> (parseStringBS <$> takeWhile1_ (notInClass "]\n")) <* ("]" <* optional ":")
+      label <- "[" *> (parseParagraph <$> takeWhile1_ (`notElem` ("]\n" :: String))) <* ("]" <* optional ":")
       c <- takeLine
       (cs, items) <- more indent p
-      let contents = parseString . dropNLs . unlines $ c : cs
+      let contents = parseText . dropNLs . T.unlines $ c : cs
       return $ case items of
         Left x -> [(label, contents `docAppend` x)]
         Right i -> (label, contents) : i
 
 -- | Drops all trailing newlines.
-dropNLs :: String -> String
-dropNLs = reverse . dropWhile (== '\n') . reverse
+dropNLs :: Text -> Text 
+dropNLs = T.dropWhileEnd (== '\n')
 
 -- | Main worker for 'innerList' and 'definitionList'.
 -- We need the 'Either' here to be able to tell in the respective functions
 -- whether we're dealing with the next list or a nested paragraph.
-more :: Monoid a => BS.ByteString -> Parser a
-     -> Parser ([String], Either (DocH mod Identifier) a)
-more indent item = innerParagraphs indent
-               <|> moreListItems indent item
-               <|> moreContent indent item
-               <|> pure ([], Right mempty)
+more :: Monoid a => Text -> Parser a
+     -> Parser ([Text], Either (DocH mod Identifier) a)
+more indent item = choice' [ innerParagraphs indent
+                           , moreListItems indent item
+                           , moreContent indent item
+                           , pure ([], Right mempty)
+                           ]
 
 -- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs.
-innerParagraphs :: BS.ByteString
-                -> Parser ([String], Either (DocH mod Identifier) a)
+innerParagraphs :: Text
+                -> Parser ([Text], Either (DocH mod Identifier) a)
 innerParagraphs indent = (,) [] . Left <$> ("\n" *> indentedParagraphs indent)
 
 -- | Attempts to fetch the next list if possibly. Used by 'innerList' and
 -- 'definitionList' to recursively grab lists that aren't separated by a whole
 -- paragraph.
-moreListItems :: BS.ByteString -> Parser a
-              -> Parser ([String], Either (DocH mod Identifier) a)
+moreListItems :: Text -> Parser a
+              -> Parser ([Text], Either (DocH mod Identifier) a)
 moreListItems indent item = (,) [] . Right <$> indentedItem
   where
-    indentedItem = string indent *> skipSpace *> item
+    indentedItem = string indent *> Parsec.spaces *> item
 
 -- | Helper for 'innerList' and 'definitionList' which simply takes
 -- a line of text and attempts to parse more list content with 'more'.
-moreContent :: Monoid a => BS.ByteString -> Parser a
-            -> Parser ([String], Either (DocH mod Identifier) a)
+moreContent :: Monoid a => Text -> Parser a
+            -> Parser ([Text], Either (DocH mod Identifier) a)
 moreContent indent item = first . (:) <$> nonEmptyLine <*> more indent item
 
 -- | Parses an indented paragraph.
 -- The indentation is 4 spaces.
-indentedParagraphs :: BS.ByteString -> Parser (DocH mod Identifier)
+indentedParagraphs :: Text -> Parser (DocH mod Identifier)
 indentedParagraphs indent =
-    (concat <$> dropFrontOfPara indent') >>= parseParagraphs
+    (T.unpack . T.concat <$> dropFrontOfPara indent') >>= parseParagraphs
   where
-    indent' = string $ BS.append indent "    "
+    indent' = string $ indent <> "    "
 
 -- | Grab as many fully indented paragraphs as we can.
-dropFrontOfPara :: Parser BS.ByteString -> Parser [String]
+dropFrontOfPara :: Parser Text -> Parser [Text]
 dropFrontOfPara sp = do
-  currentParagraph <- some (sp *> takeNonEmptyLine)
+  currentParagraph <- some (try (sp *> takeNonEmptyLine))
   followingParagraphs <-
-    skipHorizontalSpace *> nextPar -- we have more paragraphs to take
-    <|> skipHorizontalSpace *> nlList -- end of the ride, remember the newline
-    <|> endOfInput *> return [] -- nothing more to take at all
+    choice' [ skipHorizontalSpace *> nextPar -- we have more paragraphs to take
+            , skipHorizontalSpace *> nlList -- end of the ride, remember the newline
+            , Parsec.eof *> return []       -- nothing more to take at all
+            ]
   return (currentParagraph ++ followingParagraphs)
   where
     nextPar = (++) <$> nlList <*> dropFrontOfPara sp
     nlList = "\n" *> return ["\n"]
 
-nonSpace :: BS.ByteString -> Parser BS.ByteString
+nonSpace :: Text -> Parser Text
 nonSpace xs
-  | not $ any (not . isSpace) $ decodeUtf8 xs = fail "empty line"
+  | T.all isSpace xs = fail "empty line"
   | otherwise = return xs
 
 -- | Takes a non-empty, not fully whitespace line.
 --
 --  Doesn't discard the trailing newline.
-takeNonEmptyLine :: Parser String
+takeNonEmptyLine :: Parser Text
 takeNonEmptyLine = do
-    (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n"
+    l <- takeWhile1 (Parsec.noneOf "\n") >>= nonSpace
+    _ <- "\n"
+    pure (l <> "\n")
 
 -- | Takes indentation of first non-empty line.
 --
 -- More precisely: skips all whitespace-only lines and returns indentation
 -- (horizontal space, might be empty) of that non-empty line.
-takeIndent :: Parser BS.ByteString
+takeIndent :: Parser Text 
 takeIndent = do
   indent <- takeHorizontalSpace
-  "\n" *> takeIndent <|> return indent
+  choice' [ "\n" *> takeIndent
+          , return indent
+          ]
 
 -- | Blocks of text of the form:
 --
@@ -647,97 +684,98 @@ takeIndent = do
 -- >> baz
 --
 birdtracks :: Parser (DocH mod a)
-birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line
+birdtracks = DocCodeBlock . DocString . T.unpack . T.intercalate "\n" . stripSpace <$> some line
   where
-    line = skipHorizontalSpace *> ">" *> takeLine
+    line = try (skipHorizontalSpace *> ">" *> takeLine)
 
-stripSpace :: [String] -> [String]
+stripSpace :: [Text] -> [Text]
 stripSpace = fromMaybe <*> mapM strip'
   where
-    strip' (' ':xs') = Just xs'
-    strip' "" = Just ""
-    strip' _  = Nothing
+    strip' t = case T.uncons t of
+                 Nothing -> Just ""
+                 Just (' ',t') -> Just t'
+                 _ -> Nothing
 
 -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line).
 -- Consecutive examples are accepted.
 examples :: Parser (DocH mod a)
-examples = DocExamples <$> (many (skipHorizontalSpace *> "\n") *> go)
+examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)
   where
     go :: Parser [Example]
     go = do
-      prefix <- decodeUtf8 <$> takeHorizontalSpace <* ">>>"
+      prefix <- takeHorizontalSpace <* ">>>"
       expr <- takeLine
       (rs, es) <- resultAndMoreExamples
       return (makeExample prefix expr rs : es)
       where
-        resultAndMoreExamples :: Parser ([String], [Example])
-        resultAndMoreExamples = moreExamples <|> result <|> pure ([], [])
+        resultAndMoreExamples :: Parser ([Text], [Example])
+        resultAndMoreExamples = choice' [ moreExamples, result, pure ([], []) ]
           where
-            moreExamples :: Parser ([String], [Example])
+            moreExamples :: Parser ([Text], [Example])
             moreExamples = (,) [] <$> go
 
-            result :: Parser ([String], [Example])
+            result :: Parser ([Text], [Example])
             result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples
 
-    makeExample :: String -> String -> [String] -> Example
+    makeExample :: Text -> Text -> [Text] -> Example
     makeExample prefix expression res =
-      Example (strip expression) result
+      Example (T.unpack (T.strip expression)) result
       where
-        result = map (substituteBlankLine . tryStripPrefix) res
+        result = map (T.unpack . substituteBlankLine . tryStripPrefix) res
 
-        tryStripPrefix xs = fromMaybe xs (stripPrefix prefix xs)
+        tryStripPrefix xs = fromMaybe xs (T.stripPrefix prefix xs)
 
         substituteBlankLine "" = ""
         substituteBlankLine xs = xs
 
-nonEmptyLine :: Parser String
-nonEmptyLine = mfilter (any (not . isSpace)) takeLine
+nonEmptyLine :: Parser Text 
+nonEmptyLine = try (mfilter (T.any (not . isSpace)) takeLine)
 
-takeLine :: Parser String
-takeLine = decodeUtf8 <$> takeWhile (/= '\n') <* endOfLine
+takeLine :: Parser Text
+takeLine = try (takeWhile (Parsec.noneOf "\n") <* endOfLine)
 
 endOfLine :: Parser ()
-endOfLine = void "\n" <|> endOfInput
+endOfLine = void "\n" <|> Parsec.eof 
 
 -- | Property parser.
 --
 -- >>> snd <$> parseOnly property "prop> hello world"
 -- Right (DocProperty "hello world")
 property :: Parser (DocH mod a)
-property = DocProperty . strip . decodeUtf8 <$> ("prop>" *> takeWhile1 (/= '\n'))
+property = DocProperty . T.unpack . T.strip <$> ("prop>" *> takeWhile1 (Parsec.noneOf "\n"))
 
 -- |
 -- Paragraph level codeblock. Anything between the two delimiting \@ is parsed
 -- for markup.
 codeblock :: Parser (DocH mod Identifier)
 codeblock =
-  DocCodeBlock . parseStringBS . dropSpaces
+  DocCodeBlock . parseParagraph . dropSpaces
   <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@")
   where
     dropSpaces xs =
-      let rs = decodeUtf8 xs
-      in case splitByNl rs of
+      case splitByNl xs of
         [] -> xs
-        ys -> case last ys of
-          ' ':_ -> case mapM dropSpace ys of
-            Nothing -> xs
-            Just zs -> encodeUtf8 $ intercalate "\n" zs
+        ys -> case T.uncons (last ys) of
+          Just (' ',_) -> case mapM dropSpace ys of
+                            Nothing -> xs
+                            Just zs -> T.intercalate "\n" zs
           _ -> xs
 
     -- This is necessary because ‘lines’ swallows up a trailing newline
     -- and we lose information about whether the last line belongs to @ or to
     -- text which we need to decide whether we actually want to be dropping
     -- anything at all.
-    splitByNl = unfoldr (\x -> case x of
-                                 '\n':s -> Just (span (/= '\n') s)
-                                 _      -> Nothing)
-                . ('\n' :)
+    splitByNl = unfoldr (\x -> case T.uncons x of
+                                 Just ('\n',x') -> Just (T.span (/= '\n') x')
+                                 _ -> Nothing)
+                . ("\n" <>)
 
-    dropSpace "" = Just ""
-    dropSpace (' ':xs) = Just xs
-    dropSpace _ = Nothing
+    dropSpace t = case T.uncons t of
+                    Nothing -> Just ""
+                    Just (' ',t') -> Just t'
+                    _ -> Nothing
 
-    block' = scan False p
+    block' = scan p False
       where
         p isNewline c
           | isNewline && c == '@' = Nothing
@@ -745,11 +783,11 @@ codeblock =
           | otherwise = Just $ c == '\n'
 
 hyperlink :: Parser (DocH mod a)
-hyperlink = angleBracketLink <|> markdownLink <|> autoUrl
+hyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ]
 
 angleBracketLink :: Parser (DocH mod a)
 angleBracketLink =
-    DocHyperlink . makeLabeled Hyperlink . decodeUtf8
+    DocHyperlink . makeLabeled Hyperlink 
     <$> disallowNewline ("<" *> takeUntil ">")
 
 markdownLink :: Parser (DocH mod a)
@@ -759,7 +797,7 @@ linkParser :: Parser Hyperlink
 linkParser = flip Hyperlink <$> label <*> (whitespace *> url)
   where
     label :: Parser (Maybe String)
-    label = Just . strip . decode <$> ("[" *> takeUntil "]")
+    label = Just . decode . T.strip <$> ("[" *> takeUntil "]")
 
     whitespace :: Parser ()
     whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace)
@@ -770,19 +808,25 @@ linkParser = flip Hyperlink <$> label <*> (whitespace *> url)
     rejectWhitespace :: MonadPlus m => m String -> m String
     rejectWhitespace = mfilter (all (not . isSpace))
 
-    decode :: BS.ByteString -> String
-    decode = removeEscapes . decodeUtf8
+    decode :: Text -> String
+    decode = T.unpack . removeEscapes
 
 -- | Looks for URL-like things to automatically hyperlink even if they
 -- weren't marked as links.
 autoUrl :: Parser (DocH mod a)
 autoUrl = mkLink <$> url
   where
-    url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace)
-    mkLink :: BS.ByteString -> DocH mod a
-    mkLink s = case unsnoc s of
-      Just (xs, x) | inClass ",.!?" x -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x]
-      _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing)
+    url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (Parsec.satisfy (not . isSpace))
+    
+    mkLink :: Text -> DocH mod a
+    mkLink s = case T.unsnoc s of
+      Just (xs,x) | x `elem` (",.!?" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x]
+      _ -> DocHyperlink (mkHyperlink s)
+
+    mkHyperlink :: Text -> Hyperlink
+    mkHyperlink lnk = Hyperlink (T.unpack lnk) Nothing
+
+
 
 -- | Parses strings between identifier delimiters. Consumes all input that it
 -- deems to be valid in an identifier. Note that it simply blindly consumes
@@ -790,14 +834,14 @@ autoUrl = mkLink <$> url
 parseValid :: Parser String
 parseValid = p some
   where
-    idChar = satisfyUnicode (\c -> isAlphaNum c || isSymbolChar c || c == '_')
+    idChar = Parsec.satisfy (\c -> isAlphaNum c || isSymbolChar c || c == '_')
 
     p p' = do
       vs <- p' idChar
       c <- peekChar'
       case c of
         '`' -> return vs
-        '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> p many') <|> return vs
+        '\'' -> choice' [ (\x -> vs ++ "'" ++ x) <$> ("'" *> p many), return vs ]
         _ -> fail "outofvalid"
 
 -- | Parses identifiers with help of 'parseValid'. Asks GHC for
@@ -809,4 +853,4 @@ identifier = do
   e <- idDelim
   return $ DocIdentifier (o, vid, e)
   where
-    idDelim = satisfy (\c -> c == '\'' || c == '`')
+    idDelim = Parsec.satisfy (\c -> c == '\'' || c == '`')
diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
index ff6101da..585c76bb 100644
--- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
@@ -1,48 +1,24 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
-module Documentation.Haddock.Parser.Monad (
-  module Documentation.Haddock.Parser.Monad
-, Attoparsec.isDigit
-, Attoparsec.isDigit_w8
-, Attoparsec.isAlpha_iso8859_15
-, Attoparsec.isAlpha_ascii
-, Attoparsec.isSpace
-, Attoparsec.isSpace_w8
-, Attoparsec.inClass
-, Attoparsec.notInClass
-, Attoparsec.isEndOfLine
-, Attoparsec.isHorizontalSpace
-, Attoparsec.choice
-, Attoparsec.count
-, Attoparsec.option
-, Attoparsec.many'
-, Attoparsec.many1
-, Attoparsec.many1'
-, Attoparsec.manyTill
-, Attoparsec.manyTill'
-, Attoparsec.sepBy
-, Attoparsec.sepBy'
-, Attoparsec.sepBy1
-, Attoparsec.sepBy1'
-, Attoparsec.skipMany
-, Attoparsec.skipMany1
-, Attoparsec.eitherP
-) where
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.String
-import           Data.ByteString (ByteString, length)
-import qualified Data.ByteString.Lazy as LB
-import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
-import qualified Data.Attoparsec.Combinator as Attoparsec
-import           Control.Monad.Trans.State
-import qualified Control.Monad.Trans.Class as Trans
-import           Data.Word
-import           Data.Bits
-import           Data.Tuple
-
-import           Documentation.Haddock.Types (Version)
-import           Documentation.Haddock.Utf8  (encodeUtf8, decodeUtf8)
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Documentation.Haddock.Parser.Monad where
+
+import qualified Text.Parsec.Char as Parsec
+import qualified Text.Parsec as Parsec
+
+import qualified Data.Text as T
+import           Data.Text                   ( Text )
+
+import           Data.String                 ( IsString(..) )
+import           Data.Bits                   ( Bits(..) )
+import           Data.Char                   ( ord )
+import           Data.List                   ( foldl' )
+
+import           Documentation.Haddock.Types ( Version )
 
 newtype ParserState = ParserState {
   parserStateSince :: Maybe Version
@@ -51,120 +27,65 @@ newtype ParserState = ParserState {
 initialParserState :: ParserState
 initialParserState = ParserState Nothing
 
-newtype Parser a = Parser (StateT ParserState Attoparsec.Parser a)
-  deriving (Functor, Applicative, Alternative, Monad, MonadPlus)
-
-instance (a ~ ByteString) => IsString (Parser a) where
-  fromString = lift . fromString
-
-parseOnly :: Parser a -> ByteString -> Either String (ParserState, a)
-parseOnly (Parser p) = fmap swap . Attoparsec.parseOnly (runStateT p initialParserState)
+setSince :: Version -> Parser ()
+setSince since = Parsec.modifyState (\st -> st {parserStateSince = Just since})
 
-lift :: Attoparsec.Parser a -> Parser a
-lift = Parser . Trans.lift
+type Parser = Parsec.Parsec Text ParserState
 
-setParserState :: ParserState -> Parser ()
-setParserState = Parser . put
+instance (a ~ Text) => IsString (Parser a) where
+  fromString = fmap T.pack . Parsec.string
 
-setSince :: Version -> Parser ()
-setSince since = Parser $ modify (\st -> st {parserStateSince = Just since})
-
-char :: Char -> Parser Char
-char = lift . Attoparsec.char
-
-char8 :: Char -> Parser Word8
-char8 = lift . Attoparsec.char8
-
--- | Peek a unicode character and return the number of bytes that it took up
-peekUnicode :: Parser (Char, Int)
-peekUnicode = lift $ Attoparsec.lookAhead $ do
-  
-  -- attoparsec's take fails on shorter inputs rather than truncate
-  bs <- Attoparsec.choice (map Attoparsec.take [4,3,2,1])
-  
-  let c = head . decodeUtf8 $ bs
-      n = Data.ByteString.length . encodeUtf8 $ [c]
-  pure (c, fromIntegral n)
-
--- | Like 'satisfy', but consuming a unicode character
-satisfyUnicode :: (Char -> Bool) -> Parser Char
-satisfyUnicode predicate = do
-  (c,n) <- peekUnicode
-  if predicate c
-    then Documentation.Haddock.Parser.Monad.take n *> pure c
-    else fail "satsifyUnicode"
-
-anyChar :: Parser Char
-anyChar = lift Attoparsec.anyChar
-
-notChar :: Char -> Parser Char
-notChar = lift . Attoparsec.notChar
-
-satisfy :: (Char -> Bool) -> Parser Char
-satisfy = lift . Attoparsec.satisfy
+parseOnly :: Parser a -> Text -> Either String (ParserState, a)
+parseOnly p t = case Parsec.runParser p' initialParserState "" t of
+                  Left e -> Left (show e)
+                  Right (x,s) -> Right (s,x)
+  where p' = (,) <$> p <*> Parsec.getState
 
+-- | Always succeeds, but returns 'Nothing' if at the end of input. Does not
+-- consume input.
 peekChar :: Parser (Maybe Char)
-peekChar = lift Attoparsec.peekChar
+peekChar = Parsec.optionMaybe . Parsec.try . Parsec.lookAhead $ Parsec.anyChar
 
+-- | Fails if at the end of input. Does not consume input.
 peekChar' :: Parser Char
-peekChar' = lift Attoparsec.peekChar'
-
-digit :: Parser Char
-digit = lift Attoparsec.digit
-
-letter_iso8859_15 :: Parser Char
-letter_iso8859_15 = lift Attoparsec.letter_iso8859_15
-
-letter_ascii :: Parser Char
-letter_ascii = lift Attoparsec.letter_ascii
-
-space :: Parser Char
-space = lift Attoparsec.space
-
-string :: ByteString -> Parser ByteString
-string = lift . Attoparsec.string
-
-stringCI :: ByteString -> Parser ByteString
-stringCI = lift . Attoparsec.stringCI
-
-skipSpace :: Parser ()
-skipSpace = lift Attoparsec.skipSpace
-
-skipWhile :: (Char -> Bool) -> Parser ()
-skipWhile = lift . Attoparsec.skipWhile
-
-take :: Int -> Parser ByteString
-take = lift . Attoparsec.take
-
-scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString
-scan s = lift . Attoparsec.scan s
-
-takeWhile :: (Char -> Bool) -> Parser ByteString
-takeWhile = lift . Attoparsec.takeWhile
-
-takeWhile1 :: (Char -> Bool) -> Parser ByteString
-takeWhile1 = lift . Attoparsec.takeWhile1
-
-takeTill :: (Char -> Bool) -> Parser ByteString
-takeTill = lift . Attoparsec.takeTill
-
-takeByteString :: Parser ByteString
-takeByteString = lift Attoparsec.takeByteString
-
-takeLazyByteString :: Parser LB.ByteString
-takeLazyByteString = lift Attoparsec.takeLazyByteString
-
-endOfLine :: Parser ()
-endOfLine = lift Attoparsec.endOfLine
-
+peekChar' = Parsec.lookAhead Parsec.anyChar 
+
+-- | Parses the given string. Returns the parsed string.
+string :: Text -> Parser Text
+string t = Parsec.string (T.unpack t) *> pure t
+
+-- | Scan the input text, accumulating characters as long as the scanning
+-- function returns true.
+scan :: (s -> Char -> Maybe s) -- ^ scan function
+     -> s                      -- ^ initial state
+     -> Parser Text 
+scan f = fmap T.pack . go
+  where go s1 = do { cOpt <- peekChar
+                   ; case cOpt >>= f s1 of
+                       Nothing -> pure ""
+                       Just s2 -> (:) <$> Parsec.anyChar <*> go s2
+                   }
+
+-- | Apply a parser for a character zero or more times and collect the result in
+-- a string.
+takeWhile :: Parser Char -> Parser Text
+takeWhile = fmap T.pack . Parsec.many
+
+-- | Apply a parser for a character one or more times and collect the result in
+-- a string.
+takeWhile1 :: Parser Char -> Parser Text
+takeWhile1 =  fmap T.pack . Parsec.many1
+
+-- | Parse a decimal number.
 decimal :: Integral a => Parser a
-decimal = lift Attoparsec.decimal
+decimal = foldl' step 0 `fmap` Parsec.many1 Parsec.digit
+  where step a c = a * 10 + fromIntegral (ord c - 48)
 
+-- | Parse a hexadecimal number.
 hexadecimal :: (Integral a, Bits a) => Parser a
-hexadecimal = lift Attoparsec.hexadecimal
-
-endOfInput :: Parser ()
-endOfInput = lift Attoparsec.endOfInput
-
-atEnd :: Parser Bool
-atEnd = lift Attoparsec.atEnd
+hexadecimal = foldl' step 0 `fmap` Parsec.many1 Parsec.hexDigit 
+  where
+  step a c | w >= 48 && w <= 57  = (a `shiftL` 4) .|. fromIntegral (w - 48)
+           | w >= 97             = (a `shiftL` 4) .|. fromIntegral (w - 87)
+           | otherwise           = (a `shiftL` 4) .|. fromIntegral (w - 55)
+    where w = ord c
diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs
index ab5e5e9e..ffa91b09 100644
--- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 -- |
 -- Module      :  Documentation.Haddock.Parser.Util
 -- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,
@@ -11,62 +11,59 @@
 --
 -- Various utility functions used by the parser.
 module Documentation.Haddock.Parser.Util (
-  unsnoc
-, strip
-, takeUntil
-, removeEscapes
-, makeLabeled
-, takeHorizontalSpace
-, skipHorizontalSpace
+  takeUntil,
+  removeEscapes,
+  makeLabeled,
+  takeHorizontalSpace,
+  skipHorizontalSpace,
 ) where
 
+import qualified Text.Parsec as Parsec
+
+import qualified Data.Text as T
+import           Data.Text (Text)
+
 import           Control.Applicative
 import           Control.Monad (mfilter)
-import           Documentation.Haddock.Parser.Monad hiding (isHorizontalSpace)
-import           Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as BS
+import           Documentation.Haddock.Parser.Monad
 import           Prelude hiding (takeWhile)
 
-#if MIN_VERSION_bytestring(0,10,2)
-import           Data.ByteString.Char8 (unsnoc)
-#else
-unsnoc :: ByteString -> Maybe (ByteString, Char)
-unsnoc bs
-  | BS.null bs = Nothing
-  | otherwise = Just (BS.init bs, BS.last bs)
-#endif
+import           Data.Char (isSpace)
 
--- | Remove all leading and trailing whitespace
-strip :: String -> String
-strip = (\f -> f . f) $ dropWhile isSpace . reverse
-
-isHorizontalSpace :: Char -> Bool
-isHorizontalSpace = inClass " \t\f\v\r"
+-- | Characters that count as horizontal space
+horizontalSpace :: [Char]
+horizontalSpace = " \t\f\v\r"
 
+-- | Skip and ignore leading horizontal space
 skipHorizontalSpace :: Parser ()
-skipHorizontalSpace = skipWhile isHorizontalSpace
+skipHorizontalSpace = Parsec.skipMany (Parsec.oneOf horizontalSpace)
 
-takeHorizontalSpace :: Parser BS.ByteString
-takeHorizontalSpace = takeWhile isHorizontalSpace
+-- | Take leading horizontal space
+takeHorizontalSpace :: Parser Text 
+takeHorizontalSpace = takeWhile (Parsec.oneOf horizontalSpace)
 
-makeLabeled :: (String -> Maybe String -> a) -> String -> a
-makeLabeled f input = case break isSpace $ removeEscapes $ strip input of
-  (uri, "")    -> f uri Nothing
-  (uri, label) -> f uri (Just $ dropWhile isSpace label)
+makeLabeled :: (String -> Maybe String -> a) -> Text -> a
+makeLabeled f input = case T.break isSpace $ removeEscapes $ T.strip input of
+  (uri, "")    -> f (T.unpack uri) Nothing
+  (uri, label) -> f (T.unpack uri) (Just . T.unpack $ T.stripStart label)
 
 -- | Remove escapes from given string.
 --
 -- Only do this if you do not process (read: parse) the input any further.
-removeEscapes :: String -> String
-removeEscapes "" = ""
-removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs
-removeEscapes ('\\':xs) = removeEscapes xs
-removeEscapes (x:xs) = x : removeEscapes xs
+removeEscapes :: Text -> Text
+removeEscapes = T.unfoldr go
+  where
+  go :: Text -> Maybe (Char, Text)
+  go xs = case T.uncons xs of
+            Just ('\\',ys) -> T.uncons ys
+            unconsed -> unconsed
 
-takeUntil :: ByteString -> Parser ByteString
-takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome
+-- | Consume characters from the input up to and including the given pattern.
+-- Return everything consumed except for the end pattern itself.
+takeUntil :: Text -> Parser Text 
+takeUntil end_ = T.dropEnd (T.length end_) <$> requireEnd (scan p (False, end)) >>= gotSome
   where
-    end = BS.unpack end_
+    end = T.unpack end_ 
 
     p :: (Bool, String) -> Char -> Maybe (Bool, String)
     p acc c = case acc of
@@ -75,9 +72,8 @@ takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome
       (_, x:xs) | x == c -> Just (False, xs)
       _ -> Just (c == '\\', end)
 
-    dropEnd = BS.reverse . BS.drop (length end) . BS.reverse
-    requireEnd = mfilter (BS.isSuffixOf end_)
+    requireEnd = mfilter (T.isSuffixOf end_)
 
     gotSome xs
-      | BS.null xs = fail "didn't get any content"
+      | T.null xs = fail "didn't get any content"
       | otherwise = return xs
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs
deleted file mode 100644
index bd3c5592..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- |
--- Module      :  Data.Attoparsec
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient combinator parsing for
--- 'Data.ByteString.ByteString' strings, loosely based on the Parsec
--- library.
---
--- This module is deprecated. Use "Data.Attoparsec.ByteString"
--- instead.
-
-module Data.Attoparsec
-    {-# DEPRECATED "This module will be removed in the next major release." #-}
-    (
-      module Data.Attoparsec.ByteString
-    ) where
-
-import Data.Attoparsec.ByteString
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs
deleted file mode 100644
index 84e567d9..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs
+++ /dev/null
@@ -1,230 +0,0 @@
-{-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-}
-#endif
--- |
--- Module      :  Data.Attoparsec.ByteString
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient combinator parsing for 'B.ByteString' strings,
--- loosely based on the Parsec library.
-
-module Data.Attoparsec.ByteString
-    (
-    -- * Differences from Parsec
-    -- $parsec
-
-    -- * Incremental input
-    -- $incremental
-
-    -- * Performance considerations
-    -- $performance
-
-    -- * Parser types
-      I.Parser
-    , Result
-    , T.IResult(..)
-    , I.compareResults
-
-    -- * Running parsers
-    , parse
-    , feed
-    , I.parseOnly
-    , parseWith
-    , parseTest
-
-    -- ** Result conversion
-    , maybeResult
-    , eitherResult
-
-    -- * Parsing individual bytes
-    , I.word8
-    , I.anyWord8
-    , I.notWord8
-    , I.satisfy
-    , I.satisfyWith
-    , I.skip
-
-    -- ** Lookahead
-    , I.peekWord8
-    , I.peekWord8'
-
-    -- ** Byte classes
-    , I.inClass
-    , I.notInClass
-
-    -- * Efficient string handling
-    , I.string
-    , I.skipWhile
-    , I.take
-    , I.scan
-    , I.runScanner
-    , I.takeWhile
-    , I.takeWhile1
-    , I.takeTill
-
-    -- ** Consume all remaining input
-    , I.takeByteString
-    , I.takeLazyByteString
-
-    -- * Combinators
-    , try
-    , ()
-    , choice
-    , count
-    , option
-    , many'
-    , many1
-    , many1'
-    , manyTill
-    , manyTill'
-    , sepBy
-    , sepBy'
-    , sepBy1
-    , sepBy1'
-    , skipMany
-    , skipMany1
-    , eitherP
-    , I.match
-    -- * State observation and manipulation functions
-    , I.endOfInput
-    , I.atEnd
-    ) where
-
-import Data.Attoparsec.Combinator
-import Data.List (intercalate)
-import qualified Data.Attoparsec.ByteString.Internal as I
-import qualified Data.Attoparsec.Internal as I
-import qualified Data.ByteString as B
-import Data.Attoparsec.ByteString.Internal (Result, parse)
-import qualified Data.Attoparsec.Internal.Types as T
-
--- $parsec
---
--- Compared to Parsec 3, attoparsec makes several tradeoffs.  It is
--- not intended for, or ideal for, all possible uses.
---
--- * While attoparsec can consume input incrementally, Parsec cannot.
---   Incremental input is a huge deal for efficient and secure network
---   and system programming, since it gives much more control to users
---   of the library over matters such as resource usage and the I/O
---   model to use.
---
--- * Much of the performance advantage of attoparsec is gained via
---   high-performance parsers such as 'I.takeWhile' and 'I.string'.
---   If you use complicated combinators that return lists of bytes or
---   characters, there is less performance difference between the two
---   libraries.
---
--- * Unlike Parsec 3, attoparsec does not support being used as a
---   monad transformer.
---
--- * attoparsec is specialised to deal only with strict 'B.ByteString'
---   input.  Efficiency concerns rule out both lists and lazy
---   bytestrings.  The usual use for lazy bytestrings would be to
---   allow consumption of very large input without a large footprint.
---   For this need, attoparsec's incremental input provides an
---   excellent substitute, with much more control over when input
---   takes place.  If you must use lazy bytestrings, see the
---   "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks
---   to a regular parser.
---
--- * Parsec parsers can produce more helpful error messages than
---   attoparsec parsers.  This is a matter of focus: attoparsec avoids
---   the extra book-keeping in favour of higher performance.
-
--- $incremental
---
--- attoparsec supports incremental input, meaning that you can feed it
--- a bytestring that represents only part of the expected total amount
--- of data to parse. If your parser reaches the end of a fragment of
--- input and could consume more input, it will suspend parsing and
--- return a 'T.Partial' continuation.
---
--- Supplying the 'T.Partial' continuation with a bytestring will
--- resume parsing at the point where it was suspended, with the
--- bytestring you supplied used as new input at the end of the
--- existing input. You must be prepared for the result of the resumed
--- parse to be another 'T.Partial' continuation.
---
--- To indicate that you have no more input, supply the 'T.Partial'
--- continuation with an empty bytestring.
---
--- Remember that some parsing combinators will not return a result
--- until they reach the end of input.  They may thus cause 'T.Partial'
--- results to be returned.
---
--- If you do not need support for incremental input, consider using
--- the 'I.parseOnly' function to run your parser.  It will never
--- prompt for more input.
---
--- /Note/: incremental input does /not/ imply that attoparsec will
--- release portions of its internal state for garbage collection as it
--- proceeds.  Its internal representation is equivalent to a single
--- 'ByteString': if you feed incremental input to a parser, it will
--- require memory proportional to the amount of input you supply.
--- (This is necessary to support arbitrary backtracking.)
-
--- $performance
---
--- If you write an attoparsec-based parser carefully, it can be
--- realistic to expect it to perform similarly to a hand-rolled C
--- parser (measuring megabytes parsed per second).
---
--- To actually achieve high performance, there are a few guidelines
--- that it is useful to follow.
---
--- Use the 'B.ByteString'-oriented parsers whenever possible,
--- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'.  There is
--- about a factor of 100 difference in performance between the two
--- kinds of parser.
---
--- For very simple byte-testing predicates, write them by hand instead
--- of using 'I.inClass' or 'I.notInClass'.  For instance, both of
--- these predicates test for an end-of-line byte, but the first is
--- much faster than the second:
---
--- >endOfLine_fast w = w == 13 || w == 10
--- >endOfLine_slow   = inClass "\r\n"
---
--- Make active use of benchmarking and profiling tools to measure,
--- find the problems with, and improve the performance of your parser.
-
--- | Run a parser and print its result to standard output.
-parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO ()
-parseTest p s = print (parse p s)
-
--- | Run a parser with an initial input string, and a monadic action
--- that can supply more input if needed.
-parseWith :: Monad m =>
-             (m B.ByteString)
-          -- ^ An action that will be executed to provide the parser
-          -- with more input, if necessary.  The action must return an
-          -- 'B.empty' string when there is no more input available.
-          -> I.Parser a
-          -> B.ByteString
-          -- ^ Initial input for the parser.
-          -> m (Result a)
-parseWith refill p s = step $ parse p s
-  where step (T.Partial k) = (step . k) =<< refill
-        step r             = return r
-{-# INLINE parseWith #-}
-
--- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result
--- is treated as failure.
-maybeResult :: Result r -> Maybe r
-maybeResult (T.Done _ r) = Just r
-maybeResult _            = Nothing
-
--- | Convert a 'Result' value to an 'Either' value. A 'T.Partial'
--- result is treated as failure.
-eitherResult :: Result r -> Either String r
-eitherResult (T.Done _ r)        = Right r
-eitherResult (T.Fail _ [] msg)   = Left msg
-eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)
-eitherResult _                   = Left "Result: incomplete input"
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs
deleted file mode 100644
index ac94dfcc..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
--- |
--- Module      :  Data.Attoparsec.ByteString.Buffer
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  GHC
---
--- An "immutable" buffer that supports cheap appends.
---
--- A Buffer is divided into an immutable read-only zone, followed by a
--- mutable area that we've preallocated, but not yet written to.
---
--- We overallocate at the end of a Buffer so that we can cheaply
--- append.  Since a user of an existing Buffer cannot see past the end
--- of its immutable zone into the data that will change during an
--- append, this is safe.
---
--- Once we run out of space at the end of a Buffer, we do the usual
--- doubling of the buffer size.
---
--- The fact of having a mutable buffer really helps with performance,
--- but it does have a consequence: if someone misuses the Partial API
--- that attoparsec uses by calling the same continuation repeatedly
--- (which never makes sense in practice), they could overwrite data.
---
--- Since the API *looks* pure, it should *act* pure, too, so we use
--- two generation counters (one mutable, one immutable) to track the
--- number of appends to a mutable buffer. If the counters ever get out
--- of sync, someone is appending twice to a mutable buffer, so we
--- duplicate the entire buffer in order to preserve the immutability
--- of its older self.
---
--- While we could go a step further and gain protection against API
--- abuse on a multicore system, by use of an atomic increment
--- instruction to bump the mutable generation counter, that would be
--- very expensive, and feels like it would also be in the realm of the
--- ridiculous.  Clients should never call a continuation more than
--- once; we lack a linear type system that could enforce this; and
--- there's only so far we should go to accommodate broken uses.
-
-module Data.Attoparsec.ByteString.Buffer
-    (
-      Buffer
-    , buffer
-    , unbuffer
-    , pappend
-    , length
-    , unsafeIndex
-    , substring
-    , unsafeDrop
-    ) where
-
-import Control.Exception (assert)
-import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
-import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
-import Data.List (foldl1')
-import Data.Monoid as Mon (Monoid(..))
-import Data.Semigroup (Semigroup(..))
-import Data.Word (Word8)
-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
-import Foreign.Ptr (castPtr, plusPtr)
-import Foreign.Storable (peek, peekByteOff, poke, sizeOf)
-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
-import Prelude hiding (length)
-
--- If _cap is zero, this buffer is empty.
-data Buffer = Buf {
-      _fp  :: {-# UNPACK #-} !(ForeignPtr Word8)
-    , _off :: {-# UNPACK #-} !Int
-    , _len :: {-# UNPACK #-} !Int
-    , _cap :: {-# UNPACK #-} !Int
-    , _gen :: {-# UNPACK #-} !Int
-    }
-
-instance Show Buffer where
-    showsPrec p = showsPrec p . unbuffer
-
--- | The initial 'Buffer' has no mutable zone, so we can avoid all
--- copies in the (hopefully) common case of no further input being fed
--- to us.
-buffer :: ByteString -> Buffer
-buffer (PS fp off len) = Buf fp off len len 0
-
-unbuffer :: Buffer -> ByteString
-unbuffer (Buf fp off len _ _) = PS fp off len
-
-instance Semigroup Buffer where
-    (Buf _ _ _ 0 _) <> b                    = b
-    a               <> (Buf _ _ _ 0 _)      = a
-    buf             <> (Buf fp off len _ _) = append buf fp off len
-
-instance Monoid Buffer where
-    mempty = Buf nullForeignPtr 0 0 0 0
-
-    mappend = (<>)
-
-    mconcat [] = Mon.mempty
-    mconcat xs = foldl1' mappend xs
-
-pappend :: Buffer -> ByteString -> Buffer
-pappend (Buf _ _ _ 0 _) bs  = buffer bs
-pappend buf (PS fp off len) = append buf fp off len
-
-append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer
-append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =
-  inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
-    withForeignPtr fp1 $ \ptr1 -> do
-      let genSize = sizeOf (0::Int)
-          newlen  = len0 + len1
-      gen <- if gen0 == 0
-             then return 0
-             else peek (castPtr ptr0)
-      if gen == gen0 && newlen <= cap0
-        then do
-          let newgen = gen + 1
-          poke (castPtr ptr0) newgen
-          memcpy (ptr0 `plusPtr` (off0+len0))
-                 (ptr1 `plusPtr` off1)
-                 (fromIntegral len1)
-          return (Buf fp0 off0 newlen cap0 newgen)
-        else do
-          let newcap = newlen * 2
-          fp <- mallocPlainForeignPtrBytes (newcap + genSize)
-          withForeignPtr fp $ \ptr_ -> do
-            let ptr    = ptr_ `plusPtr` genSize
-                newgen = 1
-            poke (castPtr ptr_) newgen
-            memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)
-            memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)
-                   (fromIntegral len1)
-            return (Buf fp genSize newlen newcap newgen)
-
-length :: Buffer -> Int
-length (Buf _ _ len _ _) = len
-{-# INLINE length #-}
-
-unsafeIndex :: Buffer -> Int -> Word8
-unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .
-    inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)
-{-# INLINE unsafeIndex #-}
-
-substring :: Int -> Int -> Buffer -> ByteString
-substring s l (Buf fp off len _ _) =
-  assert (s >= 0 && s <= len) .
-  assert (l >= 0 && l <= len-s) $
-  PS fp (off+s) l
-{-# INLINE substring #-}
-
-unsafeDrop :: Int -> Buffer -> ByteString
-unsafeDrop s (Buf fp off len _ _) =
-  assert (s >= 0 && s <= len) $
-  PS fp (off+s) (len-s)
-{-# INLINE unsafeDrop #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs
deleted file mode 100644
index 7fafba40..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs
+++ /dev/null
@@ -1,464 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies,
-    TypeSynonymInstances, GADTs #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-} -- Imports internal modules
-#endif
-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}
-
--- |
--- Module      :  Data.Attoparsec.ByteString.Char8
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient, character-oriented combinator parsing for
--- 'B.ByteString' strings, loosely based on the Parsec library.
-
-module Data.Attoparsec.ByteString.Char8
-    (
-    -- * Character encodings
-    -- $encodings
-
-    -- * Parser types
-      Parser
-    , A.Result
-    , A.IResult(..)
-    , I.compareResults
-
-    -- * Running parsers
-    , A.parse
-    , A.feed
-    , A.parseOnly
-    , A.parseWith
-    , A.parseTest
-
-    -- ** Result conversion
-    , A.maybeResult
-    , A.eitherResult
-
-    -- * Parsing individual characters
-    , char
-    , char8
-    , anyChar
-    , notChar
-    , satisfy
-
-    -- ** Lookahead
-    , peekChar
-    , peekChar'
-
-    -- ** Special character parsers
-    , digit
-    , letter_iso8859_15
-    , letter_ascii
-    , space
-
-    -- ** Fast predicates
-    , isDigit
-    , isDigit_w8
-    , isAlpha_iso8859_15
-    , isAlpha_ascii
-    , isSpace
-    , isSpace_w8
-
-    -- *** Character classes
-    , inClass
-    , notInClass
-
-    -- * Efficient string handling
-    , I.string
-    , I.stringCI
-    , skipSpace
-    , skipWhile
-    , I.take
-    , scan
-    , takeWhile
-    , takeWhile1
-    , takeTill
-
-    -- ** String combinators
-    -- $specalt
-    , (.*>)
-    , (<*.)
-
-    -- ** Consume all remaining input
-    , I.takeByteString
-    , I.takeLazyByteString
-
-    -- * Text parsing
-    , I.endOfLine
-    , isEndOfLine
-    , isHorizontalSpace
-
-    -- * Numeric parsers
-    , decimal
-    , hexadecimal
-    , signed
-
-    -- * Combinators
-    , try
-    , ()
-    , choice
-    , count
-    , option
-    , many'
-    , many1
-    , many1'
-    , manyTill
-    , manyTill'
-    , sepBy
-    , sepBy'
-    , sepBy1
-    , sepBy1'
-    , skipMany
-    , skipMany1
-    , eitherP
-    , I.match
-    -- * State observation and manipulation functions
-    , I.endOfInput
-    , I.atEnd
-    ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative (pure, (*>), (<*), (<$>))
-import Data.Word (Word)
-#endif
-import Control.Applicative ((<|>))
-import Data.Attoparsec.ByteString.FastSet (charClass, memberChar)
-import Data.Attoparsec.ByteString.Internal (Parser)
-import Data.Attoparsec.Combinator
-import Data.Bits (Bits, (.|.), shiftL)
-import Data.ByteString.Internal (c2w, w2c)
-import Data.Int (Int8, Int16, Int32, Int64)
-import Data.String (IsString(..))
-import Data.Word (Word8, Word16, Word32, Word64)
-import Prelude hiding (takeWhile)
-import qualified Data.Attoparsec.ByteString as A
-import qualified Data.Attoparsec.ByteString.Internal as I
-import qualified Data.Attoparsec.Internal as I
-import qualified Data.ByteString as B8
-import qualified Data.ByteString.Char8 as B
-
-instance (a ~ B.ByteString) => IsString (Parser a) where
-    fromString = I.string . B.pack
-
--- $encodings
---
--- This module is intended for parsing text that is
--- represented using an 8-bit character set, e.g. ASCII or
--- ISO-8859-15.  It /does not/ make any attempt to deal with character
--- encodings, multibyte characters, or wide characters.  In
--- particular, all attempts to use characters above code point U+00FF
--- will give wrong answers.
---
--- Code points below U+0100 are simply translated to and from their
--- numeric values, so e.g. the code point U+00A4 becomes the byte
--- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic
--- currency sign in ISO-8859-1).  Haskell 'Char' values above U+00FF
--- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@.
-
--- | Consume input as long as the predicate returns 'True', and return
--- the consumed input.
---
--- This parser requires the predicate to succeed on at least one byte
--- of input: it will fail if the predicate never returns 'True' or if
--- there is no input left.
-takeWhile1 :: (Char -> Bool) -> Parser B.ByteString
-takeWhile1 p = I.takeWhile1 (p . w2c)
-{-# INLINE takeWhile1 #-}
-
--- | The parser @satisfy p@ succeeds for any byte for which the
--- predicate @p@ returns 'True'. Returns the byte that is actually
--- parsed.
---
--- >digit = satisfy isDigit
--- >    where isDigit c = c >= '0' && c <= '9'
-satisfy :: (Char -> Bool) -> Parser Char
-satisfy = I.satisfyWith w2c
-{-# INLINE satisfy #-}
-
--- | Match a letter, in the ISO-8859-15 encoding.
-letter_iso8859_15 :: Parser Char
-letter_iso8859_15 = satisfy isAlpha_iso8859_15  "letter_iso8859_15"
-{-# INLINE letter_iso8859_15 #-}
-
--- | Match a letter, in the ASCII encoding.
-letter_ascii :: Parser Char
-letter_ascii = satisfy isAlpha_ascii  "letter_ascii"
-{-# INLINE letter_ascii #-}
-
--- | A fast alphabetic predicate for the ISO-8859-15 encoding
---
--- /Note/: For all character encodings other than ISO-8859-15, and
--- almost all Unicode code points above U+00A3, this predicate gives
--- /wrong answers/.
-isAlpha_iso8859_15 :: Char -> Bool
-isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
-                       (c >= '\166' && moby c)
-  where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247"
-        {-# NOINLINE moby #-}
-{-# INLINE isAlpha_iso8859_15 #-}
-
--- | A fast alphabetic predicate for the ASCII encoding
---
--- /Note/: For all character encodings other than ASCII, and
--- almost all Unicode code points above U+007F, this predicate gives
--- /wrong answers/.
-isAlpha_ascii :: Char -> Bool
-isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
-{-# INLINE isAlpha_ascii #-}
-
--- | Parse a single digit.
-digit :: Parser Char
-digit = satisfy isDigit  "digit"
-{-# INLINE digit #-}
-
--- | A fast digit predicate.
-isDigit :: Char -> Bool
-isDigit c = c >= '0' && c <= '9'
-{-# INLINE isDigit #-}
-
--- | A fast digit predicate.
-isDigit_w8 :: Word8 -> Bool
-isDigit_w8 w = w - 48 <= 9
-{-# INLINE isDigit_w8 #-}
-
--- | Match any character.
-anyChar :: Parser Char
-anyChar = satisfy $ const True
-{-# INLINE anyChar #-}
-
--- | Match any character, to perform lookahead. Returns 'Nothing' if
--- end of input has been reached. Does not consume any input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'many', because such parsers loop until a
--- failure occurs.  Careless use will thus result in an infinite loop.
-peekChar :: Parser (Maybe Char)
-peekChar = (fmap w2c) `fmap` I.peekWord8
-{-# INLINE peekChar #-}
-
--- | Match any character, to perform lookahead.  Does not consume any
--- input, but will fail if end of input has been reached.
-peekChar' :: Parser Char
-peekChar' = w2c `fmap` I.peekWord8'
-{-# INLINE peekChar' #-}
-
--- | Fast predicate for matching ASCII space characters.
---
--- /Note/: This predicate only gives correct answers for the ASCII
--- encoding.  For instance, it does not recognise U+00A0 (non-breaking
--- space) as a space character, even though it is a valid ISO-8859-15
--- byte. For a Unicode-aware and only slightly slower predicate,
--- use 'Data.Char.isSpace'
-isSpace :: Char -> Bool
-isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
-{-# INLINE isSpace #-}
-
--- | Fast 'Word8' predicate for matching ASCII space characters.
-isSpace_w8 :: Word8 -> Bool
-isSpace_w8 w = w == 32 || w - 9 <= 4
-{-# INLINE isSpace_w8 #-}
-
-
--- | Parse a space character.
---
--- /Note/: This parser only gives correct answers for the ASCII
--- encoding.  For instance, it does not recognise U+00A0 (non-breaking
--- space) as a space character, even though it is a valid ISO-8859-15
--- byte.
-space :: Parser Char
-space = satisfy isSpace  "space"
-{-# INLINE space #-}
-
--- | Match a specific character.
-char :: Char -> Parser Char
-char c = satisfy (== c)  [c]
-{-# INLINE char #-}
-
--- | Match a specific character, but return its 'Word8' value.
-char8 :: Char -> Parser Word8
-char8 c = I.satisfy (== c2w c)  [c]
-{-# INLINE char8 #-}
-
--- | Match any character except the given one.
-notChar :: Char -> Parser Char
-notChar c = satisfy (/= c)  "not " ++ [c]
-{-# INLINE notChar #-}
-
--- | Match any character in a set.
---
--- >vowel = inClass "aeiou"
---
--- Range notation is supported.
---
--- >halfAlphabet = inClass "a-nA-N"
---
--- To add a literal \'-\' to a set, place it at the beginning or end
--- of the string.
-inClass :: String -> Char -> Bool
-inClass s = (`memberChar` mySet)
-    where mySet = charClass s
-{-# INLINE inClass #-}
-
--- | Match any character not in a set.
-notInClass :: String -> Char -> Bool
-notInClass s = not . inClass s
-{-# INLINE notInClass #-}
-
--- | Consume input as long as the predicate returns 'True', and return
--- the consumed input.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'False' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'many', because such parsers loop until a
--- failure occurs.  Careless use will thus result in an infinite loop.
-takeWhile :: (Char -> Bool) -> Parser B.ByteString
-takeWhile p = I.takeWhile (p . w2c)
-{-# INLINE takeWhile #-}
-
--- | A stateful scanner.  The predicate consumes and transforms a
--- state argument, and each transformed state is passed to successive
--- invocations of the predicate on each byte of the input until one
--- returns 'Nothing' or the input ends.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'Nothing' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'many', because such parsers loop until a
--- failure occurs.  Careless use will thus result in an infinite loop.
-scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString
-scan s0 p = I.scan s0 (\s -> p s . w2c)
-{-# INLINE scan #-}
-
--- | Consume input as long as the predicate returns 'False'
--- (i.e. until it returns 'True'), and return the consumed input.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'True' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'many', because such parsers loop until a
--- failure occurs.  Careless use will thus result in an infinite loop.
-takeTill :: (Char -> Bool) -> Parser B.ByteString
-takeTill p = I.takeTill (p . w2c)
-{-# INLINE takeTill #-}
-
--- | Skip past input for as long as the predicate returns 'True'.
-skipWhile :: (Char -> Bool) -> Parser ()
-skipWhile p = I.skipWhile (p . w2c)
-{-# INLINE skipWhile #-}
-
--- | Skip over white space.
-skipSpace :: Parser ()
-skipSpace = I.skipWhile isSpace_w8
-{-# INLINE skipSpace #-}
-
--- $specalt
---
--- If you enable the @OverloadedStrings@ language extension, you can
--- use the '*>' and '<*' combinators to simplify the common task of
--- matching a statically known string, then immediately parsing
--- something else.
---
--- Instead of writing something like this:
---
--- @
---'I.string' \"foo\" '*>' wibble
--- @
---
--- Using @OverloadedStrings@, you can omit the explicit use of
--- 'I.string', and write a more compact version:
---
--- @
--- \"foo\" '*>' wibble
--- @
---
--- (Note: the '.*>' and '<*.' combinators that were originally
--- provided for this purpose are obsolete and unnecessary, and will be
--- removed in the next major version.)
-
--- | /Obsolete/. A type-specialized version of '*>' for
--- 'B.ByteString'. Use '*>' instead.
-(.*>) :: B.ByteString -> Parser a -> Parser a
-s .*> f = I.string s *> f
-{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-}
-
--- | /Obsolete/. A type-specialized version of '<*' for
--- 'B.ByteString'. Use '<*' instead.
-(<*.) :: Parser a -> B.ByteString -> Parser a
-f <*. s = f <* I.string s
-{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-}
-
--- | A predicate that matches either a carriage return @\'\\r\'@ or
--- newline @\'\\n\'@ character.
-isEndOfLine :: Word8 -> Bool
-isEndOfLine w = w == 13 || w == 10
-{-# INLINE isEndOfLine #-}
-
--- | A predicate that matches either a space @\' \'@ or horizontal tab
--- @\'\\t\'@ character.
-isHorizontalSpace :: Word8 -> Bool
-isHorizontalSpace w = w == 32 || w == 9
-{-# INLINE isHorizontalSpace #-}
-
--- | Parse and decode an unsigned hexadecimal number.  The hex digits
--- @\'a\'@ through @\'f\'@ may be upper or lower case.
---
--- This parser does not accept a leading @\"0x\"@ string.
-hexadecimal :: (Integral a, Bits a) => Parser a
-hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit
-  where
-    isHexDigit w = (w >= 48 && w <= 57) ||
-                   (w >= 97 && w <= 102) ||
-                   (w >= 65 && w <= 70)
-    step a w | w >= 48 && w <= 57  = (a `shiftL` 4) .|. fromIntegral (w - 48)
-             | w >= 97             = (a `shiftL` 4) .|. fromIntegral (w - 87)
-             | otherwise           = (a `shiftL` 4) .|. fromIntegral (w - 55)
-{-# SPECIALISE hexadecimal :: Parser Int #-}
-{-# SPECIALISE hexadecimal :: Parser Int8 #-}
-{-# SPECIALISE hexadecimal :: Parser Int16 #-}
-{-# SPECIALISE hexadecimal :: Parser Int32 #-}
-{-# SPECIALISE hexadecimal :: Parser Int64 #-}
-{-# SPECIALISE hexadecimal :: Parser Integer #-}
-{-# SPECIALISE hexadecimal :: Parser Word #-}
-{-# SPECIALISE hexadecimal :: Parser Word8 #-}
-{-# SPECIALISE hexadecimal :: Parser Word16 #-}
-{-# SPECIALISE hexadecimal :: Parser Word32 #-}
-{-# SPECIALISE hexadecimal :: Parser Word64 #-}
-
--- | Parse and decode an unsigned decimal number.
-decimal :: Integral a => Parser a
-decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8
-  where step a w = a * 10 + fromIntegral (w - 48)
-{-# SPECIALISE decimal :: Parser Int #-}
-{-# SPECIALISE decimal :: Parser Int8 #-}
-{-# SPECIALISE decimal :: Parser Int16 #-}
-{-# SPECIALISE decimal :: Parser Int32 #-}
-{-# SPECIALISE decimal :: Parser Int64 #-}
-{-# SPECIALISE decimal :: Parser Integer #-}
-{-# SPECIALISE decimal :: Parser Word #-}
-{-# SPECIALISE decimal :: Parser Word8 #-}
-{-# SPECIALISE decimal :: Parser Word16 #-}
-{-# SPECIALISE decimal :: Parser Word32 #-}
-{-# SPECIALISE decimal :: Parser Word64 #-}
-
--- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign
--- character.
-signed :: Num a => Parser a -> Parser a
-{-# SPECIALISE signed :: Parser Int -> Parser Int #-}
-{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-}
-{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-}
-{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-}
-{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-}
-{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-}
-signed p = (negate <$> (char8 '-' *> p))
-       <|> (char8 '+' *> p)
-       <|> p
-
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs
deleted file mode 100644
index d15854c4..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-# LANGUAGE BangPatterns, MagicHash #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Attoparsec.ByteString.FastSet
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Fast set membership tests for 'Word8' and 8-bit 'Char' values.  The
--- set representation is unboxed for efficiency.  For small sets, we
--- test for membership using a binary search.  For larger sets, we use
--- a lookup table.
---
------------------------------------------------------------------------------
-module Data.Attoparsec.ByteString.FastSet
-    (
-    -- * Data type
-      FastSet
-    -- * Construction
-    , fromList
-    , set
-    -- * Lookup
-    , memberChar
-    , memberWord8
-    -- * Debugging
-    , fromSet
-    -- * Handy interface
-    , charClass
-    ) where
-
-import Data.Bits ((.&.), (.|.))
-import Foreign.Storable (peekByteOff, pokeByteOff)
-import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)
-import GHC.Word (Word8(W8#))
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as B8
-import qualified Data.ByteString.Internal as I
-import qualified Data.ByteString.Unsafe as U
-
-data FastSet = Sorted { fromSet :: !B.ByteString }
-             | Table  { fromSet :: !B.ByteString }
-    deriving (Eq, Ord)
-
-instance Show FastSet where
-    show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s)
-    show (Table _) = "FastSet Table"
-
--- | The lower bound on the size of a lookup table.  We choose this to
--- balance table density against performance.
-tableCutoff :: Int
-tableCutoff = 8
-
--- | Create a set.
-set :: B.ByteString -> FastSet
-set s | B.length s < tableCutoff = Sorted . B.sort $ s
-      | otherwise                = Table . mkTable $ s
-
-fromList :: [Word8] -> FastSet
-fromList = set . B.pack
-
-data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8
-
-shiftR :: Int -> Int -> Int
-shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
-
-shiftL :: Word8 -> Int -> Word8
-shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
-
-index :: Int -> I
-index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))
-{-# INLINE index #-}
-
--- | Check the set for membership.
-memberWord8 :: Word8 -> FastSet -> Bool
-memberWord8 w (Table t)  =
-    let I byte bit = index (fromIntegral w)
-    in  U.unsafeIndex t byte .&. bit /= 0
-memberWord8 w (Sorted s) = search 0 (B.length s - 1)
-    where search lo hi
-              | hi < lo = False
-              | otherwise =
-                  let mid = (lo + hi) `quot` 2
-                  in case compare w (U.unsafeIndex s mid) of
-                       GT -> search (mid + 1) hi
-                       LT -> search lo (mid - 1)
-                       _ -> True
-
--- | Check the set for membership.  Only works with 8-bit characters:
--- characters above code point 255 will give wrong answers.
-memberChar :: Char -> FastSet -> Bool
-memberChar c = memberWord8 (I.c2w c)
-{-# INLINE memberChar #-}
-
-mkTable :: B.ByteString -> B.ByteString
-mkTable s = I.unsafeCreate 32 $ \t -> do
-            _ <- I.memset t 0 32
-            U.unsafeUseAsCStringLen s $ \(p, l) ->
-              let loop n | n == l = return ()
-                         | otherwise = do
-                    c <- peekByteOff p n :: IO Word8
-                    let I byte bit = index (fromIntegral c)
-                    prev <- peekByteOff t byte :: IO Word8
-                    pokeByteOff t byte (prev .|. bit)
-                    loop (n + 1)
-              in loop 0
-
-charClass :: String -> FastSet
-charClass = set . B8.pack . go
-    where go (a:'-':b:xs) = [a..b] ++ go xs
-          go (x:xs) = x : go xs
-          go _ = ""
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs
deleted file mode 100644
index 4938ea87..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs
+++ /dev/null
@@ -1,536 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
-    RecordWildCards #-}
--- |
--- Module      :  Data.Attoparsec.ByteString.Internal
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient parser combinators for 'ByteString' strings,
--- loosely based on the Parsec library.
-
-module Data.Attoparsec.ByteString.Internal
-    (
-    -- * Parser types
-      Parser
-    , Result
-
-    -- * Running parsers
-    , parse
-    , parseOnly
-
-    -- * Combinators
-    , module Data.Attoparsec.Combinator
-
-    -- * Parsing individual bytes
-    , satisfy
-    , satisfyWith
-    , anyWord8
-    , skip
-    , word8
-    , notWord8
-
-    -- ** Lookahead
-    , peekWord8
-    , peekWord8'
-
-    -- ** Byte classes
-    , inClass
-    , notInClass
-
-    -- * Parsing more complicated structures
-    , storable
-
-    -- * Efficient string handling
-    , skipWhile
-    , string
-    , stringCI
-    , take
-    , scan
-    , runScanner
-    , takeWhile
-    , takeWhile1
-    , takeTill
-
-    -- ** Consume all remaining input
-    , takeByteString
-    , takeLazyByteString
-
-    -- * Utilities
-    , endOfLine
-    , endOfInput
-    , match
-    , atEnd
-    ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
-#endif
-import Control.Applicative ((<|>))
-import Control.Monad (when)
-import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
-import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
-import Data.Attoparsec.Combinator (())
-import Data.Attoparsec.Internal
-import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
-import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
-import Data.ByteString (ByteString)
-import Data.List (intercalate)
-import Data.Word (Word8)
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Ptr (castPtr, minusPtr, plusPtr)
-import Foreign.Storable (Storable(peek, sizeOf))
-import Prelude hiding (getChar, succ, take, takeWhile)
-import qualified Data.Attoparsec.ByteString.Buffer as Buf
-import qualified Data.Attoparsec.Internal.Types as T
-import qualified Data.ByteString as B8
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Internal as B
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Unsafe as B
-
-type Parser = T.Parser ByteString
-type Result = IResult ByteString
-type Failure r = T.Failure ByteString Buffer r
-type Success a r = T.Success ByteString Buffer a r
-
--- | The parser @satisfy p@ succeeds for any byte for which the
--- predicate @p@ returns 'True'. Returns the byte that is actually
--- parsed.
---
--- >digit = satisfy isDigit
--- >    where isDigit w = w >= 48 && w <= 57
-satisfy :: (Word8 -> Bool) -> Parser Word8
-satisfy p = do
-  h <- peekWord8'
-  if p h
-    then advance 1 >> return h
-    else fail "satisfy"
-{-# INLINE satisfy #-}
-
--- | The parser @skip p@ succeeds for any byte for which the predicate
--- @p@ returns 'True'.
---
--- >skipDigit = skip isDigit
--- >    where isDigit w = w >= 48 && w <= 57
-skip :: (Word8 -> Bool) -> Parser ()
-skip p = do
-  h <- peekWord8'
-  if p h
-    then advance 1
-    else fail "skip"
-
--- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
--- the predicate @p@ returns 'True' on the transformed value. The
--- parser returns the transformed byte that was parsed.
-satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
-satisfyWith f p = do
-  h <- peekWord8'
-  let c = f h
-  if p c
-    then advance 1 >> return c
-    else fail "satisfyWith"
-{-# INLINE satisfyWith #-}
-
-storable :: Storable a => Parser a
-storable = hack undefined
- where
-  hack :: Storable b => b -> Parser b
-  hack dummy = do
-    (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
-    return . inlinePerformIO . withForeignPtr fp $ \p ->
-        peek (castPtr $ p `plusPtr` o)
-
--- | Consume exactly @n@ bytes of input.
-take :: Int -> Parser ByteString
-take n0 = do
-  let n = max n0 0
-  s <- ensure n
-  advance n >> return s
-{-# INLINE take #-}
-
--- | @string s@ parses a sequence of bytes that identically match
--- @s@. Returns the parsed string (i.e. @s@).  This parser consumes no
--- input if it fails (even if a partial match).
---
--- /Note/: The behaviour of this parser is different to that of the
--- similarly-named parser in Parsec, as this one is all-or-nothing.
--- To illustrate the difference, the following parser will fail under
--- Parsec given an input of @\"for\"@:
---
--- >string "foo" <|> string "for"
---
--- The reason for its failure is that the first branch is a
--- partial match, and will consume the letters @\'f\'@ and @\'o\'@
--- before failing.  In attoparsec, the above parser will /succeed/ on
--- that input, because the failed first branch will consume nothing.
-string :: ByteString -> Parser ByteString
-string s = string_ (stringSuspended id) id s
-{-# INLINE string #-}
-
--- ASCII-specific but fast, oh yes.
-toLower :: Word8 -> Word8
-toLower w | w >= 65 && w <= 90 = w + 32
-          | otherwise          = w
-
--- | Satisfy a literal string, ignoring case.
-stringCI :: ByteString -> Parser ByteString
-stringCI s = string_ (stringSuspended lower) lower s
-  where lower = B8.map toLower
-{-# INLINE stringCI #-}
-
-string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More
-            -> Failure r -> Success ByteString r -> Result r)
-        -> (ByteString -> ByteString)
-        -> ByteString -> Parser ByteString
-string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
-  let n = B.length s
-      s = f s0
-  in if lengthAtLeast pos n t
-     then let t' = substring pos (Pos n) t
-          in if s == f t'
-             then succ t (pos + Pos n) more t'
-             else lose t pos more [] "string"
-     else let t' = Buf.unsafeDrop (fromPos pos) t
-          in if f t' `B.isPrefixOf` s
-             then suspended s (B.drop (B.length t') s) t pos more lose succ
-             else lose t pos more [] "string"
-{-# INLINE string_ #-}
-
-stringSuspended :: (ByteString -> ByteString)
-                -> ByteString -> ByteString -> Buffer -> Pos -> More
-                -> Failure r
-                -> Success ByteString r
-                -> Result r
-stringSuspended f s0 s t pos more lose succ =
-    runParser (demandInput_ >>= go) t pos more lose succ
-  where go s'0   = T.Parser $ \t' pos' more' lose' succ' ->
-          let m  = B.length s
-              s' = f s'0
-              n  = B.length s'
-          in if n >= m
-             then if B.unsafeTake m s' == s
-                  then let o = Pos (B.length s0)
-                       in succ' t' (pos' + o) more'
-                          (substring pos' o t')
-                  else lose' t' pos' more' [] "string"
-             else if s' == B.unsafeTake n s
-                  then stringSuspended f s0 (B.unsafeDrop n s)
-                       t' pos' more' lose' succ'
-                  else lose' t' pos' more' [] "string"
-
--- | Skip past input for as long as the predicate returns 'True'.
-skipWhile :: (Word8 -> Bool) -> Parser ()
-skipWhile p = go
- where
-  go = do
-    t <- B8.takeWhile p <$> get
-    continue <- inputSpansChunks (B.length t)
-    when continue go
-{-# INLINE skipWhile #-}
-
--- | Consume input as long as the predicate returns 'False'
--- (i.e. until it returns 'True'), and return the consumed input.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'True' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'Control.Applicative.many', because such
--- parsers loop until a failure occurs.  Careless use will thus result
--- in an infinite loop.
-takeTill :: (Word8 -> Bool) -> Parser ByteString
-takeTill p = takeWhile (not . p)
-{-# INLINE takeTill #-}
-
--- | Consume input as long as the predicate returns 'True', and return
--- the consumed input.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'False' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'Control.Applicative.many', because such
--- parsers loop until a failure occurs.  Careless use will thus result
--- in an infinite loop.
-takeWhile :: (Word8 -> Bool) -> Parser ByteString
-takeWhile p = do
-    s <- B8.takeWhile p <$> get
-    continue <- inputSpansChunks (B.length s)
-    if continue
-      then takeWhileAcc p [s]
-      else return s
-{-# INLINE takeWhile #-}
-
-takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
-takeWhileAcc p = go
- where
-  go acc = do
-    s <- B8.takeWhile p <$> get
-    continue <- inputSpansChunks (B.length s)
-    if continue
-      then go (s:acc)
-      else return $ concatReverse (s:acc)
-{-# INLINE takeWhileAcc #-}
-
-takeRest :: Parser [ByteString]
-takeRest = go []
- where
-  go acc = do
-    input <- wantInput
-    if input
-      then do
-        s <- get
-        advance (B.length s)
-        go (s:acc)
-      else return (reverse acc)
-
--- | Consume all remaining input and return it as a single string.
-takeByteString :: Parser ByteString
-takeByteString = B.concat `fmap` takeRest
-
--- | Consume all remaining input and return it as a single string.
-takeLazyByteString :: Parser L.ByteString
-takeLazyByteString = L.fromChunks `fmap` takeRest
-
-data T s = T {-# UNPACK #-} !Int s
-
-scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
-         -> Parser r
-scan_ f s0 p = go [] s0
- where
-  go acc s1 = do
-    let scanner (B.PS fp off len) =
-          withForeignPtr fp $ \ptr0 -> do
-            let start = ptr0 `plusPtr` off
-                end   = start `plusPtr` len
-                inner ptr !s
-                  | ptr < end = do
-                    w <- peek ptr
-                    case p s w of
-                      Just s' -> inner (ptr `plusPtr` 1) s'
-                      _       -> done (ptr `minusPtr` start) s
-                  | otherwise = done (ptr `minusPtr` start) s
-                done !i !s = return (T i s)
-            inner start s1
-    bs <- get
-    let T i s' = inlinePerformIO $ scanner bs
-        !h = B.unsafeTake i bs
-    continue <- inputSpansChunks i
-    if continue
-      then go (h:acc) s'
-      else f s' (h:acc)
-{-# INLINE scan_ #-}
-
--- | A stateful scanner.  The predicate consumes and transforms a
--- state argument, and each transformed state is passed to successive
--- invocations of the predicate on each byte of the input until one
--- returns 'Nothing' or the input ends.
---
--- This parser does not fail.  It will return an empty string if the
--- predicate returns 'Nothing' on the first byte of input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'Control.Applicative.many', because such
--- parsers loop until a failure occurs.  Careless use will thus result
--- in an infinite loop.
-scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
-scan = scan_ $ \_ chunks -> return $! concatReverse chunks
-{-# INLINE scan #-}
-
--- | Like 'scan', but generalized to return the final state of the
--- scanner.
-runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
-runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
-{-# INLINE runScanner #-}
-
--- | Consume input as long as the predicate returns 'True', and return
--- the consumed input.
---
--- This parser requires the predicate to succeed on at least one byte
--- of input: it will fail if the predicate never returns 'True' or if
--- there is no input left.
-takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
-takeWhile1 p = do
-  (`when` demandInput) =<< endOfChunk
-  s <- B8.takeWhile p <$> get
-  let len = B.length s
-  if len == 0
-    then fail "takeWhile1"
-    else do
-      advance len
-      eoc <- endOfChunk
-      if eoc
-        then takeWhileAcc p [s]
-        else return s
-{-# INLINE takeWhile1 #-}
-
--- | Match any byte in a set.
---
--- >vowel = inClass "aeiou"
---
--- Range notation is supported.
---
--- >halfAlphabet = inClass "a-nA-N"
---
--- To add a literal @\'-\'@ to a set, place it at the beginning or end
--- of the string.
-inClass :: String -> Word8 -> Bool
-inClass s = (`memberWord8` mySet)
-    where mySet = charClass s
-          {-# NOINLINE mySet #-}
-{-# INLINE inClass #-}
-
--- | Match any byte not in a set.
-notInClass :: String -> Word8 -> Bool
-notInClass s = not . inClass s
-{-# INLINE notInClass #-}
-
--- | Match any byte.
-anyWord8 :: Parser Word8
-anyWord8 = satisfy $ const True
-{-# INLINE anyWord8 #-}
-
--- | Match a specific byte.
-word8 :: Word8 -> Parser Word8
-word8 c = satisfy (== c)  show c
-{-# INLINE word8 #-}
-
--- | Match any byte except the given one.
-notWord8 :: Word8 -> Parser Word8
-notWord8 c = satisfy (/= c)  "not " ++ show c
-{-# INLINE notWord8 #-}
-
--- | Match any byte, to perform lookahead. Returns 'Nothing' if end of
--- input has been reached. Does not consume any input.
---
--- /Note/: Because this parser does not fail, do not use it with
--- combinators such as 'Control.Applicative.many', because such
--- parsers loop until a failure occurs.  Careless use will thus result
--- in an infinite loop.
-peekWord8 :: Parser (Maybe Word8)
-peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
-  case () of
-    _| pos_ < Buf.length t ->
-       let !w = Buf.unsafeIndex t pos_
-       in succ t pos more (Just w)
-     | more == Complete ->
-       succ t pos more Nothing
-     | otherwise ->
-       let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_
-                                 in succ t' pos' more' (Just w)
-           lose' t' pos' more' = succ t' pos' more' Nothing
-       in prompt t pos more lose' succ'
-{-# INLINE peekWord8 #-}
-
--- | Match any byte, to perform lookahead.  Does not consume any
--- input, but will fail if end of input has been reached.
-peekWord8' :: Parser Word8
-peekWord8' = T.Parser $ \t pos more lose succ ->
-    if lengthAtLeast pos 1 t
-    then succ t pos more (Buf.unsafeIndex t (fromPos pos))
-    else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs'
-         in ensureSuspended 1 t pos more lose succ'
-{-# INLINE peekWord8' #-}
-
--- | Match either a single newline character @\'\\n\'@, or a carriage
--- return followed by a newline character @\"\\r\\n\"@.
-endOfLine :: Parser ()
-endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
-
--- | Terminal failure continuation.
-failK :: Failure a
-failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg
-{-# INLINE failK #-}
-
--- | Terminal success continuation.
-successK :: Success a a
-successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
-{-# INLINE successK #-}
-
--- | Run a parser.
-parse :: Parser a -> ByteString -> Result a
-parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
-{-# INLINE parse #-}
-
--- | Run a parser that cannot be resupplied via a 'Partial' result.
---
--- This function does not force a parser to consume all of its input.
--- Instead, any residual input will be discarded.  To force a parser
--- to consume all of its input, use something like this:
---
--- @
---'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
--- @
-parseOnly :: Parser a -> ByteString -> Either String a
-parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
-                  Fail _ [] err   -> Left err
-                  Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
-                  Done _ a        -> Right a
-                  _               -> error "parseOnly: impossible error!"
-{-# INLINE parseOnly #-}
-
-get :: Parser ByteString
-get = T.Parser $ \t pos more _lose succ ->
-  succ t pos more (Buf.unsafeDrop (fromPos pos) t)
-{-# INLINE get #-}
-
-endOfChunk :: Parser Bool
-endOfChunk = T.Parser $ \t pos more _lose succ ->
-  succ t pos more (fromPos pos == Buf.length t)
-{-# INLINE endOfChunk #-}
-
-inputSpansChunks :: Int -> Parser Bool
-inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->
-  let pos = pos_ + Pos i
-  in if fromPos pos < Buf.length t || more == Complete
-     then succ t pos more False
-     else let lose' t' pos' more' = succ t' pos' more' False
-              succ' t' pos' more' = succ t' pos' more' True
-          in prompt t pos more lose' succ'
-{-# INLINE inputSpansChunks #-}
-
-advance :: Int -> Parser ()
-advance n = T.Parser $ \t pos more _lose succ ->
-  succ t (pos + Pos n) more ()
-{-# INLINE advance #-}
-
-ensureSuspended :: Int -> Buffer -> Pos -> More
-                -> Failure r
-                -> Success ByteString r
-                -> Result r
-ensureSuspended n t pos more lose succ =
-    runParser (demandInput >> go) t pos more lose succ
-  where go = T.Parser $ \t' pos' more' lose' succ' ->
-          if lengthAtLeast pos' n t'
-          then succ' t' pos' more' (substring pos (Pos n) t')
-          else runParser (demandInput >> go) t' pos' more' lose' succ'
-
--- | If at least @n@ elements of input are available, return the
--- current input, otherwise fail.
-ensure :: Int -> Parser ByteString
-ensure n = T.Parser $ \t pos more lose succ ->
-    if lengthAtLeast pos n t
-    then succ t pos more (substring pos (Pos n) t)
-    -- The uncommon case is kept out-of-line to reduce code size:
-    else ensureSuspended n t pos more lose succ
-{-# INLINE ensure #-}
-
--- | Return both the result of a parse and the portion of the input
--- that was consumed while it was being parsed.
-match :: Parser a -> Parser (ByteString, a)
-match p = T.Parser $ \t pos more lose succ ->
-  let succ' t' pos' more' a =
-        succ t' pos' more' (substring pos (pos'-pos) t', a)
-  in runParser p t pos more lose succ'
-
-lengthAtLeast :: Pos -> Int -> Buffer -> Bool
-lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
-{-# INLINE lengthAtLeast #-}
-
-substring :: Pos -> Pos -> Buffer -> ByteString
-substring (Pos pos) (Pos n) = Buf.substring pos n
-{-# INLINE substring #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs
deleted file mode 100644
index dde0c27a..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP #-}
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Trustworthy #-} -- Imports internal modules
-#endif
--- |
--- Module      :  Data.Attoparsec.Combinator
--- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  portable
---
--- Useful parser combinators, similar to those provided by Parsec.
-module Data.Attoparsec.Combinator
-    (
-    -- * Combinators
-      try
-    , ()
-    , choice
-    , count
-    , option
-    , many'
-    , many1
-    , many1'
-    , manyTill
-    , manyTill'
-    , sepBy
-    , sepBy'
-    , sepBy1
-    , sepBy1'
-    , skipMany
-    , skipMany1
-    , eitherP
-    , feed
-    , satisfyElem
-    , endOfInput
-    , atEnd
-    , lookAhead
-    ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative (Applicative(..), (<$>))
-import Data.Monoid (Monoid(mappend))
-#endif
-import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>))
-import Control.Monad (MonadPlus(..))
-import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))
-import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)
-import Data.ByteString (ByteString)
-import Prelude hiding (succ)
-
--- | Attempt a parse, and if it fails, rewind the input so that no
--- input appears to have been consumed.
---
--- This combinator is provided for compatibility with Parsec.
--- attoparsec parsers always backtrack on failure.
-try :: Parser i a -> Parser i a
-try p = p
-{-# INLINE try #-}
-
--- | Name the parser, in case failure occurs.
-() :: Parser i a
-      -> String                 -- ^ the name to use if parsing fails
-      -> Parser i a
-p  msg0 = Parser $ \t pos more lose succ ->
-             let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg
-             in runParser p t pos more lose' succ
-{-# INLINE () #-}
-infix 0 
-
--- | @choice ps@ tries to apply the actions in the list @ps@ in order,
--- until one of them succeeds. Returns the value of the succeeding
--- action.
-choice :: Alternative f => [f a] -> f a
-choice = foldr (<|>) empty
-{-# SPECIALIZE choice :: [Parser ByteString a]
-                      -> Parser ByteString a #-}
-
--- | @option x p@ tries to apply action @p@. If @p@ fails without
--- consuming input, it returns the value @x@, otherwise the value
--- returned by @p@.
---
--- > priority  = option 0 (digitToInt <$> digit)
-option :: Alternative f => a -> f a -> f a
-option x p = p <|> pure x
-{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-}
-
--- | A version of 'liftM2' that is strict in the result of its first
--- action.
-liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c
-liftM2' f a b = do
-  !x <- a
-  y <- b
-  return (f x y)
-{-# INLINE liftM2' #-}
-
--- | @many' p@ applies the action @p@ /zero/ or more times. Returns a
--- list of the returned values of @p@. The value returned by @p@ is
--- forced to WHNF.
---
--- >  word  = many' letter
-many' :: (MonadPlus m) => m a -> m [a]
-many' p = many_p
-  where many_p = some_p `mplus` return []
-        some_p = liftM2' (:) p many_p
-{-# INLINE many' #-}
-
--- | @many1 p@ applies the action @p@ /one/ or more times. Returns a
--- list of the returned values of @p@.
---
--- >  word  = many1 letter
-many1 :: Alternative f => f a -> f [a]
-many1 p = liftA2 (:) p (many p)
-{-# INLINE many1 #-}
-
--- | @many1' p@ applies the action @p@ /one/ or more times. Returns a
--- list of the returned values of @p@. The value returned by @p@ is
--- forced to WHNF.
---
--- >  word  = many1' letter
-many1' :: (MonadPlus m) => m a -> m [a]
-many1' p = liftM2' (:) p (many' p)
-{-# INLINE many1' #-}
-
--- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated
--- by @sep@. Returns a list of the values returned by @p@.
---
--- > commaSep p  = p `sepBy` (char ',')
-sepBy :: Alternative f => f a -> f s -> f [a]
-sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []
-{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s
-                     -> Parser ByteString [a] #-}
-
--- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated
--- by @sep@. Returns a list of the values returned by @p@. The value
--- returned by @p@ is forced to WHNF.
---
--- > commaSep p  = p `sepBy'` (char ',')
-sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
-sepBy' p s = scan `mplus` return []
-  where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])
-{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s
-                      -> Parser ByteString [a] #-}
-
--- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated
--- by @sep@. Returns a list of the values returned by @p@.
---
--- > commaSep p  = p `sepBy1` (char ',')
-sepBy1 :: Alternative f => f a -> f s -> f [a]
-sepBy1 p s = scan
-    where scan = liftA2 (:) p ((s *> scan) <|> pure [])
-{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s
-                      -> Parser ByteString [a] #-}
-
--- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated
--- by @sep@. Returns a list of the values returned by @p@. The value
--- returned by @p@ is forced to WHNF.
---
--- > commaSep p  = p `sepBy1'` (char ',')
-sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
-sepBy1' p s = scan
-    where scan = liftM2' (:) p ((s >> scan) `mplus` return [])
-{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s
-                       -> Parser ByteString [a] #-}
-
--- | @manyTill p end@ applies action @p@ /zero/ or more times until
--- action @end@ succeeds, and returns the list of values returned by
--- @p@.  This can be used to scan comments:
---
--- >  simpleComment   = string "")
---
--- (Note the overlapping parsers @anyChar@ and @string \"-->\"@.
--- While this will work, it is not very efficient, as it will cause a
--- lot of backtracking.)
-manyTill :: Alternative f => f a -> f b -> f [a]
-manyTill p end = scan
-    where scan = (end *> pure []) <|> liftA2 (:) p scan
-{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b
-                        -> Parser ByteString [a] #-}
-
--- | @manyTill' p end@ applies action @p@ /zero/ or more times until
--- action @end@ succeeds, and returns the list of values returned by
--- @p@.  This can be used to scan comments:
---
--- >  simpleComment   = string "")
---
--- (Note the overlapping parsers @anyChar@ and @string \"-->\"@.
--- While this will work, it is not very efficient, as it will cause a
--- lot of backtracking.)
---
--- The value returned by @p@ is forced to WHNF.
-manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
-manyTill' p end = scan
-    where scan = (end >> return []) `mplus` liftM2' (:) p scan
-{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b
-                         -> Parser ByteString [a] #-}
-
--- | Skip zero or more instances of an action.
-skipMany :: Alternative f => f a -> f ()
-skipMany p = scan
-    where scan = (p *> scan) <|> pure ()
-{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-}
-
--- | Skip one or more instances of an action.
-skipMany1 :: Alternative f => f a -> f ()
-skipMany1 p = p *> skipMany p
-{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-}
-
--- | Apply the given action repeatedly, returning every result.
-count :: Monad m => Int -> m a -> m [a]
-count n p = sequence (replicate n p)
-{-# INLINE count #-}
-
--- | Combine two alternatives.
-eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
-eitherP a b = (Left <$> a) <|> (Right <$> b)
-{-# INLINE eitherP #-}
-
--- | If a parser has returned a 'T.Partial' result, supply it with more
--- input.
-feed :: Monoid i => IResult i r -> i -> IResult i r
-feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg
-feed (Partial k) d    = k d
-feed (Done t r) d     = Done (mappend t d) r
-{-# INLINE feed #-}
-
--- | Apply a parser without consuming any input.
-lookAhead :: Parser i a -> Parser i a
-lookAhead p = Parser $ \t pos more lose succ ->
-  let succ' t' _pos' more' = succ t' pos more'
-  in runParser p t pos more lose succ'
-{-# INLINE lookAhead #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs
deleted file mode 100644
index ee758b26..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
--- |
--- Module      :  Data.Attoparsec.Internal
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient parser combinators, loosely based on the Parsec
--- library.
-
-module Data.Attoparsec.Internal
-    ( compareResults
-    , prompt
-    , demandInput
-    , demandInput_
-    , wantInput
-    , endOfInput
-    , atEnd
-    , satisfyElem
-    , concatReverse
-    ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
-import Data.Monoid (Monoid, mconcat)
-#endif
-import Data.Attoparsec.Internal.Types
-import Data.ByteString (ByteString)
-import Prelude hiding (succ)
-
--- | Compare two 'IResult' values for equality.
---
--- If both 'IResult's are 'Partial', the result will be 'Nothing', as
--- they are incomplete and hence their equality cannot be known.
--- (This is why there is no 'Eq' instance for 'IResult'.)
-compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool
-compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) =
-    Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1)
-compareResults (Done t0 r0) (Done t1 r1) =
-    Just (t0 == t1 && r0 == r1)
-compareResults (Partial _) (Partial _) = Nothing
-compareResults _ _ = Just False
-
--- | Ask for input.  If we receive any, pass the augmented input to a
--- success continuation, otherwise to a failure continuation.
-prompt :: Chunk t
-       => State t -> Pos -> More
-       -> (State t -> Pos -> More -> IResult t r)
-       -> (State t -> Pos -> More -> IResult t r)
-       -> IResult t r
-prompt t pos _more lose succ = Partial $ \s ->
-  if nullChunk s
-  then lose t pos Complete
-  else succ (pappendChunk t s) pos Incomplete
-{-# SPECIALIZE prompt :: State ByteString -> Pos -> More
-                      -> (State ByteString -> Pos -> More
-                          -> IResult ByteString r)
-                      -> (State ByteString -> Pos -> More
-                          -> IResult ByteString r)
-                      -> IResult ByteString r #-}
-
--- | Immediately demand more input via a 'Partial' continuation
--- result.
-demandInput :: Chunk t => Parser t ()
-demandInput = Parser $ \t pos more lose succ ->
-  case more of
-    Complete -> lose t pos more [] "not enough input"
-    _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input"
-             succ' t' pos' more' = succ t' pos' more' ()
-         in prompt t pos more lose' succ'
-{-# SPECIALIZE demandInput :: Parser ByteString () #-}
-
--- | Immediately demand more input via a 'Partial' continuation
--- result.  Return the new input.
-demandInput_ :: Chunk t => Parser t t
-demandInput_ = Parser $ \t pos more lose succ ->
-  case more of
-    Complete -> lose t pos more [] "not enough input"
-    _ -> Partial $ \s ->
-         if nullChunk s
-         then lose t pos Complete [] "not enough input"
-         else succ (pappendChunk t s) pos more s
-{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}
-
--- | This parser always succeeds.  It returns 'True' if any input is
--- available either immediately or on demand, and 'False' if the end
--- of all input has been reached.
-wantInput :: forall t . Chunk t => Parser t Bool
-wantInput = Parser $ \t pos more _lose succ ->
-  case () of
-    _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True
-      | more == Complete -> succ t pos more False
-      | otherwise       -> let lose' t' pos' more' = succ t' pos' more' False
-                               succ' t' pos' more' = succ t' pos' more' True
-                           in prompt t pos more lose' succ'
-{-# INLINE wantInput #-}
-
--- | Match only if all input has been consumed.
-endOfInput :: forall t . Chunk t => Parser t ()
-endOfInput = Parser $ \t pos more lose succ ->
-  case () of
-    _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput"
-     | more == Complete -> succ t pos more ()
-     | otherwise ->
-       let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
-           succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"
-       in  runParser demandInput t pos more lose' succ'
-{-# SPECIALIZE endOfInput :: Parser ByteString () #-}
-
--- | Return an indication of whether the end of input has been
--- reached.
-atEnd :: Chunk t => Parser t Bool
-atEnd = not <$> wantInput
-{-# INLINE atEnd #-}
-
-satisfySuspended :: forall t r . Chunk t
-                 => (ChunkElem t -> Bool)
-                 -> State t -> Pos -> More
-                 -> Failure t (State t) r
-                 -> Success t (State t) (ChunkElem t) r
-                 -> IResult t r
-satisfySuspended p t pos more lose succ =
-    runParser (demandInput >> go) t pos more lose succ
-  where go = Parser $ \t' pos' more' lose' succ' ->
-          case bufferElemAt (undefined :: t) pos' t' of
-            Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e
-                        | otherwise -> lose' t' pos' more' [] "satisfyElem"
-            Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'
-{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool)
-                                -> State ByteString -> Pos -> More
-                                -> Failure ByteString (State ByteString) r
-                                -> Success ByteString (State ByteString)
-                                           (ChunkElem ByteString) r
-                                -> IResult ByteString r #-}
-
--- | The parser @satisfyElem p@ succeeds for any chunk element for which the
--- predicate @p@ returns 'True'. Returns the element that is
--- actually parsed.
-satisfyElem :: forall t . Chunk t
-            => (ChunkElem t -> Bool) -> Parser t (ChunkElem t)
-satisfyElem p = Parser $ \t pos more lose succ ->
-    case bufferElemAt (undefined :: t) pos t of
-      Just (e, l) | p e -> succ t (pos + Pos l) more e
-                  | otherwise -> lose t pos more [] "satisfyElem"
-      Nothing -> satisfySuspended p t pos more lose succ
-{-# INLINE satisfyElem #-}
-
--- | Concatenate a monoid after reversing its elements.  Used to
--- glue together a series of textual chunks that have been accumulated
--- \"backwards\".
-concatReverse :: Monoid m => [m] -> m
-concatReverse [x] = x
-concatReverse xs  = mconcat (reverse xs)
-{-# INLINE concatReverse #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
deleted file mode 100644
index 0e00ed2c..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,
-    RecordWildCards, MagicHash, UnboxedTuples #-}
-
-module Data.Attoparsec.Internal.Fhthagn
-    (
-      inlinePerformIO
-    ) where
-
-import GHC.Base (realWorld#)
-import GHC.IO (IO(IO))
-
--- | Just like unsafePerformIO, but we inline it. Big performance gains as
--- it exposes lots of things to further inlining. /Very unsafe/. In
--- particular, you should do no memory allocation inside an
--- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
-inlinePerformIO :: IO a -> a
-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
-{-# INLINE inlinePerformIO #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
deleted file mode 100644
index 96bc319e..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
+++ /dev/null
@@ -1,243 +0,0 @@
-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
-    Rank2Types, RecordWildCards, TypeFamilies #-}
--- |
--- Module      :  Data.Attoparsec.Internal.Types
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- Simple, efficient parser combinators, loosely based on the Parsec
--- library.
-
-module Data.Attoparsec.Internal.Types
-    (
-      Parser(..)
-    , State
-    , Failure
-    , Success
-    , Pos(..)
-    , IResult(..)
-    , More(..)
-    , (<>)
-    , Chunk(..)
-    ) where
-
-import Control.Applicative as App (Applicative(..), (<$>))
-import Control.Applicative (Alternative(..))
-import Control.DeepSeq (NFData(rnf))
-import Control.Monad (MonadPlus(..))
-import qualified Control.Monad.Fail as Fail (MonadFail(..))
-import Data.Monoid as Mon (Monoid(..))
-import Data.Semigroup  (Semigroup(..))
-import Data.Word (Word8)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import Data.ByteString.Internal (w2c)
-import Prelude hiding (getChar, succ)
-import qualified Data.Attoparsec.ByteString.Buffer as B
-
-newtype Pos = Pos { fromPos :: Int }
-            deriving (Eq, Ord, Show, Num)
-
--- | The result of a parse.  This is parameterised over the type @i@
--- of string that was processed.
---
--- This type is an instance of 'Functor', where 'fmap' transforms the
--- value in a 'Done' result.
-data IResult i r =
-    Fail i [String] String
-    -- ^ The parse failed.  The @i@ parameter is the input that had
-    -- not yet been consumed when the failure occurred.  The
-    -- @[@'String'@]@ is a list of contexts in which the error
-    -- occurred.  The 'String' is the message describing the error, if
-    -- any.
-  | Partial (i -> IResult i r)
-    -- ^ Supply this continuation with more input so that the parser
-    -- can resume.  To indicate that no more input is available, pass
-    -- an empty string to the continuation.
-    --
-    -- __Note__: if you get a 'Partial' result, do not call its
-    -- continuation more than once.
-  | Done i r
-    -- ^ The parse succeeded.  The @i@ parameter is the input that had
-    -- not yet been consumed (if any) when the parse succeeded.
-
-instance (Show i, Show r) => Show (IResult i r) where
-    showsPrec d ir = showParen (d > 10) $
-      case ir of
-        (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg
-        (Partial _)      -> showString "Partial _"
-        (Done t r)       -> showString "Done" . f t . f r
-      where f :: Show a => a -> ShowS
-            f x = showChar ' ' . showsPrec 11 x
-
-instance (NFData i, NFData r) => NFData (IResult i r) where
-    rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg
-    rnf (Partial _)  = ()
-    rnf (Done t r)   = rnf t `seq` rnf r
-    {-# INLINE rnf #-}
-
-instance Functor (IResult i) where
-    fmap _ (Fail t stk msg) = Fail t stk msg
-    fmap f (Partial k)      = Partial (fmap f . k)
-    fmap f (Done t r)   = Done t (f r)
-
--- | The core parser type.  This is parameterised over the type @i@
--- of string being processed.
---
--- This type is an instance of the following classes:
---
--- * 'Monad', where 'fail' throws an exception (i.e. fails) with an
---   error message.
---
--- * 'Functor' and 'Applicative', which follow the usual definitions.
---
--- * 'MonadPlus', where 'mzero' fails (with no error message) and
---   'mplus' executes the right-hand parser if the left-hand one
---   fails.  When the parser on the right executes, the input is reset
---   to the same state as the parser on the left started with. (In
---   other words, attoparsec is a backtracking parser that supports
---   arbitrary lookahead.)
---
--- * 'Alternative', which follows 'MonadPlus'.
-newtype Parser i a = Parser {
-      runParser :: forall r.
-                   State i -> Pos -> More
-                -> Failure i (State i)   r
-                -> Success i (State i) a r
-                -> IResult i r
-    }
-
-type family State i
-type instance State ByteString = B.Buffer
-
-type Failure i t   r = t -> Pos -> More -> [String] -> String
-                       -> IResult i r
-type Success i t a r = t -> Pos -> More -> a -> IResult i r
-
--- | Have we read all available input?
-data More = Complete | Incomplete
-            deriving (Eq, Show)
-
-instance Semigroup More where
-    c@Complete <> _ = c
-    _          <> m = m
-
-instance Mon.Monoid More where
-    mappend = (<>)
-    mempty  = Incomplete
-
-instance Monad (Parser i) where
-    fail = Fail.fail
-    {-# INLINE fail #-}
-
-    return = App.pure
-    {-# INLINE return #-}
-
-    m >>= k = Parser $ \t !pos more lose succ ->
-        let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ
-        in runParser m t pos more lose succ'
-    {-# INLINE (>>=) #-}
-
-    (>>) = (*>)
-    {-# INLINE (>>) #-}
-
-
-instance Fail.MonadFail (Parser i) where
-    fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
-      where msg = "Failed reading: " ++ err
-    {-# INLINE fail #-}
-
-plus :: Parser i a -> Parser i a -> Parser i a
-plus f g = Parser $ \t pos more lose succ ->
-  let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
-  in runParser f t pos more lose' succ
-
-instance MonadPlus (Parser i) where
-    mzero = fail "mzero"
-    {-# INLINE mzero #-}
-    mplus = plus
-
-instance Functor (Parser i) where
-    fmap f p = Parser $ \t pos more lose succ ->
-      let succ' t' pos' more' a = succ t' pos' more' (f a)
-      in runParser p t pos more lose succ'
-    {-# INLINE fmap #-}
-
-apP :: Parser i (a -> b) -> Parser i a -> Parser i b
-apP d e = do
-  b <- d
-  a <- e
-  return (b a)
-{-# INLINE apP #-}
-
-instance Applicative (Parser i) where
-    pure v = Parser $ \t pos more _lose succ -> succ t pos more v
-    {-# INLINE pure #-}
-    (<*>)  = apP
-    {-# INLINE (<*>) #-}
-    m *> k = m >>= \_ -> k
-    {-# INLINE (*>) #-}
-    x <* y = x >>= \a -> y >> pure a
-    {-# INLINE (<*) #-}
-
-instance Semigroup (Parser i a) where
-    (<>) = plus
-    {-# INLINE (<>) #-}
-
-instance Monoid (Parser i a) where
-    mempty  = fail "mempty"
-    {-# INLINE mempty #-}
-    mappend = (<>)
-    {-# INLINE mappend #-}
-
-instance Alternative (Parser i) where
-    empty = fail "empty"
-    {-# INLINE empty #-}
-
-    (<|>) = plus
-    {-# INLINE (<|>) #-}
-
-    many v = many_v
-        where many_v = some_v <|> pure []
-              some_v = (:) App.<$> v <*> many_v
-    {-# INLINE many #-}
-
-    some v = some_v
-      where
-        many_v = some_v <|> pure []
-        some_v = (:) <$> v <*> many_v
-    {-# INLINE some #-}
-
--- | A common interface for input chunks.
-class Monoid c => Chunk c where
-  type ChunkElem c
-  -- | Test if the chunk is empty.
-  nullChunk :: c -> Bool
-  -- | Append chunk to a buffer.
-  pappendChunk :: State c -> c -> State c
-  -- | Position at the end of a buffer. The first argument is ignored.
-  atBufferEnd :: c -> State c -> Pos
-  -- | Return the buffer element at the given position along with its length.
-  bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)
-  -- | Map an element to the corresponding character.
-  --   The first argument is ignored.
-  chunkElemToChar :: c -> ChunkElem c -> Char
-
-instance Chunk ByteString where
-  type ChunkElem ByteString = Word8
-  nullChunk = BS.null
-  {-# INLINE nullChunk #-}
-  pappendChunk = B.pappend
-  {-# INLINE pappendChunk #-}
-  atBufferEnd _ = Pos . B.length
-  {-# INLINE atBufferEnd #-}
-  bufferElemAt _ (Pos i) buf
-    | i < B.length buf = Just (B.unsafeIndex buf i, 1)
-    | otherwise = Nothing
-  {-# INLINE bufferElemAt #-}
-  chunkElemToChar _ = w2c
-  {-# INLINE chunkElemToChar #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs
deleted file mode 100644
index d0970d90..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs
+++ /dev/null
@@ -1,137 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
--- |
--- Module      :  Data.Attoparsec.Number
--- Copyright   :  Bryan O'Sullivan 2007-2015
--- License     :  BSD3
---
--- Maintainer  :  bos@serpentine.com
--- Stability   :  experimental
--- Portability :  unknown
---
--- This module is deprecated, and both the module and 'Number' type
--- will be removed in the next major release.  Use the
---  package
--- and the 'Data.Scientific.Scientific' type instead.
---
--- A simple number type, useful for parsing both exact and inexact
--- quantities without losing much precision.
-module Data.Attoparsec.Number
-    {-# DEPRECATED "This module will be removed in the next major release." #-}
-    (
-      Number(..)
-    ) where
-
-import Control.DeepSeq (NFData(rnf))
-import Data.Data (Data)
-import Data.Function (on)
-import Data.Typeable (Typeable)
-
--- | A numeric type that can represent integers accurately, and
--- floating point numbers to the precision of a 'Double'.
---
--- /Note/: this type is deprecated, and will be removed in the next
--- major release.  Use the 'Data.Scientific.Scientific' type instead.
-data Number = I !Integer
-            | D {-# UNPACK #-} !Double
-              deriving (Typeable, Data)
-{-# DEPRECATED Number "Use Scientific instead." #-}
-
-instance Show Number where
-    show (I a) = show a
-    show (D a) = show a
-
-instance NFData Number where
-    rnf (I _) = ()
-    rnf (D _) = ()
-    {-# INLINE rnf #-}
-
-binop :: (Integer -> Integer -> a) -> (Double -> Double -> a)
-      -> Number -> Number -> a
-binop _ d (D a) (D b) = d a b
-binop i _ (I a) (I b) = i a b
-binop _ d (D a) (I b) = d a (fromIntegral b)
-binop _ d (I a) (D b) = d (fromIntegral a) b
-{-# INLINE binop #-}
-
-instance Eq Number where
-    (==) = binop (==) (==)
-    {-# INLINE (==) #-}
-
-    (/=) = binop (/=) (/=)
-    {-# INLINE (/=) #-}
-
-instance Ord Number where
-    (<) = binop (<) (<)
-    {-# INLINE (<) #-}
-
-    (<=) = binop (<=) (<=)
-    {-# INLINE (<=) #-}
-
-    (>) = binop (>) (>)
-    {-# INLINE (>) #-}
-
-    (>=) = binop (>=) (>=)
-    {-# INLINE (>=) #-}
-
-    compare = binop compare compare
-    {-# INLINE compare #-}
-
-instance Num Number where
-    (+) = binop (((I$!).) . (+)) (((D$!).) . (+))
-    {-# INLINE (+) #-}
-
-    (-) = binop (((I$!).) . (-)) (((D$!).) . (-))
-    {-# INLINE (-) #-}
-
-    (*) = binop (((I$!).) . (*)) (((D$!).) . (*))
-    {-# INLINE (*) #-}
-
-    abs (I a) = I $! abs a
-    abs (D a) = D $! abs a
-    {-# INLINE abs #-}
-
-    negate (I a) = I $! negate a
-    negate (D a) = D $! negate a
-    {-# INLINE negate #-}
-
-    signum (I a) = I $! signum a
-    signum (D a) = D $! signum a
-    {-# INLINE signum #-}
-
-    fromInteger = (I$!) . fromInteger
-    {-# INLINE fromInteger #-}
-
-instance Real Number where
-    toRational (I a) = fromIntegral a
-    toRational (D a) = toRational a
-    {-# INLINE toRational #-}
-
-instance Fractional Number where
-    fromRational = (D$!) . fromRational
-    {-# INLINE fromRational #-}
-
-    (/) = binop (((D$!).) . (/) `on` fromIntegral)
-                (((D$!).) . (/))
-    {-# INLINE (/) #-}
-
-    recip (I a) = D $! recip (fromIntegral a)
-    recip (D a) = D $! recip a
-    {-# INLINE recip #-}
-
-instance RealFrac Number where
-    properFraction (I a) = (fromIntegral a,0)
-    properFraction (D a) = case properFraction a of
-                             (i,d) -> (i,D d)
-    {-# INLINE properFraction #-}
-    truncate (I a) = fromIntegral a
-    truncate (D a) = truncate a
-    {-# INLINE truncate #-}
-    round (I a) = fromIntegral a
-    round (D a) = round a
-    {-# INLINE round #-}
-    ceiling (I a) = fromIntegral a
-    ceiling (D a) = ceiling a
-    {-# INLINE ceiling #-}
-    floor (I a) = fromIntegral a
-    floor (D a) = floor a
-    {-# INLINE floor #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE
deleted file mode 100644
index 97392a62..00000000
--- a/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE
+++ /dev/null
@@ -1,30 +0,0 @@
-Copyright (c) Lennart Kolmodin
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
-OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
diff --git a/haddock.cabal b/haddock.cabal
index 7ae252c2..7401cdc7 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -63,11 +63,12 @@ executable haddock
   hs-source-dirs:       driver
   ghc-options:          -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded
 
-  -- haddock typically only supports a single GHC major version
+  -- haddock typically only supports a single GHC major version 
   build-depends:
     base ^>= 4.11.0
+
   if flag(in-ghc-tree)
-    hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.13.1.0, haddock-library/src
+    hs-source-dirs: haddock-api/src,  haddock-library/src
     cpp-options: -DIN_GHC_TREE
     build-depends:
       filepath,
@@ -80,6 +81,8 @@ executable haddock
       ghc-boot,
       ghc == 8.4.*,
       bytestring,
+      parsec,
+      text,
       transformers
 
     other-modules:
@@ -89,17 +92,6 @@ executable haddock
       Documentation.Haddock.Parser.Monad
       Documentation.Haddock.Types
       Documentation.Haddock.Doc
-      Data.Attoparsec
-      Data.Attoparsec.ByteString
-      Data.Attoparsec.ByteString.Buffer
-      Data.Attoparsec.ByteString.Char8
-      Data.Attoparsec.ByteString.FastSet
-      Data.Attoparsec.ByteString.Internal
-      Data.Attoparsec.Combinator
-      Data.Attoparsec.Internal
-      Data.Attoparsec.Internal.Fhthagn
-      Data.Attoparsec.Internal.Types
-      Data.Attoparsec.Number
       Documentation.Haddock.Utf8
       Documentation.Haddock.Parser.Util
       Documentation.Haddock.Markup
-- 
cgit v1.2.3


From a8a84a3dda95022738534971a77eb856885b5ed0 Mon Sep 17 00:00:00 2001
From: Chaitanya Koparkar 
Date: Thu, 10 May 2018 11:44:58 -0400
Subject: Use the response file utilities defined in `base` (#821)

Summary: The response file related modules were recently copied from
`haddock` into `base`. This patch removes them from `haddock`.

GHC Trac Issues: #13896
---
 CHANGES.md                      |   3 ++
 driver-test/Main.hs             |  12 -----
 driver-test/ResponseFileSpec.hs |  80 -----------------------------
 driver/Main.hs                  |   5 +-
 driver/ResponseFile.hs          | 110 ----------------------------------------
 haddock.cabal                   |  17 -------
 6 files changed, 5 insertions(+), 222 deletions(-)
 delete mode 100644 driver-test/Main.hs
 delete mode 100644 driver-test/ResponseFileSpec.hs
 delete mode 100644 driver/ResponseFile.hs

diff --git a/CHANGES.md b/CHANGES.md
index 9621bc06..7f7d7084 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -52,6 +52,9 @@ TODO
  * Recognise `SPDX-License-Identifier` as alias for `License` in module header
    parser (#743)
 
+ * Remove the response file related utilities, and use the ones that
+   come with `base` (Trac #13896)
+
 ## Changes in version 2.18.1
 
  * Synopsis is working again (#599)
diff --git a/driver-test/Main.hs b/driver-test/Main.hs
deleted file mode 100644
index d3f636e9..00000000
--- a/driver-test/Main.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Main where
-
-import Test.Hspec (describe, hspec, Spec)
-import qualified ResponseFileSpec (spec)
-
-
-main :: IO ()
-main = hspec spec
-
-spec :: Spec
-spec = do
-    describe "ResponseFile" ResponseFileSpec.spec
diff --git a/driver-test/ResponseFileSpec.hs b/driver-test/ResponseFileSpec.hs
deleted file mode 100644
index 997adac4..00000000
--- a/driver-test/ResponseFileSpec.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module ResponseFileSpec where
-
-import Test.Hspec (context, describe, it, shouldBe, Spec)
-import ResponseFile (escapeArgs, unescapeArgs)
-
--- The first two elements are
---   1) a list of 'args' to encode and
---   2) a single string of the encoded args
--- The 3rd element is just a description for the tests.
-testStrs :: [(([String], String), String)]
-testStrs =
-  [ ((["a simple command line"],
-      "a\\ simple\\ command\\ line\n"),
-     "the white-space, end with newline")
-
-  , ((["arg 'foo' is single quoted"],
-      "arg\\ \\'foo\\'\\ is\\ single\\ quoted\n"),
-     "the single quotes as well")
-
-  , ((["arg \"bar\" is double quoted"],
-      "arg\\ \\\"bar\\\"\\ is\\ double\\ quoted\n"),
-     "the double quotes as well" )
-
-  , ((["arg \"foo bar\" has embedded whitespace"],
-      "arg\\ \\\"foo\\ bar\\\"\\ has\\ embedded\\ whitespace\n"),
-     "the quote-embedded whitespace")
-
-  , ((["arg 'Jack said \\'hi\\'' has single quotes"],
-      "arg\\ \\'Jack\\ said\\ \\\\\\'hi\\\\\\'\\'\\ has\\ single\\ quotes\n"),
-     "the escaped single quotes")
-
-  , ((["arg 'Jack said \\\"hi\\\"' has double quotes"],
-      "arg\\ \\'Jack\\ said\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ double\\ quotes\n"),
-     "the escaped double quotes")
-
-  , ((["arg 'Jack said\\r\\n\\t \\\"hi\\\"' has other whitespace"],
-      "arg\\ \\'Jack\\ said\\\\r\\\\n\\\\t\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ \
-           \other\\ whitespace\n"),
-     "the other whitespace")
-
-  , (([ "--prologue=.\\dist\\.\\haddock-prologue3239114604.txt"
-      , "--title=HaddockNewline-0.1.0.0: This has a\n\
-        \newline yo."
-      , "-BC:\\Program Files\\Haskell Platform\\lib"],
-      "--prologue=.\\\\dist\\\\.\\\\haddock-prologue3239114604.txt\n\
-      \--title=HaddockNewline-0.1.0.0:\\ This\\ has\\ a\\\n\
-      \newline\\ yo.\n\
-      \-BC:\\\\Program\\ Files\\\\Haskell\\ Platform\\\\lib\n"),
-     "an actual haddock response file snippet with embedded newlines")
-  ]
-
-spec :: Spec
-spec = do
-  describe "escapeArgs" $ do
-      mapM_ (\((ss1,s2),des) -> do
-                  context ("given " ++ (show ss1)) $ do
-                      it ("should escape " ++ des) $ do
-                          escapeArgs ss1 `shouldBe` s2
-            ) testStrs
-  describe "unescapeArgs" $ do
-      mapM_ (\((ss1,s2),des) -> do
-                  context ("given " ++ (show s2)) $ do
-                      it ("should unescape " ++ des) $ do
-                          unescapeArgs s2 `shouldBe` ss1
-            ) testStrs
-  describe "unescapeArgs" $ do
-      context "given unescaped single quotes" $ do
-          it "should pass-through, without escaping, everything inside" $ do
-              -- backslash *always* is escaped anywhere it appears
-              (filter (not . null) $
-                unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
-              `shouldBe`
-              ["this is not escaped \"inside\" yo"]
-      context "given unescaped double quotes" $ do
-          it "should pass-through, without escaping, everything inside" $ do
-              -- backslash *always* is escaped anywhere it appears
-              (filter (not . null) $
-                unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
-              `shouldBe`
-              ["this is not escaped 'inside' yo"]
diff --git a/driver/Main.hs b/driver/Main.hs
index 852f44c7..44df4692 100644
--- a/driver/Main.hs
+++ b/driver/Main.hs
@@ -1,8 +1,7 @@
 module Main where
 
 import Documentation.Haddock (haddock)
-import ResponseFile (expandResponse)
-import System.Environment (getArgs)
+import GHC.ResponseFile (getArgsWithResponseFiles)
 
 main :: IO ()
-main = getArgs >>= expandResponse >>= haddock
+main = getArgsWithResponseFiles >>= haddock
diff --git a/driver/ResponseFile.hs b/driver/ResponseFile.hs
deleted file mode 100644
index 253c6004..00000000
--- a/driver/ResponseFile.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-module ResponseFile (
-    unescapeArgs,
-    escapeArgs,
-    expandResponse
-  ) where
-
-import Control.Exception
-import Data.Char (isSpace)
-import Data.Foldable (foldl')
-import System.Exit (exitFailure)
-import System.IO
-
-
--- | Given a string of concatenated strings, separate each by removing
--- a layer of /quoting/ and\/or /escaping/ of certain characters.
---
--- These characters are: any whitespace, single quote, double quote,
--- and the backslash character.  The backslash character always
--- escapes (i.e., passes through without further consideration) the
--- character which follows.  Characters can also be escaped in blocks
--- by quoting (i.e., surrounding the blocks with matching pairs of
--- either single- or double-quotes which are not themselves escaped).
---
--- Any whitespace which appears outside of either of the quoting and
--- escaping mechanisms, is interpreted as having been added by this
--- special concatenation process to designate where the boundaries
--- are between the original, un-concatenated list of strings.  These
--- added whitespace characters are removed from the output.
---
--- > unescapeArgs "hello\\ \\\"world\\\"\n" == escapeArgs "hello \"world\""
-unescapeArgs :: String -> [String]
-unescapeArgs = filter (not . null) . unescape
-
--- | Given a list of strings, concatenate them into a single string
--- with escaping of certain characters, and the addition of a newline
--- between each string.  The escaping is done by adding a single
--- backslash character before any whitespace, single quote, double
--- quote, or backslash character, so this escaping character must be
--- removed.  Unescaped whitespace (in this case, newline) is part
--- of this "transport" format to indicate the end of the previous
--- string and the start of a new string.
---
--- While 'unescapeArgs' allows using quoting (i.e., convenient
--- escaping of many characters) by having matching sets of single- or
--- double-quotes,'escapeArgs' does not use the quoting mechasnism,
--- and thus will always escape any whitespace, quotes, and
--- backslashes.
---
--- > unescapeArgs "hello\\ \\\"world\\\"\\n" == escapeArgs "hello \"world\""
-escapeArgs :: [String] -> String
-escapeArgs = unlines . map escapeArg
-
--- | Arguments which look like '@foo' will be replaced with the
--- contents of file @foo@. A gcc-like syntax for response files arguments
--- is expected.  This must re-constitute the argument list by doing an
--- inverse of the escaping mechanism done by the calling-program side.
---
--- We quit if the file is not found or reading somehow fails.
--- (A convenience routine for haddock or possibly other clients)
-expandResponse :: [String] -> IO [String]
-expandResponse = fmap concat . mapM expand
-  where
-    expand :: String -> IO [String]
-    expand ('@':f) = readFileExc f >>= return . unescapeArgs
-    expand x = return [x]
-
-    readFileExc f =
-      readFile f `catch` \(e :: IOException) -> do
-        hPutStrLn stderr $ "Error while expanding response file: " ++ show e
-        exitFailure
-
-data Quoting = NoneQ | SngQ | DblQ
-
-unescape :: String -> [String]
-unescape args = reverse . map reverse $ go args NoneQ False [] []
-    where
-      -- n.b., the order of these cases matters; these are cribbed from gcc
-      -- case 1: end of input
-      go []     _q    _bs   a as = a:as
-      -- case 2: back-slash escape in progress
-      go (c:cs) q     True  a as = go cs q     False (c:a) as
-      -- case 3: no back-slash escape in progress, but got a back-slash
-      go (c:cs) q     False a as
-        | '\\' == c              = go cs q     True  a     as
-      -- case 4: single-quote escaping in progress
-      go (c:cs) SngQ  False a as
-        | '\'' == c              = go cs NoneQ False a     as
-        | otherwise              = go cs SngQ  False (c:a) as
-      -- case 5: double-quote escaping in progress
-      go (c:cs) DblQ  False a as
-        | '"' == c               = go cs NoneQ False a     as
-        | otherwise              = go cs DblQ  False (c:a) as
-      -- case 6: no escaping is in progress
-      go (c:cs) NoneQ False a as
-        | isSpace c              = go cs NoneQ False []    (a:as)
-        | '\'' == c              = go cs SngQ  False a     as
-        | '"'  == c              = go cs DblQ  False a     as
-        | otherwise              = go cs NoneQ False (c:a) as
-
-escapeArg :: String -> String
-escapeArg = reverse . foldl' escape []
-
-escape :: String -> Char -> String
-escape cs c
-  |    isSpace c
-    || '\\' == c
-    || '\'' == c
-    || '"'  == c = c:'\\':cs -- n.b., our caller must reverse the result
-  | otherwise    = c:cs
diff --git a/haddock.cabal b/haddock.cabal
index 40822acf..af606894 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -42,7 +42,6 @@ extra-source-files:
   doc/README.md
   doc/*.rst
   doc/conf.py
-  driver-test/*.hs
   haddock-api/src/haddock.sh
   html-test/src/*.hs
   html-test/ref/*.html
@@ -86,8 +85,6 @@ executable haddock
       transformers
 
     other-modules:
-      ResponseFile,
-
       Documentation.Haddock.Parser
       Documentation.Haddock.Parser.Monad
       Documentation.Haddock.Types
@@ -147,20 +144,6 @@ executable haddock
     -- we pin down to a single haddock-api version.
     build-depends:  haddock-api == 2.20.0
 
-    other-modules:
-      ResponseFile
-
-test-suite driver-test
-  type:             exitcode-stdio-1.0
-  default-language: Haskell2010
-  main-is:          Main.hs
-  hs-source-dirs:   driver-test, driver
-  other-modules:
-    ResponseFile
-    ResponseFileSpec
-
-  build-depends:    base, hspec
-
 test-suite html-test
   type:             exitcode-stdio-1.0
   -- This tells cabal that this test depends on the executable
-- 
cgit v1.2.3


From 9b9fb7ed2e7f30cca8693cdb186eaea8eeca0860 Mon Sep 17 00:00:00 2001
From: Ben Gamari 
Date: Sun, 13 May 2018 17:35:21 -0400
Subject: Account for refactoring of LitString

---
 haddock-api/src/Haddock/Backends/LaTeX.hs | 10 +---------
 1 file changed, 1 insertion(+), 9 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index d06e85d1..f8052895 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -169,15 +169,7 @@ ppLaTeXModule _title odir iface = do
 
       body = processExports exports
   --
-  writeFile (odir  moduleLaTeXFile mdl) (fullRender PageMode 80 1 string_txt "" tex)
-
-
-string_txt :: TextDetails -> String -> String
-string_txt (Chr c)   s  = c:s
-string_txt (Str s1)  s2 = s1 ++ s2
-string_txt (PStr s1) s2 = unpackFS s1 ++ s2
-string_txt (ZStr s1) s2 = zString s1 ++ s2
-string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
+  writeFile (odir  moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
 
 -- | Prints out an entry in a module export list.
 exportListItem :: ExportItem DocNameI -> LaTeX
-- 
cgit v1.2.3


From 090813eaa7a7dbc5ba20a979150ca37521849994 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Mon, 28 May 2018 03:13:15 +0200
Subject: Adjust to new HsDocString internals

---
 haddock-api/src/Haddock/Interface/Create.hs     | 10 +++++-----
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 15 +++++++--------
 2 files changed, 12 insertions(+), 13 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 8b929e15..b04a3777 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -58,7 +58,7 @@ import Packages   ( lookupModuleInAllPackages, PackageName(..) )
 import Bag
 import RdrName
 import TcRnTypes
-import FastString ( concatFS, unpackFS )
+import FastString ( concatFS, unpackFS, fastStringToByteString)
 import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
 import HsDecls ( getConArgs )
@@ -304,11 +304,11 @@ 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: " (concatFS $ map (sl_fs . unLoc) msg)
-  WarningTxt    _ msg -> format "Warning: "    (concatFS $ map (sl_fs . unLoc) msg)
+  DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (fastStringToByteString . sl_fs . unLoc) msg)
+  WarningTxt    _ msg -> format "Warning: "    (foldMap (fastStringToByteString . sl_fs . unLoc) msg)
   where
-    format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
-                  <$> processDocString dflags gre (HsDocString xs)
+    format x bs = DocWarning . DocParagraph . DocAppend (DocString x)
+                  <$> processDocString dflags gre (mkHsDocStringUtf8ByteString bs)
 
 
 -------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 9a978f9f..c598cb75 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -44,14 +44,13 @@ processDocStrings dflags pkg gre strs = do
     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 (HsDocString fs) =
-  overDocF (rename dflags gre) $ parseParas dflags pkg (unpackFS fs)
+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 (HsDocString fs) =
-  rename dflags gre $ parseString dflags (unpackFS fs)
+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))
@@ -59,8 +58,8 @@ processModuleHeader dflags pkgName gre safety mayStr = do
   (hmi, doc) <-
     case mayStr of
       Nothing -> return failure
-      Just (L _ (HsDocString fs)) -> do
-        let str = unpackFS fs
+      Just (L _ hds) -> do
+        let str = unpackHDS hds
             (hmi, doc) = parseModuleHeader dflags pkgName str
         !descr <- case hmi_description hmi of
                     Just hmi_descr -> Just <$> rename dflags gre hmi_descr
-- 
cgit v1.2.3


From 6be939f24f9db58c19a220daa0ff73d3a633a244 Mon Sep 17 00:00:00 2001
From: Ben Gamari 
Date: Sat, 2 Jun 2018 15:45:54 -0400
Subject: Remove ParallelArrays and Data Parallel Haskell

---
 haddock-api/src/Haddock/Backends/Hoogle.hs      | 1 -
 haddock-api/src/Haddock/Backends/LaTeX.hs       | 5 -----
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs  | 1 -
 haddock-api/src/Haddock/Interface/Rename.hs     | 1 -
 haddock-api/src/Haddock/Interface/Specialize.hs | 1 -
 haddock-api/src/Haddock/Types.hs                | 1 -
 6 files changed, 10 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 9a31428f..8d0318c2 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -80,7 +80,6 @@ dropHsDocTy = f
         f (HsAppTy x a b) = HsAppTy x (g a) (g b)
         f (HsFunTy x a b) = HsFunTy x (g a) (g b)
         f (HsListTy x a) = HsListTy x (g a)
-        f (HsPArrTy x a) = HsPArrTy x (g a)
         f (HsTupleTy x a b) = HsTupleTy x a (map g b)
         f (HsOpTy x a b c) = HsOpTy x (g a) b (g c)
         f (HsParTy x a) = HsParTy x (g a)
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index f8052895..a2f43ece 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -967,7 +967,6 @@ ppr_mono_ty _         (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u)
 ppr_mono_ty _         (HsSumTy _ tys) u       = sumParens (map (ppLType u) tys)
 ppr_mono_ty _         (HsKindSig _ ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)
 ppr_mono_ty _         (HsListTy _ ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsPArrTy _ ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ = text "{..}"
@@ -1290,10 +1289,6 @@ ubxparens :: LaTeX -> LaTeX
 ubxparens h = text "(#" <> h <> text "#)"
 
 
-pabrackets :: LaTeX -> LaTeX
-pabrackets h = text "[:" <> h <> text ":]"
-
-
 nl :: LaTeX
 nl = text "\\\\"
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3fbe6eaf..d4f6db0e 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1203,7 +1203,6 @@ ppr_mono_ty _         (HsSumTy _ tys) u q _ = sumParens (map (ppLType u q HideEm
 ppr_mono_ty _         (HsKindSig _ ty kind) u q e =
     parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind)
 ppr_mono_ty _         (HsListTy _ ty)       u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
-ppr_mono_ty _         (HsPArrTy _ ty)       u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts)
 ppr_mono_ty ctxt_prec (HsIParamTy _ (L _ n) ty) u q _ =
     maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts
 ppr_mono_ty _         (HsSpliceTy {})     _ _ _ = error "ppr_mono_ty HsSpliceTy"
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 7fb1f4b7..5684e70a 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -244,7 +244,6 @@ renameType t = case t of
     return (HsFunTy NoExt a' b')
 
   HsListTy _ ty -> return . (HsListTy NoExt) =<< renameLType ty
-  HsPArrTy _ ty -> return . (HsPArrTy NoExt) =<< renameLType ty
   HsIParamTy _ n ty -> liftM (HsIParamTy NoExt n) (renameLType ty)
   HsEqTy _ ty1 ty2 -> liftM2 (HsEqTy NoExt) (renameLType ty1) (renameLType ty2)
 
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 80fbc714..2fcb495c 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -257,7 +257,6 @@ renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name
 renameType (HsAppTy x lf la) = HsAppTy x <$> renameLType lf <*> renameLType la
 renameType (HsFunTy x la lr) = HsFunTy x <$> renameLType la <*> renameLType lr
 renameType (HsListTy x lt) = HsListTy x <$> renameLType lt
-renameType (HsPArrTy x lt) = HsPArrTy x <$> renameLType lt
 renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt
 renameType (HsSumTy x lt) = HsSumTy x <$> mapM renameLType lt
 renameType (HsOpTy x la lop lb) =
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 1115e829..e4d79760 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -675,7 +675,6 @@ type instance XAppsTy          DocNameI = NoExt
 type instance XAppTy           DocNameI = NoExt
 type instance XFunTy           DocNameI = NoExt
 type instance XListTy          DocNameI = NoExt
-type instance XPArrTy          DocNameI = NoExt
 type instance XTupleTy         DocNameI = NoExt
 type instance XSumTy           DocNameI = NoExt
 type instance XOpTy            DocNameI = NoExt
-- 
cgit v1.2.3


From 3b028ce3d1996f82cad8a273bcf95445238f5c6e Mon Sep 17 00:00:00 2001
From: Ryan Scott 
Date: Wed, 9 May 2018 10:42:03 -0400
Subject: DerivingVia changes

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs |  7 +------
 haddock-api/src/Haddock/Interface/Rename.hs            | 11 +++++++++--
 haddock-api/src/Haddock/Types.hs                       |  1 +
 3 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 34512de8..7abb01a3 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -211,6 +211,7 @@ classify tok =
     ITqualified            -> TkKeyword
     ITthen                 -> TkKeyword
     ITtype                 -> TkKeyword
+    ITvia                  -> TkKeyword
     ITwhere                -> TkKeyword
 
     ITforall            {} -> TkKeyword
@@ -261,9 +262,6 @@ classify tok =
     IToptions_prag      {} -> TkPragma
     ITinclude_prag      {} -> TkPragma
     ITlanguage_prag        -> TkPragma
-    ITvect_prag         {} -> TkPragma
-    ITvect_scalar_prag  {} -> TkPragma
-    ITnovect_prag       {} -> TkPragma
     ITminimal_prag      {} -> TkPragma
     IToverlappable_prag {} -> TkPragma
     IToverlapping_prag  {} -> TkPragma
@@ -408,9 +406,6 @@ inPragma False tok =
     IToptions_prag      {} -> True
     ITinclude_prag      {} -> True
     ITlanguage_prag        -> True
-    ITvect_prag         {} -> True
-    ITvect_scalar_prag  {} -> True
-    ITnovect_prag       {} -> True
     ITminimal_prag      {} -> True
     IToverlappable_prag {} -> True
     IToverlapping_prag  {} -> True
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 5684e70a..c07f8300 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -560,13 +560,20 @@ renameDerivD :: DerivDecl GhcRn -> RnM (DerivDecl DocNameI)
 renameDerivD (DerivDecl { deriv_type = ty
                         , deriv_strategy = strat
                         , deriv_overlap_mode = omode }) = do
-  ty' <- renameLSigWcType ty
+  ty'    <- renameLSigWcType ty
+  strat' <- mapM (mapM renameDerivStrategy) strat
   return (DerivDecl { deriv_ext = noExt
                     , deriv_type = ty'
-                    , deriv_strategy = strat
+                    , deriv_strategy = strat'
                     , deriv_overlap_mode = omode })
 renameDerivD (XDerivDecl _) = panic "haddock:renameDerivD"
 
+renameDerivStrategy :: DerivStrategy GhcRn -> RnM (DerivStrategy DocNameI)
+renameDerivStrategy StockStrategy    = pure StockStrategy
+renameDerivStrategy AnyclassStrategy = pure AnyclassStrategy
+renameDerivStrategy NewtypeStrategy  = pure NewtypeStrategy
+renameDerivStrategy (ViaStrategy ty) = ViaStrategy <$> renameLSigType ty
+
 renameClsInstD :: ClsInstDecl GhcRn -> RnM (ClsInstDecl DocNameI)
 renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
                             , cid_poly_ty =ltype, cid_tyfam_insts = lATs
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index e4d79760..1f96abc0 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -725,6 +725,7 @@ type instance XCFamEqn       DocNameI _ _ = NoExt
 
 type instance XCClsInstDecl DocNameI = NoExt
 type instance XCDerivDecl   DocNameI = NoExt
+type instance XViaStrategy  DocNameI = LHsSigType DocNameI
 type instance XDataFamInstD DocNameI = NoExt
 type instance XTyFamInstD   DocNameI = NoExt
 type instance XClsInstD     DocNameI = NoExt
-- 
cgit v1.2.3


From 9db17c50429d6dda5ef98a638e1228e877a80062 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Tue, 5 Jun 2018 13:53:25 -0700
Subject: Extract docs from strict/unpacked constructor args (#839)

This fixes #836.
---
 haddock-api/src/Haddock/Interface/Create.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index b04a3777..cf708503 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -485,6 +485,7 @@ conArgDocs con = case getConArgs con of
                    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
 
-- 
cgit v1.2.3


From 524566646723ced878d49c903358e7b5f25442b9 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 13 Jun 2018 23:10:43 +0200
Subject: Remove `ITtildehsh` token

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 7abb01a3..8f77b8f5 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -280,7 +280,6 @@ classify tok =
     ITrarrow            {} -> TkGlyph
     ITat                   -> TkGlyph
     ITtilde                -> TkGlyph
-    ITtildehsh             -> TkGlyph
     ITdarrow            {} -> TkGlyph
     ITminus                -> TkGlyph
     ITbang                 -> TkGlyph
-- 
cgit v1.2.3


From 52405584f978c8d1afd6439b3ac0e3fd0f9b825e Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Mon, 7 May 2018 18:53:15 -0700
Subject: Filter out CRLFs in hyperlinker backend (#813)

This prevents spurious lines from appearing in the final output.
---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 8f77b8f5..92443bff 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -24,8 +24,13 @@ import Haddock.Backends.Hyperlinker.Types as T
 -- (In reality, this only holds for input not containing '\r', '\t', '\f', '\v',
 -- characters, since GHC transforms those into ' ' and '\n')
 parse :: DynFlags -> FilePath -> String -> [T.Token]
-parse dflags fp s = ghcToks (processCPP dflags fp s)
-
+parse dflags fp = ghcToks . processCPP dflags fp . filterCRLF
+  where
+    -- Remove CRLFs from source
+    filterCRLF :: String -> String
+    filterCRLF ('\r':'\n':cs) = '\n' : filterCRLF cs
+    filterCRLF (c:cs) = c : filterCRLF cs
+    filterCRLF [] = []
 
 -- | Parse the source into tokens using the GHC lexer.
 --
-- 
cgit v1.2.3


From 00c401b965e1468aee71caa4cffd049cadd515d8 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Tue, 8 May 2018 04:00:18 +0200
Subject: Add docs for some DocH constructors (#814)

---
 haddock-library/src/Documentation/Haddock/Types.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 005ec186..b5dea3d4 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -107,8 +107,10 @@ data DocH mod id
   | DocParagraph (DocH mod id)
   | DocIdentifier id
   | DocIdentifierUnchecked mod
+  -- ^ A qualified identifier that couldn't be resolved.
   | DocModule String
   | DocWarning (DocH mod id)
+  -- ^ This constructor has no counterpart in Haddock markup.
   | DocEmphasis (DocH mod id)
   | DocMonospaced (DocH mod id)
   | DocBold (DocH mod id)
@@ -121,6 +123,7 @@ data DocH mod id
   | DocMathInline String
   | DocMathDisplay String
   | DocAName String
+  -- ^ A (HTML) anchor.
   | DocProperty String
   | DocExamples [Example]
   | DocHeader (Header (DocH mod id))
-- 
cgit v1.2.3


From 276c352b5dd3dd52b333e0d04ea71f7686ecd7b9 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Tue, 8 May 2018 02:15:45 -0700
Subject: Remove 'TokenGroup' from Hyperlinker (#818)

Since the hyperlinker backend now relies on the GHC tokenizer, something
like 'Bar.Baz.foo' already gets bunched together into one token (as
opposed to being spread across 'Bar', '.', 'Baz', '.', and 'foo').
---
 .../src/Haddock/Backends/Hyperlinker/Renderer.hs   | 64 +++++-----------------
 1 file changed, 14 insertions(+), 50 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 5291220a..d7ea70a6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
 
-
 module Haddock.Backends.Hyperlinker.Renderer (render) where
 
 
@@ -28,36 +27,10 @@ render :: Maybe FilePath -> Maybe FilePath -> SrcMap -> [RichToken]
        -> Html
 render mcss mjs srcs tokens = header mcss mjs <> body srcs tokens
 
-
-data TokenGroup
-    = GrpNormal Token
-    | GrpRich TokenDetails [Token]
-
-
--- | Group consecutive tokens pointing to the same element.
---
--- We want to render qualified identifiers as one entity. For example,
--- @Bar.Baz.foo@ consists of 5 tokens (@Bar@, @.@, @Baz@, @.@, @foo@) but for
--- better user experience when highlighting and clicking links, these tokens
--- should be regarded as one identifier. Therefore, before rendering we must
--- group consecutive elements pointing to the same 'GHC.Name' (note that even
--- dot token has it if it is part of qualified name).
-groupTokens :: [RichToken] -> [TokenGroup]
-groupTokens [] = []
-groupTokens ((RichToken tok Nothing):rest) = (GrpNormal tok):(groupTokens rest)
-groupTokens ((RichToken tok (Just det)):rest) =
-    let (grp, rest') = span same rest
-    in (GrpRich det (tok:(map rtkToken grp))):(groupTokens rest')
-  where
-    same (RichToken _ (Just det')) = det == det'
-    same _ = False
-
-
 body :: SrcMap -> [RichToken] -> Html
-body srcs tokens =
-    Html.body . Html.pre $ hypsrc
+body srcs tokens = Html.body . Html.pre $ hypsrc
   where
-    hypsrc = mconcat . map (tokenGroup srcs) . groupTokens $ tokens
+    hypsrc = mconcat . map (richToken srcs) $ tokens
 
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
@@ -78,29 +51,20 @@ header mcss mjs =
         , Html.src scriptFile
         ]
 
-
-tokenGroup :: SrcMap -> TokenGroup -> Html
-tokenGroup _ (GrpNormal tok@(Token { .. }))
+-- | Given information about the source position of definitions, render a token
+richToken :: SrcMap -> RichToken -> Html
+richToken srcs (RichToken Token{..} details)
     | tkType == TkSpace = renderSpace (GHC.srcSpanStartLine tkSpan) tkValue
-    | otherwise = tokenSpan tok ! attrs
-  where
-    attrs = [ multiclass . tokenStyle $ tkType ]
-tokenGroup srcs (GrpRich det tokens) =
-    externalAnchor det . internalAnchor det . hyperlink srcs det $ content
+    | otherwise = linked content
   where
-    content = mconcat . map (richToken det) $ tokens
-
-
-richToken :: TokenDetails -> Token -> Html
-richToken det tok =
-    tokenSpan tok ! [ multiclass style ]
-  where
-    style = (tokenStyle . tkType) tok ++ richTokenStyle det
-
-
-tokenSpan :: Token -> Html
-tokenSpan = Html.thespan . Html.toHtml . tkValue
-
+    content = tokenSpan ! [ multiclass style ]
+    tokenSpan = Html.thespan (Html.toHtml tkValue)
+    style = tokenStyle tkType ++ maybe [] richTokenStyle details
+
+    -- If we have name information, we can make links
+    linked = case details of
+      Just d -> externalAnchor d . internalAnchor d . hyperlink srcs d
+      Nothing -> id
 
 richTokenStyle :: TokenDetails -> [StyleClass]
 richTokenStyle (RtkVar _) = ["hs-var"]
-- 
cgit v1.2.3


From 8bc1c577a1a54f7326c408b52753ec3ed97fa7bc Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Tue, 8 May 2018 19:48:11 +0200
Subject: Renamer: Warn about out of scope identifiers. (#819)

---
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index c598cb75..c91b89d7 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -103,7 +103,9 @@ rename dflags gre = rn
           -- 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
@@ -112,7 +114,7 @@ rename dflags gre = rn
               -- type constructor names (such as in #253). So now we
               -- only get type constructor links if they are actually
               -- in scope.
-              a:_ -> pure (outOfScope dflags a)
+              a:_ -> outOfScope dflags a
 
           -- There is only one name in the environment that matches so
           -- use it.
@@ -153,12 +155,15 @@ 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 -> Doc a
+outOfScope :: DynFlags -> RdrName -> ErrMsgM (Doc a)
 outOfScope dflags x =
   case x of
-    Unqual occ -> monospaced occ
-    Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
-    Orig _ occ -> monospaced occ
-    Exact name -> monospaced name  -- Shouldn't happen since x is out of scope
+    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."]
+      pure (monospaced a)
     monospaced a = DocMonospaced (DocString (showPpr dflags a))
-- 
cgit v1.2.3


From e5098935e723f668fb2d283ef0393e72df32147a Mon Sep 17 00:00:00 2001
From: Ryan Scott 
Date: Thu, 10 May 2018 11:19:47 -0400
Subject: Remove Hoogle backend hack that butchers infix datatype names

---
 haddock-api/src/Haddock/Backends/Hoogle.hs | 3 +--
 hoogle-test/ref/Bug825/test.txt            | 9 +++++++++
 hoogle-test/src/Bug825/Bug825.hs           | 6 ++++++
 3 files changed, 16 insertions(+), 2 deletions(-)
 create mode 100644 hoogle-test/ref/Bug825/test.txt
 create mode 100644 hoogle-test/src/Bug825/Bug825.hs

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 8d0318c2..6d1bdad0 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -225,11 +225,10 @@ ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
 
         -- GHC gives out "data Bar =", we want to delete the equals
         -- also writes data : a b, when we want data (:) a b
-        showData d = unwords $ map f $ if last xs == "=" then init xs else xs
+        showData d = unwords $ if last xs == "=" then init xs else xs
             where
                 xs = words $ out dflags d
                 nam = out dflags $ tyClDeclLName d
-                f w = if w == nam then operator nam else w
 ppData _ _ _ = panic "ppData"
 
 -- | for constructors, and named-fields...
diff --git a/hoogle-test/ref/Bug825/test.txt b/hoogle-test/ref/Bug825/test.txt
new file mode 100644
index 00000000..a88202dc
--- /dev/null
+++ b/hoogle-test/ref/Bug825/test.txt
@@ -0,0 +1,9 @@
+-- Hoogle documentation, generated by Haddock
+-- See Hoogle, http://www.haskell.org/hoogle/
+
+@package test
+@version 0.0.0
+
+module Bug825
+data a :~: b
+data (:~~:) a b
diff --git a/hoogle-test/src/Bug825/Bug825.hs b/hoogle-test/src/Bug825/Bug825.hs
new file mode 100644
index 00000000..bfe07139
--- /dev/null
+++ b/hoogle-test/src/Bug825/Bug825.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+module Bug825 where
+
+data a :~: b
+data (:~~:) a b
-- 
cgit v1.2.3


From d1b26b4846f10fc3e0f84f6898852a6605a3e286 Mon Sep 17 00:00:00 2001
From: Ryan Scott 
Date: Thu, 10 May 2018 11:24:38 -0400
Subject: Wibbles

---
 haddock-api/src/Haddock/Backends/Hoogle.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 6d1bdad0..6e8148f7 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -223,12 +223,12 @@ ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs
       concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn)
     where
 
-        -- GHC gives out "data Bar =", we want to delete the equals
-        -- also writes data : a b, when we want data (:) a b
+        -- GHC gives out "data Bar =", we want to delete the equals.
+        -- There's no need to worry about parenthesizing infix data type names,
+        -- since this Outputable instance for TyClDecl gets this right already.
         showData d = unwords $ if last xs == "=" then init xs else xs
             where
                 xs = words $ out dflags d
-                nam = out dflags $ tyClDeclLName d
 ppData _ _ _ = panic "ppData"
 
 -- | for constructors, and named-fields...
-- 
cgit v1.2.3


From 622c45d56e0ccb11e3b8b0832654cb30c8369ba8 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Wed, 23 May 2018 02:29:05 -0700
Subject: Use `ClassOpSig` instead of `TypeSig` for class methods (#835)

* Fix minimal pragma handling

Class declarations contain 'ClassOpSig' not 'Typesig'. This should fix #834.

* Accept html-test output
---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs |  8 ++--
 html-test/ref/Bug26.html                       | 14 +++----
 html-test/ref/Bug613.html                      | 14 +++----
 html-test/ref/Bug647.html                      |  8 ----
 html-test/ref/Bug679.html                      |  8 ----
 html-test/ref/DeprecatedClass.html             | 28 +++++--------
 html-test/ref/Hash.html                        | 16 ++++---
 html-test/ref/Instances.html                   | 24 +++++++++++
 html-test/ref/Minimal.html                     | 36 +++++++++++-----
 html-test/ref/Operators.html                   | 34 +++++++--------
 html-test/ref/OrphanInstancesClass.html        |  8 ----
 html-test/ref/Test.html                        | 58 ++++++++++++--------------
 html-test/ref/Ticket61.html                    |  8 ----
 13 files changed, 124 insertions(+), 140 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d4f6db0e..819c9aa6 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -523,9 +523,9 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
                 -- ToDo: add associated type defaults
 
-            [ ppFunSig summary links loc doc names (hsSigWcType typ)
+            [ ppFunSig summary links loc doc names (hsSigType typ)
                        [] splice unicode pkg qual
-              | L _ (TypeSig _ lnames typ) <- sigs
+              | L _ (ClassOpSig _ False lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -585,12 +585,12 @@ ppClassDecl summary links instances fixities loc d subdocs
     minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
-                   sort [getName n | TypeSig _ ns _ <- sigs, L _ n <- ns]
+                   sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns]
         -> noHtml
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig _ ns _) <- lsigs, L _ n' <- ns]
+                        [getName n' | L _ (ClassOpSig _ _ ns _) <- lsigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html
index e50169ba..a363fef3 100644
--- a/html-test/ref/Bug26.html
+++ b/html-test/ref/Bug26.html
@@ -71,7 +71,11 @@
 	      > a where
      • c_f :: a
        • Since: 1.0
        Minimal complete definition
        c_f
        Methods
         f where
        • fmap :: (a -> b) -> f a -> f b
        •  #
          Minimal complete definition
          fmap
          Methods
           #
          Minimal complete definition
          f
          Methods
           #
          Minimal complete definition
          foo
          Methods
           a where
          • foo :: a -> a
          •  a where
            • bar :: a -> a
              • some class
              Minimal complete definition
              foo
              Methods
              Deprecated: SomeOtherClass
              Minimal complete definition
              bar
              Methods
               a where
              • hash :: a -> Int
                • A class of types which can be hashed.
                Minimal complete definition
                hash
                Methods
                 #
                Minimal complete definition
                Nothing
                Methods
                 #
                Minimal complete definition
                Nothing
                Methods
                 #
                Minimal complete definition
                Nothing
                Methods
                 #
                Minimal complete definition
                Nothing
                Associated Types
                 #
                Minimal complete definition
                (a, b, c | (d | e, (f | g)))
                Methods
                 #
                Minimal complete definition
                aaa, bbb
                Methods
                 #
                Minimal complete definition
                Nothing
                Methods
                 a ><< b
              • (>><), (<<>) :: a -> b -> ()
              • (**>), (**<), (>**), (<**) :: a -> a -> ()
              • Class with fixity, including associated types
                • Minimal complete definition
                (>><), (<<>), (**>), (**<), (>**), (<**)
                Associated Types
                 #
                Minimal complete definition
                aClass
                Methods
                 a where
                • a :: IO a
                • b :: [a]
                •  a where
                  • d :: T a b
                  • e :: (a, a)
                  •  a where
                    • ff :: a
                    •  class)
                      • Minimal complete definition
                      a, b
                      Methods
                      This is a class declaration with no separate docs for the methods
                      Minimal complete definition
                      d, e
                      Methods
                       #
                      Minimal complete definition
                      ff
                      Methods
                       #
                      Minimal complete definition
                      f
                      Methods
                      
Date: Tue, 5 Jun 2018 19:47:06 +0200
Subject: Bump a few dependency bounds (#845)

---
 haddock-api/haddock-api.cabal         | 6 +++---
 haddock-library/haddock-library.cabal | 8 ++++----
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 6a7fe0cb..ea294fdc 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -166,12 +166,12 @@ test-suite spec
     Haddock.Backends.Hyperlinker.Parser
     Haddock.Backends.Hyperlinker.Types
 
-  build-depends: Cabal           ^>= 2.0.0
+  build-depends: Cabal           ^>= 2.2
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
                , haddock-library ^>= 1.6.0
                , xhtml           ^>= 3000.2.2
-               , hspec           ^>= 2.4.4
+               , hspec           >= 2.4.4 && < 2.6
                , QuickCheck      ^>= 2.11
 
   -- Versions for the dependencies below are transitively pinned by
@@ -188,7 +188,7 @@ test-suite spec
                , transformers
 
   build-tool-depends:
-    hspec-discover:hspec-discover ^>= 2.4.4
+    hspec-discover:hspec-discover >= 2.4.4 && < 2.6
 
 source-repository head
   type:     git
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index 2fadeb65..df2dbf93 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -72,18 +72,18 @@ test-suite spec
 
   build-depends:
       base         >= 4.5     && < 4.12
-    , base-compat   ^>= 0.9.3
+    , base-compat  >= 0.9.3   && < 0.11
     , bytestring   >= 0.9.2.1 && < 0.11
     , containers   >= 0.4.2.1 && < 0.6
     , transformers   >= 0.3.0   && < 0.6
-    , hspec         ^>= 2.4.4
+    , hspec        >= 2.4.4   && < 2.6
     , QuickCheck    ^>= 2.11
     , text         >= 1.2.3.0  && < 1.3
     , parsec       >= 3.1.13.0 && < 3.2
     , deepseq      >= 1.3     && < 1.5
 
   build-tool-depends:
-    hspec-discover:hspec-discover ^>= 2.4.4
+    hspec-discover:hspec-discover >= 2.4.4 && < 2.6
 
 test-suite fixtures
   type:             exitcode-stdio-1.0
@@ -93,7 +93,7 @@ test-suite fixtures
   hs-source-dirs:   fixtures
   build-depends:
       base         >= 4.5     && < 4.12
-    , base-compat           ^>= 0.9.3
+    , base-compat  >= 0.9.3   && < 0.11
     , directory             ^>= 1.3.0.2
     , filepath              ^>= 1.4.1.2
     , optparse-applicative  ^>= 0.14.0.0
-- 
cgit v1.2.3


From 254de3010dddb06bc1dacf4c029a9e8f30ff1600 Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Tue, 5 Jun 2018 10:47:16 -0700
Subject: Improve hyperlinker's 'spanToNewline' (#846)

'spanToNewline' is used to help break apart the source into lines which
can then be partioned into CPP and non-CPP chunks. It is important that
'spanToNewline' not break apart tokens, so it needs to properly handle
things like

  * block comments, possibly nested
  * string literals, possibly multi-line
  * CPP macros, possibly multi-line

String literals in particular were not being properly handled. The fix
is to to fall back in 'Text.Read.lex' to help lex things that are not
comments.

Fixes #837.
---
 .../src/Haddock/Backends/Hyperlinker/Parser.hs     |  32 ++-
 hypsrc-test/ref/src/CPP.html                       | 216 +++++++++++++++++++++
 hypsrc-test/src/CPP.hs                             |  26 +++
 3 files changed, 267 insertions(+), 7 deletions(-)
 create mode 100644 hypsrc-test/ref/src/CPP.html
 create mode 100644 hypsrc-test/src/CPP.hs

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 92443bff..e7ecac73 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -3,6 +3,8 @@ module Haddock.Backends.Hyperlinker.Parser (parse) where
 import Data.Either         ( isRight, isLeft )
 import Data.List           ( foldl', isPrefixOf, isSuffixOf )
 import Data.Maybe          ( maybeToList )
+import Data.Char           ( isSpace )
+import qualified Text.Read as R
 
 import GHC                 ( DynFlags, addSourceToTokens )
 import SrcLoc
@@ -109,12 +111,9 @@ isCPPline :: String -> Bool
 isCPPline = isPrefixOf "#" . dropWhile (`elem` " \t") . take 5
 
 
--- | Split a "line" off the front of a string, supporting newline escapes.
---
--- By "line", we understand: the shortest substring ending in a '\n' that is not
---
---   1. immediately preceded by a '\\'
---   2. not inside some (possibly nested) block comment
+-- | Split a "line" off the front of a string, hopefully without cutting tokens
+-- in half. I say "hopefully" because knowing what a token is requires lexing,
+-- yet lexing depends on this function.
 --
 -- All characters in the input are present in the output:
 --
@@ -122,17 +121,36 @@ isCPPline = isPrefixOf "#" . dropWhile (`elem` " \t") . take 5
 spanToNewline :: Int                 -- ^ open '{-'
               -> String              -- ^ input
               -> (String, String)
-spanToNewline _ [] = ([], [])
+
+-- Base case and space characters
+spanToNewline _ "" = ("", "")
+spanToNewline n ('\n':str) | n <= 0 = ("\n", str)
 spanToNewline n ('\n':str) | n <= 0 = ("\n", str)
 spanToNewline n ('\\':'\n':str) =
     let (str', rest) = spanToNewline n str
     in ('\\':'\n':str', rest)
+
+-- Block comments
 spanToNewline n ('{':'-':str) =
     let (str', rest) = spanToNewline (n+1) str
     in ('{':'-':str', rest)
 spanToNewline n ('-':'}':str) =
     let (str', rest) = spanToNewline (n-1) str
     in ('-':'}':str', rest)
+
+-- When not in a block comment, try to lex a Haskell token
+spanToNewline 0 str@(c:_) | ((lexed, str') : _) <- R.lex str, not (isSpace c) =
+    if all (== '-') lexed && length lexed >= 2
+      -- A Haskell line comment
+      then case span (/= '\n') str' of
+             (str'', '\n':rest) -> (lexed ++ str'' ++ "\n", rest)
+             (_, _) -> (str, "") 
+
+      -- An actual Haskell token
+      else let (str'', rest) = spanToNewline 0 str'
+           in (lexed ++ str'', rest)
+
+-- In all other cases, advance one character at a time
 spanToNewline n (c:str) =
     let (str', rest) = spanToNewline n str
     in (c:str', rest)
diff --git a/hypsrc-test/ref/src/CPP.html b/hypsrc-test/ref/src/CPP.html
new file mode 100644
index 00000000..fb85bd2f
--- /dev/null
+++ b/hypsrc-test/ref/src/CPP.html
@@ -0,0 +1,216 @@
+
                      {-# LANGUAGE CPP #-}
+module CPP where
+
+#define SOMETHING1
+
+foo :: String
+foo = {-  " single quotes are fine in block comments
+          {- nested block comments are fine -}
+       -} "foo"
+
+#define SOMETHING2
+
+bar :: String
+bar = "block comment in a string is not a comment {- "
+
+#define SOMETHING3
+
+-- " single quotes are fine in line comments
+-- {- unclosed block comments are fine in line comments
+
+-- Multiline CPP is also fine
+#define FOO\
+  1
+
+baz :: String
+baz = "line comment in a string is not a comment --"
+
                      
\ No newline at end of file
diff --git a/hypsrc-test/src/CPP.hs b/hypsrc-test/src/CPP.hs
new file mode 100644
index 00000000..f00ce031
--- /dev/null
+++ b/hypsrc-test/src/CPP.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE CPP #-}
+module CPP where
+
+#define SOMETHING1
+
+foo :: String
+foo = {-  " single quotes are fine in block comments
+          {- nested block comments are fine -}
+       -} "foo"
+
+#define SOMETHING2
+
+bar :: String
+bar = "block comment in a string is not a comment {- "
+
+#define SOMETHING3
+
+-- " single quotes are fine in line comments
+-- {- unclosed block comments are fine in line comments
+
+-- Multiline CPP is also fine
+#define FOO\
+  1
+
+baz :: String
+baz = "line comment in a string is not a comment --"
-- 
cgit v1.2.3


From 02b2f1d46d0982f19e339051ca13e6cb203840cb Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Fri, 8 Jun 2018 22:20:30 +0200
Subject: Renamer: Warn about ambiguous identifiers (#831)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* Renamer: Warn about ambiguous identifiers

Example:

    Warning: 'elem' is ambiguous. It is defined
        * in ‘Data.Foldable’
        * at /home/simon/tmp/hdk/src/Lib.hs:7:1
        You may be able to disambiguate the identifier by qualifying it or
        by hiding some imports.
        Defaulting to 'elem' defined at /home/simon/tmp/hdk/src/Lib.hs:7:1

Fixes #830.

* Deduplicate warnings

Fixes #832.
---
 haddock-api/src/Haddock/Interface.hs            |  4 ++--
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 20 +++++++++++++++++---
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 89064a6c..a66745ea 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -184,10 +184,10 @@ processModule verbosity modsum flags modMap instIfaceMap = do
 
   if not $ isBootSummary modsum then do
     out verbosity verbose "Creating interface..."
-    (interface, msg) <- {-# SCC createIterface #-}
+    (interface, msgs) <- {-# SCC createIterface #-}
                         withTiming getDynFlags "createInterface" (const ()) $ do
                           runWriterGhc $ createInterface tm flags modMap instIfaceMap
-    liftIO $ mapM_ putStrLn msg
+    liftIO $ mapM_ putStrLn (nub msgs)
     dflags <- getDynFlags
     let (haddockable, haddocked) = ifaceHaddockCoverage interface
         percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index c91b89d7..d8793d63 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -28,7 +28,7 @@ import Haddock.Interface.ParseModuleHeader
 import Haddock.Parser
 import Haddock.Types
 import Name
-import Outputable ( showPpr )
+import Outputable ( showPpr, showSDoc )
 import RdrName
 import EnumSet
 import RnEnv (dataTcOccs)
@@ -119,11 +119,11 @@ rename dflags gre = rn
           -- There is only one name in the environment that matches so
           -- use it.
           [a] -> pure (DocIdentifier a)
+
           -- But when there are multiple names available, default to
           -- type constructors: somewhat awfully GHC returns the
           -- values in the list positionally.
-          a:b:_ | isTyConName a -> pure (DocIdentifier a)
-                | otherwise -> pure (DocIdentifier b)
+          a:b:_ -> ambiguous dflags x (if isTyConName a then a else b) names
 
       DocWarning doc -> DocWarning <$> rn doc
       DocEmphasis doc -> DocEmphasis <$> rn doc
@@ -167,3 +167,17 @@ outOfScope dflags x =
       tell ["Warning: '" ++ showPpr dflags a ++ "' is out of scope."]
       pure (monospaced a)
     monospaced a = DocMonospaced (DocString (showPpr dflags a))
+
+-- | Warn about an ambiguous identifier.
+ambiguous :: DynFlags -> RdrName -> Name -> [Name] -> ErrMsgM (Doc Name)
+ambiguous dflags x dflt names = do
+  tell [msg]
+  pure (DocIdentifier dflt)
+  where
+    msg = "Warning: " ++ x_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
+    x_str = '\'' : showPpr dflags x ++ "'"
+    defnLoc = showSDoc dflags . pprNameDefnLoc
-- 
cgit v1.2.3


From 083faee1cec2df01d7ab8a4ef2dc0a28c0c120cf Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 13 Jun 2018 23:28:47 +0200
Subject: Complete FixitySig and FamilyDecl pattern matches

---
 haddock-api/src/Haddock/Backends/Hoogle.hs          | 1 +
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 3 +++
 2 files changed, 4 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 6e8148f7..257a8d6d 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -201,6 +201,7 @@ ppFam dflags decl@(FamilyDecl { fdInfo = info })
               -- for Hoogle, so pretend it doesn't have any.
               ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily }
               _                  -> decl
+ppFam _ XFamilyDecl {} = panic "ppFam"
 
 ppInstance :: DynFlags -> ClsInst -> [String]
 ppInstance dflags x =
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 220a59fe..0ecf7109 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -183,8 +183,11 @@ decls (group, _, _, _) = concatMap ($ group)
     fix term = case cast term of
         Just ((GHC.FixitySig _ names _) :: GHC.FixitySig GHC.GhcRn)
           -> map (\(GHC.L sspan x) -> (sspan, RtkVar x)) names
+        Just ((GHC.XFixitySig {}) :: GHC.FixitySig GHC.GhcRn)
+          -> GHC.panic "haddock:decls"
         Nothing -> empty
     tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
+    tyfam (GHC.L _ (GHC.XFamilyDecl {})) = GHC.panic "haddock:dels"
     sig (GHC.L _ (GHC.TypeSig _ names _)) = map decl names
     sig (GHC.L _ (GHC.PatSynSig _ names _)) = map decl names
     sig (GHC.L _ (GHC.ClassOpSig _ _ names _)) = map decl names
-- 
cgit v1.2.3


From 39a35291045de99b2dabb9cddf5bb16d294c2f3b Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 13 Jun 2018 23:32:37 +0200
Subject: Fix redundant import warnings

---
 haddock-api/src/Haddock/Backends/LaTeX.hs       | 2 +-
 haddock-api/src/Haddock/Interface/Create.hs     | 2 +-
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 1 -
 haddock-api/src/Haddock/Types.hs                | 2 --
 haddock-api/src/Haddock/Utils.hs                | 1 -
 5 files changed, 2 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index a2f43ece..3cc4c278 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -27,7 +27,7 @@ import GHC
 import OccName
 import Name                 ( nameOccName )
 import RdrName              ( rdrNameOcc )
-import FastString           ( unpackFS, unpackLitString, zString )
+import FastString           ( unpackFS )
 import Outputable           ( panic)
 
 import qualified Data.Map as Map
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index cf708503..78242990 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -58,7 +58,7 @@ import Packages   ( lookupModuleInAllPackages, PackageName(..) )
 import Bag
 import RdrName
 import TcRnTypes
-import FastString ( concatFS, unpackFS, fastStringToByteString)
+import FastString ( unpackFS, fastStringToByteString)
 import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
 import HsDecls ( getConArgs )
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index d8793d63..731f2a35 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -22,7 +22,6 @@ import Data.List
 import Documentation.Haddock.Doc (metaDocConcat)
 import DynFlags (languageExtensions)
 import qualified GHC.LanguageExtensions as LangExt
-import FastString
 import GHC
 import Haddock.Interface.ParseModuleHeader
 import Haddock.Parser
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 1f96abc0..a5ebfa42 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -38,8 +38,6 @@ import BasicTypes (Fixity(..))
 import GHC hiding (NoLink)
 import DynFlags (Language)
 import qualified GHC.LanguageExtensions as LangExt
-import Coercion
-import NameSet
 import OccName
 import Outputable
 import Control.Applicative (Applicative(..))
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index e3cc9655..c2cdddf7 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -62,7 +62,6 @@ import Haddock.GhcUtils
 
 import GHC
 import Name
-import NameSet ( emptyNameSet )
 import HsTypes (extFieldOcc)
 import Outputable ( panic )
 
-- 
cgit v1.2.3


From ce568c3afb00610d659d3c2bab022983d252f1cd Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 13 Jun 2018 23:49:52 +0200
Subject: html-test: Accept output

---
 html-test/ref/A.html                             |  24 +-
 html-test/ref/Bug280.html                        |   4 +-
 html-test/ref/Bug294.html                        |  16 +-
 html-test/ref/Bug3.html                          |   8 +-
 html-test/ref/Bug310.html                        |  46 +--
 html-test/ref/Bug387.html                        |  16 +-
 html-test/ref/Bug4.html                          |   8 +-
 html-test/ref/Bug546.html                        |  20 +-
 html-test/ref/Bug548.html                        | 256 +++------------
 html-test/ref/Bug6.html                          |  60 +---
 html-test/ref/Bug613.html                        |  10 +-
 html-test/ref/Bug8.html                          |   4 +-
 html-test/ref/Bug85.html                         |  14 +-
 html-test/ref/BugDeprecated.html                 |  48 +--
 html-test/ref/BugExportHeadings.html             |  48 +--
 html-test/ref/Bugs.html                          |   4 +-
 html-test/ref/BundledPatterns.html               |  36 +-
 html-test/ref/BundledPatterns2.html              |  36 +-
 html-test/ref/ConstructorPatternExport.html      |  30 +-
 html-test/ref/DeprecatedFunction.html            |  16 +-
 html-test/ref/DeprecatedFunction2.html           |   8 +-
 html-test/ref/DeprecatedFunction3.html           |   8 +-
 html-test/ref/DeprecatedModule.html              |   4 +-
 html-test/ref/DeprecatedModule2.html             |   4 +-
 html-test/ref/DeprecatedNewtype.html             |  16 +-
 html-test/ref/DeprecatedReExport.html            |   8 +-
 html-test/ref/DeprecatedRecord.html              |  16 +-
 html-test/ref/DeprecatedTypeFamily.html          |  24 +-
 html-test/ref/DeprecatedTypeSynonym.html         |  16 +-
 html-test/ref/Examples.html                      |  16 +-
 html-test/ref/FunArgs.html                       |  16 +-
 html-test/ref/GADTRecords.html                   |  54 ++-
 html-test/ref/Hash.html                          |  96 ++----
 html-test/ref/HiddenInstances.html               |  26 +-
 html-test/ref/Hyperlinks.html                    |   8 +-
 html-test/ref/Instances.html                     | 398 ++++-------------------
 html-test/ref/Math.html                          |   8 +-
 html-test/ref/ModuleWithWarning.html             |   4 +-
 html-test/ref/NoLayout.html                      |   8 +-
 html-test/ref/Operators.html                     |   8 +-
 html-test/ref/OrphanInstances.html               |   4 +-
 html-test/ref/OrphanInstancesClass.html          |   8 +-
 html-test/ref/OrphanInstancesType.html           |   8 +-
 html-test/ref/PatternSyns.html                   |  32 +-
 html-test/ref/PromotedTypes.html                 |  28 +-
 html-test/ref/Properties.html                    |  16 +-
 html-test/ref/QuasiExpr.html                     |  80 +----
 html-test/ref/QuasiQuote.html                    |   4 +-
 html-test/ref/SpuriousSuperclassConstraints.html |  44 +--
 html-test/ref/TH.html                            |   6 +-
 html-test/ref/Test.html                          | 320 ++++--------------
 html-test/ref/Threaded.html                      |   8 +-
 html-test/ref/Threaded_TH.html                   |  12 +-
 html-test/ref/Ticket112.html                     |   4 +-
 html-test/ref/Ticket75.html                      |   8 +-
 html-test/ref/TitledPicture.html                 |  16 +-
 html-test/ref/TypeFamilies.html                  | 120 +++----
 html-test/ref/Unicode.html                       |   8 +-
 html-test/ref/Visible.html                       |   6 +-
 59 files changed, 460 insertions(+), 1722 deletions(-)

diff --git a/html-test/ref/A.html b/html-test/ref/A.html
index e4802966..c6965abc 100644
--- a/html-test/ref/A.html
+++ b/html-test/ref/A.html
@@ -54,15 +54,11 @@
 	    >
                    • other :: Int
                      •  :: Int
                    • test2 :: Bool
                      •  :: Bool
                    • data
                    • reExport :: Int
                      •  :: Int
                      other :: Int  :: Int #
                      test2 :: Bool  :: Bool #
                      reExport :: Int  :: Int #
                      x :: [Char]  :: [Char] #
                      gadtField :: ({..} -> GADT  :: GADT A) ->  -> A #data family TP t :: *  t :: * #
                      data family DP t :: *  t :: * #
                      data family TO' t :: *  t :: * #
                    • foo :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                      Bug310
                      Synopsis
                      • type family (a :: Nat) + (b :: Nat) :: Nat where ...
                      Documentation
                      type family (a :: Nat)  (a :: Nat) + (b :: Nat) :: Nat  (b :: Nat) :: Nat where ... infixl 6 #
                      Addition of type-level naturals.
                      Since: base-4.7.0.0
                      
+>
\ No newline at end of file
diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html
index ba2f5c91..da1b1ee5 100644
--- a/html-test/ref/Bug387.html
+++ b/html-test/ref/Bug387.html
@@ -60,15 +60,11 @@
 	  >
                    • test1 :: Int
                      •  :: Int
                    • test2 :: Int
                      •  :: Int
                      test1 :: Int  :: Int #
                      test2 :: Int  :: Int #
                    • foo :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                    • x :: Integer
                      •  :: Integer
                    • compile :: String -> String
                      •  :: String -> String
                      x :: Integer  :: Integer #
                      compile :: String -> String  :: String -> String #
                      newtype WrappedArrow (a :: * -> * -> *) b c  (a :: * -> * -> *) b c #
                       Generic1 ( Generic1 (WrappedArrow a b :: * -> *) a b :: * -> *)
                      type Rep1 (WrappedArrow a b) :: k -> * #
                       Rep1 (WrappedArrow a b) :: k -> *
                      from1 :: WrappedArrow a b a0 -> Rep1 ( a b a0 -> Rep1 (WrappedArrow a b) a0 #
                       a b) a0
                      to1 :: Rep1 ( :: Rep1 (WrappedArrow a b) a0 -> WrappedArrow a b a0 #
                       a b a0
                       Arrow a => Functor ( Arrow a => Functor (WrappedArrow a b) Arrow a => Applicative ( Arrow a => Applicative (WrappedArrow a b) (ArrowZero a, ArrowPlus a) => Alternative ( (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) Generic ( Generic (WrappedArrow a b c)
                      type Rep (WrappedArrow a b c) :: * -> * #
                       Rep (WrappedArrow a b c) :: * -> *
                      from :: WrappedArrow a b c -> Rep ( a b c -> Rep (WrappedArrow a b c) x #
                       a b c) x
                      to :: Rep ( :: Rep (WrappedArrow a b c) x -> WrappedArrow a b c #
                       a b c
                      typeRep1 ( Rep1 (WrappedArrow a b :: * -> *) a b :: * -> *)
                      type Rep1 ( Rep1 (WrappedArrow a b :: * -> *) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 (MetaCons "WrapArrow" PrefixI True) (S1 (MetaSel (Just "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 (a b))))
                       a b :: * -> *) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 (MetaCons "WrapArrow" PrefixI True) (S1 (MetaSel (Just "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 (a b))))typeRep ( Rep (WrappedArrow a b c)
                      type Rep ( Rep (WrappedArrow a b c) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 (MetaCons "WrapArrow" PrefixI True) (S1 (MetaSel (Just "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a b c))))
                       a b c) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" True) (C1 (MetaCons "WrapArrow" PrefixI True) (S1 (MetaSel (Just "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (a b c))))
+>
\ No newline at end of file
diff --git a/html-test/ref/Bug6.html b/html-test/ref/Bug6.html
index 15842547..27f73d64 100644
--- a/html-test/ref/Bug6.html
+++ b/html-test/ref/Bug6.html
@@ -58,9 +58,7 @@
 	      >A = AInt Int
                    • dataB = B Int
                      •  Int
                    • b :: B -> Int
                      •  -> Int
                    • data
                    • c1 :: Int
                      •  :: Int
                    • c2 :: Int
                      •  :: Int}
                    • D = D Int Int
                      •  Int Int
                    • newtypeE = E Int
                      •  Int Int Intb :: B -> Int -> Int #
                      c1 :: Int :: Int
                      c2 :: Int :: Int
                       Int Int IntFunctor (Either a) (Either a)#
                      fmap :: (a0 -> b) -> Either a a0 -> Either a b  :: (a0 -> b) -> Either a a0 -> Either a b #
                      (--->) :: Foldable t0 => t0 t ->  :: Foldable t0 => t0 t -> Typ -> Typdata Foo :: (* -> *) -> * -> *  :: (* -> *) -> * -> * where #data Baz :: *  :: * where #
                    • foo :: Int
                      •  :: Int
                    • bar :: Int
                      •  :: Int
                    • baz :: Int
                      •  :: Int
                    • one :: Int
                      •  :: Int
                    • two :: Int
                      •  :: Int
                    • three :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                      bar :: Int  :: Int #
                      baz :: Int  :: Int #
                      one :: Int  :: Int #
                      two :: Int  :: Int #
                      three :: Int  :: Int #
                    • foo :: Int
                      •  :: Int
                    • bar :: Int
                      •  :: Int
                    • baz :: Int
                      •  :: Int
                    • one :: Int
                      •  :: Int
                    • two :: Int
                      •  :: Int
                    • three :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                      bar :: Int  :: Int #
                      baz :: Int  :: Int #
                      one :: Int  :: Int #
                      two :: Int  :: Int #
                      three :: Int  :: Int #
                       a (a -> Int)dataVec :: Nat -> * -> * :: Nat -> * -> * where
                      foo :: Int  :: Int #
                    • foo :: Integer
                      •  :: Integer
                      foo :: Integer  :: Integer #
                      foo :: Int  :: Int #
                      foo :: Int  :: Int #
                      SomeNewType = SomeNewTypeConst String String
                    • newtypeSomeOtherNewType = SomeOtherNewTypeConst String
                      •  String                       String String
                      :: :: R
                      -> -> N1 ()
                      -> -> IO  Intdata Bat* X
                      data  Bat *  X  type  Foo *  X 
                      type  Foo *  X =  = Y
                       type (<>) *  X a <> (a :: *) #
                      type (<>) *  X a =  <> (a :: *) = X
                        Assoc *  Y 
                      data  AssocD  Y (a :: Y) ::  :: * #
                      type  AssocT Y (a ::  Y) ::  :: * #  Test *  Y  data  Bar  Y 
                      data  Bar  Y
                       data  AssocD *  Y 
                      data  AssocD *  Y = AssocY type  AssocT *  Y 
                      type  AssocT *  Y =  = Bat *  Y
                       data  Bat *  Y 
                      data  Bat *  Y = BatY  Y
                       type  Foo *  Y 
                      type  Foo *  Y =  = X
                       type (<>) *  Y a <> (a :: *) #
                      type (<>) *  Y a = a
                       <> (a :: *) = a
                       data  Bat  (z :: Z) #
                      data  Bat  (z :: Z ) where  Test *  Y   Test *  X  type  Foo *  Y 
                      type  Foo *  Y =  = X
                       type  Foo *  X 
                      type  Foo *  X =  = Y
                      data family Bat (a :: k) ::  (a :: k) :: * # data  Bat  (z :: Z) #
                      data  Bat  (z :: Z ) where data  Bat *  Y 
                      data  Bat *  Y = BatY  Y
                       data  Bat *  X 
                      data  Bat *  X data AssocD a ::  a :: * #type AssocT a ::  a :: * #  Assoc *  Y 
                      data  AssocD  Y (a :: Y) ::  :: * #
                      type  AssocT Y (a ::  Y) ::  :: * #  Assoc *  X 
                      data  AssocD  X (a :: X) ::  :: * #
                      type  AssocT X (a ::  X) ::  :: * #
                      :: :: Float
                      -> -> IO  Float
                      f' ::  :: Int #
                      a function with a prime can be referred to as f'
@@ -2283,7 +2359,7 @@ is at the beginning of the line).
                      withType ::  :: Int #
                    • f ::  :: Integer
                      • f ::  :: Integer #
                      ...given a raw Addr# to the string, and the length of the string.
                      Minimal complete definition
                      f
                    • f ::  :: Int
                      • f ::  :: Int #
                      A reference to :-
                    • foo ::  :: Integer
                    • bar ::  :: Integer
                      • foo ::  :: Integer #
                      Picture for foo without a title 
                      bar ::  :: Integer #
                      Picture for bar with title data family Bat (a :: k) ::  (a :: k) :: *
                    • data AssocD a ::  a :: *
                    • type AssocT a ::  a :: *
                      •  (><) X  XX  >< XXX   Assoc *  X 
                      data  AssocD X (a ::  X) ::  :: * #
                      type  AssocT  X (a :: X) ::  :: * #  Test *  X  type  Foo  X 
                      type  Foo  X =  = Y
                       type (<>) X  XXX  <> XX 
                      type (<>) X  XXX  <> XX =  = X
                       data  AssocD *  X 
                      data  AssocD *  X = AssocX type  AssocT *  X 
                      type  AssocT *  X =  = (Foo *  X
                       :: *)
                           
                      type (<>) *  Y a = a
                      <> (a :: *) = atype(<>)* X a<> (a :: *)#
                      type (<>) *  X a =  <> (a :: *) = X
                       (><) X  XX  >< XXX data  Bar W
                      data  Bar  W = BarX type  Foo  W 
                      type  Foo  W
                       type  Foo  W 
                      type  Foo  W
                       type  Foo  X 
                      type  Foo  X =  = Y
                       data  Bar  W 
                      data  Bar  W = BarX data  Bar  Y 
                      data  Bar  Y
                      biO :: (g  :: (g `O` f) a #
                      x :: (a  :: (a :-: a)  a) <=> (a  (a `Op` a) => a #
                      y :: (a  :: (a <=> a, (a  a, (a `Op` a)  a) <=> a) => a #
                    • x ::  :: Int
                      • x ::  :: Int #
                      visible ::  :: Int ->  -> Int #
Date: Mon, 5 Feb 2018 18:14:32 -0800
Subject: Support unicode operators, proper modules

Unicode operators are a pretty big thing in Haskell, so supporting linking them
seems like it outweighs the cost of the extra machinery to force Attoparsec to
look for unicode.

Fixes #458.
---
 haddock-library/haddock-library.cabal              |  2 +-
 .../src/Documentation/Haddock/Parser.hs            | 34 ++++-----
 .../src/Documentation/Haddock/Parser/Monad.hs      | 25 ++++++-
 html-test/ref/Bug458.html                          | 80 ++++++++++++++++++++++
 html-test/src/Bug458.hs                            |  6 ++
 5 files changed, 122 insertions(+), 25 deletions(-)
 create mode 100644 html-test/ref/Bug458.html
 create mode 100644 html-test/src/Bug458.hs

diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index 3d069f07..d7935747 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -64,13 +64,13 @@ library attoparsec
   exposed-modules:
     Data.Attoparsec.ByteString
     Data.Attoparsec.ByteString.Char8
+    Data.Attoparsec.Combinator
 
   other-modules:
     Data.Attoparsec
     Data.Attoparsec.ByteString.Buffer
     Data.Attoparsec.ByteString.FastSet
     Data.Attoparsec.ByteString.Internal
-    Data.Attoparsec.Combinator
     Data.Attoparsec.Internal
     Data.Attoparsec.Internal.Fhthagn
     Data.Attoparsec.Internal.Types
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index a1349c95..82515ab4 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -23,7 +23,7 @@ import           Control.Applicative
 import           Control.Arrow (first)
 import           Control.Monad
 import qualified Data.ByteString.Char8 as BS
-import           Data.Char (chr, isAsciiUpper)
+import           Data.Char (chr, isUpper, isAlpha, isAlphaNum)
 import           Data.List (stripPrefix, intercalate, unfoldr, elemIndex)
 import           Data.Maybe (fromMaybe, mapMaybe)
 import           Data.Monoid
@@ -35,6 +35,7 @@ import           Documentation.Haddock.Types
 import           Documentation.Haddock.Utf8
 import           Prelude hiding (takeWhile)
 import qualified Prelude as P
+import           Text.Read.Lex (isSymbolChar)
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -205,20 +206,19 @@ monospace :: Parser (DocH mod Identifier)
 monospace = DocMonospaced . parseStringBS
             <$> ("@" *> takeWhile1_ (/= '@') <* "@")
 
--- | Module names: we try our reasonable best to only allow valid
--- Haskell module names, with caveat about not matching on technically
--- valid unicode symbols.
+-- | Module names.
+--
+-- Note that we allow '#' and '\' to support anchors (old style anchors are of
+-- the form "SomeModule\#anchor").
 moduleName :: Parser (DocH mod a)
 moduleName = DocModule <$> (char '"' *> modid <* char '"')
   where
     modid = intercalate "." <$> conid `sepBy1` "."
     conid = (:)
-      <$> satisfy isAsciiUpper
-      -- NOTE: According to Haskell 2010 we should actually only
-      -- accept {small | large | digit | ' } here.  But as we can't
-      -- match on unicode characters, this is currently not possible.
-      -- Note that we allow ‘#’ to suport anchors.
-      <*> (decodeUtf8 <$> takeWhile (notInClass " .&[{}(=*)+]!|@/;,^?\"\n"))
+      <$> satisfyUnicode (\c -> isAlpha c && isUpper c)
+      <*> many (satisfyUnicode conChar <|> char '\\' <|> char '#')
+
+    conChar c = isAlphaNum c || c == '_'
 
 -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify
 -- a title for the picture.
@@ -760,26 +760,16 @@ autoUrl = mkLink <$> url
 parseValid :: Parser String
 parseValid = p some
   where
-    idChar =
-      satisfy (\c -> isAlpha_ascii c
-                     || isDigit c
-                     -- N.B. '-' is placed first otherwise attoparsec thinks
-                     -- it belongs to a character class
-                     || inClass "-_.!#$%&*+/<=>?@\\|~:^" c)
+    idChar = satisfyUnicode (\c -> isAlphaNum c || isSymbolChar c || c == '_')
 
     p p' = do
-      vs' <- p' $ utf8String "⋆" <|> return <$> idChar
-      let vs = concat vs'
+      vs <- p' idChar
       c <- peekChar'
       case c of
         '`' -> return vs
         '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> p many') <|> return vs
         _ -> fail "outofvalid"
 
--- | Parses UTF8 strings from ByteString streams.
-utf8String :: String -> Parser String
-utf8String x = decodeUtf8 <$> string (encodeUtf8 x)
-
 -- | Parses identifiers with help of 'parseValid'. Asks GHC for
 -- 'String' from the string it deems valid.
 identifier :: Parser (DocH mod Identifier)
diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
index 3f7d60f8..3430ef8a 100644
--- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, BangPatterns #-}
 module Documentation.Haddock.Parser.Monad (
   module Documentation.Haddock.Parser.Monad
 , Attoparsec.isDigit
@@ -31,9 +31,10 @@ module Documentation.Haddock.Parser.Monad (
 import           Control.Applicative
 import           Control.Monad
 import           Data.String
-import           Data.ByteString (ByteString)
+import           Data.ByteString (ByteString, length)
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
+import qualified Data.Attoparsec.Combinator as Attoparsec
 import           Control.Monad.Trans.State
 import qualified Control.Monad.Trans.Class as Trans
 import           Data.Word
@@ -41,6 +42,7 @@ import           Data.Bits
 import           Data.Tuple
 
 import           Documentation.Haddock.Types (Version)
+import           Documentation.Haddock.Utf8  (encodeUtf8, decodeUtf8)
 
 newtype ParserState = ParserState {
   parserStateSince :: Maybe Version
@@ -73,6 +75,25 @@ char = lift . Attoparsec.char
 char8 :: Char -> Parser Word8
 char8 = lift . Attoparsec.char8
 
+-- | Peek a unicode character and return the number of bytes that it took up
+peekUnicode :: Parser (Char, Int)
+peekUnicode = lift $ Attoparsec.lookAhead $ do
+  
+  -- attoparsec's take fails on shorter inputs rather than truncate
+  bs <- Attoparsec.choice (map Attoparsec.take [4,3,2,1])
+  
+  let !c = head . decodeUtf8 $ bs
+      !n = Data.ByteString.length . encodeUtf8 $ [c]
+  pure (c, fromIntegral n)
+
+-- | Like 'satisfy', but consuming a unicode character
+satisfyUnicode :: (Char -> Bool) -> Parser Char
+satisfyUnicode predicate = do
+  (c,n) <- peekUnicode
+  if predicate c
+    then Documentation.Haddock.Parser.Monad.take n *> pure c
+    else fail "satsifyUnicode"
+
 anyChar :: Parser Char
 anyChar = lift Attoparsec.anyChar
 
diff --git a/html-test/ref/Bug458.html b/html-test/ref/Bug458.html
new file mode 100644
index 00000000..aa99e719
--- /dev/null
+++ b/html-test/ref/Bug458.html
@@ -0,0 +1,80 @@
+Bug458
                      Bar  X =  = X
                      Bar y =  y = Y type (<>) X  XXX  <> XX 
                      type (<>) X  XXX  <> XX =  = X
                       type (<>) *  Y a <> (a :: *) #                      		 
                               
                      Safe HaskellSafe
                      Bug458
                      Synopsis
                      Documentation
                      (⊆) :: () -> () -> () #
                      See the defn of ⊆.
                      
\ No newline at end of file
diff --git a/html-test/src/Bug458.hs b/html-test/src/Bug458.hs
new file mode 100644
index 00000000..6a3ac9a4
--- /dev/null
+++ b/html-test/src/Bug458.hs
@@ -0,0 +1,6 @@
+module Bug458 where
+
+-- | See the defn of @'⊆'@.
+(⊆) :: () -> () -> ()
+_ ⊆ _ = ()
+
-- 
cgit v1.2.3


From 785818fe3e7dbb47b6942b896bbf6120e8f95ddb Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Mon, 5 Feb 2018 23:02:29 -0800
Subject: Remove bang pattern

---
 haddock-library/src/Documentation/Haddock/Parser/Monad.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
index 3430ef8a..ff6101da 100644
--- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
 module Documentation.Haddock.Parser.Monad (
   module Documentation.Haddock.Parser.Monad
 , Attoparsec.isDigit
@@ -82,8 +82,8 @@ peekUnicode = lift $ Attoparsec.lookAhead $ do
   -- attoparsec's take fails on shorter inputs rather than truncate
   bs <- Attoparsec.choice (map Attoparsec.take [4,3,2,1])
   
-  let !c = head . decodeUtf8 $ bs
-      !n = Data.ByteString.length . encodeUtf8 $ [c]
+  let c = head . decodeUtf8 $ bs
+      n = Data.ByteString.length . encodeUtf8 $ [c]
   pure (c, fromIntegral n)
 
 -- | Like 'satisfy', but consuming a unicode character
-- 
cgit v1.2.3


From 1ac2f9569242f6cb074ba6e577285a4c33ae1197 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Fri, 2 Mar 2018 15:47:04 +0100
Subject: fix test

---
 html-test/ref/Bug458.html | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/html-test/ref/Bug458.html b/html-test/ref/Bug458.html
index aa99e719..1a174f94 100644
--- a/html-test/ref/Bug458.html
+++ b/html-test/ref/Bug458.html
@@ -63,11 +63,7 @@
 	  >
                      See the defn of ⊆'⊆'.
                      
Date: Fri, 2 Mar 2018 16:20:19 +0100
Subject: haddock-test: Be more explicit which packages to pass

We now pass `-hide-all-packages` to haddock when invoking the
testsuite. This ensures we don't accidentally pick up any dependencies
up through ghc.env files.
---
 haddock-test/src/Test/Haddock/Config.hs | 13 +++++++++++--
 html-test/ref/QuasiExpr.html            | 10 ++++++++--
 html-test/ref/TH.html                   |  6 +++++-
 html-test/ref/Threaded_TH.html          | 12 ++++++++++--
 4 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 2d16fa63..8b395b6c 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -197,6 +197,7 @@ loadConfig ccfg dcfg flags files = do
         [ pure ["--no-warnings"]
         , pure ["--odir=" ++ dcfgOutDir dcfg]
         , pure ["--optghc=-w"]
+        , pure ["--optghc=-hide-all-packages"]
         , pure $ flagsHaddockOptions flags
         , baseDependencies ghcPath
         ]
@@ -244,13 +245,21 @@ baseDependencies ghcPath = do
 #else
     pkgIndex <- getInstalledPackages normal [GlobalPackageDB] cfg
 #endif
-    mapM (getDependency pkgIndex) ["base", "process", "ghc-prim"]
+    let
+      pkgs =
+        [ "array"
+        , "base"
+        , "ghc-prim"
+        , "process"
+        , "template-haskell"
+        ]
+    concat `fmap` mapM (getDependency pkgIndex) pkgs
   where
     getDependency pkgIndex name = case ifaces pkgIndex name of
         [] -> do
             hPutStrLn stderr $ "Couldn't find base test dependency: " ++ name
             exitFailure
-        (ifArg:_) -> pure ifArg
+        (ifArg:_) -> pure ["--optghc=-package" ++ name, ifArg]
     ifaces pkgIndex name = do
         pkg <- join $ snd <$> lookupPackageName pkgIndex (mkPackageName name)
         iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg
diff --git a/html-test/ref/QuasiExpr.html b/html-test/ref/QuasiExpr.html
index 66e31ec7..062ebb8d 100644
--- a/html-test/ref/QuasiExpr.html
+++ b/html-test/ref/QuasiExpr.html
@@ -301,7 +301,9 @@
 	>
                      expr :: QuasiQuoter  :: QuasiQuoter #
                      parseExprExp :: String -> Q Exp  -> Q Exp #
                      decl :: Q [Dec]  :: Q [Dec] #
                    • forkTH :: Q Exp
                      •  :: Q Exp
                      forkTH :: Q Exp  :: Q Exp #
                      
Date: Fri, 2 Mar 2018 17:50:38 +0100
Subject: Revert "fix test"

This reverts commit 1ac2f9569242f6cb074ba6e577285a4c33ae1197.
---
 html-test/ref/Bug458.html | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/html-test/ref/Bug458.html b/html-test/ref/Bug458.html
index 1a174f94..aa99e719 100644
--- a/html-test/ref/Bug458.html
+++ b/html-test/ref/Bug458.html
@@ -63,7 +63,11 @@
 	  >
                      See the defn of '⊆'⊆.
                      
Date: Fri, 2 Mar 2018 18:16:50 +0100
Subject: Fix Bug548 for real

---
 html-test/ref/Bug458.html | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/html-test/ref/Bug458.html b/html-test/ref/Bug458.html
index aa99e719..f716d7d6 100644
--- a/html-test/ref/Bug458.html
+++ b/html-test/ref/Bug458.html
@@ -64,7 +64,7 @@
 	  >
                      See the defn of ⊆
Date: Mon, 5 Mar 2018 18:10:07 +0100
Subject: Hyperlinker: Links for TyOps, class methods and associated types

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs        | 15 +++++++-
 hypsrc-test/ref/src/Classes.html                   | 40 ++++++++++++++++------
 2 files changed, 44 insertions(+), 11 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 02c4ca0b..3c96db98 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -93,9 +93,12 @@ variables =
 types :: GHC.RenamedSource -> LTokenDetails
 types = everythingInRenamedSource ty
   where
+    ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)]
     ty term = case cast term of
         (Just ((GHC.L sspan (GHC.HsTyVar _ name)) :: GHC.LHsType GHC.GhcRn)) ->
             pure (sspan, RtkType (GHC.unLoc name))
+        (Just ((GHC.L sspan (GHC.HsOpTy l name r)) :: GHC.LHsType GHC.GhcRn)) ->
+            (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r)
         _ -> empty
 
 -- | Obtain details map for identifier bindings.
@@ -141,6 +144,7 @@ decls :: GHC.RenamedSource -> LTokenDetails
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
     , everythingInRenamedSource fun . GHC.hs_valds
+    , everythingInRenamedSource fix . GHC.hs_fixds
     , everythingInRenamedSource (con `Syb.combine` ins)
     ]
   where
@@ -148,7 +152,10 @@ decls (group, _, _, _) = concatMap ($ group)
         GHC.DataDecl { tcdLName = name } -> pure . decl $ name
         GHC.SynDecl name _ _ _ _ -> pure . decl $ name
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
-        GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
+        GHC.ClassDecl{..} ->
+          [decl tcdLName]
+            ++ concatMap sig tcdSigs
+            ++ concatMap tyfam tcdATs
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
@@ -171,8 +178,14 @@ decls (group, _, _, _) = concatMap ($ group)
         Just (field :: GHC.ConDeclField GHC.GhcRn)
           -> map (decl . fmap GHC.selectorFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
+    fix term = case cast term of
+        Just ((GHC.FixitySig names _) :: GHC.FixitySig GHC.GhcRn)
+          -> map decl names
+        Nothing -> empty
+    tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
     sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
     sig (GHC.L _ (GHC.PatSynSig names _)) = map decl names
+    sig (GHC.L _ (GHC.ClassOpSig _ names _)) = map decl names
     sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html
index abff8877..d2604e82 100644
--- a/hypsrc-test/ref/src/Classes.html
+++ b/hypsrc-test/ref/src/Classes.html
@@ -60,8 +60,12 @@
       >    barbar     bazbaz     quuxquux     norfnorf     plughplugh 
Date: Thu, 8 Mar 2018 09:48:16 +0100
Subject: Bump haddock-2.19.0.1, haddock-api-2.19.0.1, haddock-library-1.5.0.1

---
 haddock-api/haddock-api.cabal         | 6 +++---
 haddock-library/haddock-library.cabal | 4 ++--
 haddock.cabal                         | 8 ++++----
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 0acbcb74..ddd538c0 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -1,5 +1,6 @@
+cabal-version:        2.0
 name:                 haddock-api
-version:              2.19.0
+version:              2.19.0.1
 synopsis:             A documentation-generation tool for Haskell libraries
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries
@@ -12,7 +13,6 @@ bug-reports:          https://github.com/haskell/haddock/issues
 copyright:            (c) Simon Marlow, David Waern
 category:             Documentation
 build-type:           Simple
-cabal-version:        >= 2.0
 
 extra-source-files:
   CHANGES.md
@@ -41,7 +41,7 @@ library
 
   -- this package typically supports only single major versions
   build-depends: base            ^>= 4.11.0
-               , Cabal           ^>= 2.0.0
+               , Cabal           ^>= 2.2.0
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
                , haddock-library ^>= 1.5.0
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index d7935747..d09b7f33 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -1,5 +1,6 @@
+cabal-version:        2.0
 name:                 haddock-library
-version:              1.5.0
+version:              1.5.0.1
 synopsis:             Library exposing some functionality of Haddock.
 description:          Haddock is a documentation-generation tool for Haskell
                       libraries. These modules expose some functionality of it
@@ -15,7 +16,6 @@ homepage:             http://www.haskell.org/haddock/
 bug-reports:          https://github.com/haskell/haddock/issues
 category:             Documentation
 build-type:           Simple
-cabal-version:        >= 2.0
 extra-source-files:
   CHANGES.md
 
diff --git a/haddock.cabal b/haddock.cabal
index f6d6fa51..101d4ac2 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -1,5 +1,6 @@
+cabal-version:        2.0
 name:                 haddock
-version:              2.19.0
+version:              2.19.0.1
 synopsis:             A documentation-generation tool for Haskell libraries
 description:
   This is Haddock, a tool for automatically generating documentation
@@ -32,8 +33,7 @@ bug-reports:          https://github.com/haskell/haddock/issues
 copyright:            (c) Simon Marlow, David Waern
 category:             Documentation
 build-type:           Simple
-cabal-version:        >= 2.0
-tested-with:          GHC==8.2.*
+tested-with:          GHC==8.4.*
 
 extra-source-files:
   CHANGES.md
@@ -153,7 +153,7 @@ executable haddock
   else
     -- in order for haddock's advertised version number to have proper meaning,
     -- we pin down to a single haddock-api version.
-    build-depends:  haddock-api == 2.19.0
+    build-depends:  haddock-api == 2.19.0.1
 
     other-modules:
       ResponseFile
-- 
cgit v1.2.3


From 7580675a9ee3f5e05aa7012678633b23f5ca3a39 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Thu, 8 Mar 2018 10:07:38 +0100
Subject: Update changelogs for haddock-2.19.0.1 and haddock-library-1.5.0.1

---
 CHANGES.md                 | 6 ++++++
 haddock-library/CHANGES.md | 4 ++++
 2 files changed, 10 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index ab2ef01a..359d12b1 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,9 @@
+## Changes in version 2.19.0.1
+
+ * Support for linking unicode operators (#458)
+
+ * Hyperlinker: Fix file handle leak in (#763)
+
 ## Changes in version 2.19.0
 
  * Haddock now supports tables in documentation inspired by reSTs grid tables
diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md
index 8b7806bc..1f44f5bf 100644
--- a/haddock-library/CHANGES.md
+++ b/haddock-library/CHANGES.md
@@ -1,3 +1,7 @@
+## Changes in version 1.5.0.1
+
+ * Support for parsing unicode operators (#458)
+
 ## Changes in version 1.5.0
 
  * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc
-- 
cgit v1.2.3


From 85d88f826e2e9c3aaf643b7e29c63db1fccd8c57 Mon Sep 17 00:00:00 2001
From: Herbert Valerio Riedel 
Date: Thu, 8 Mar 2018 10:18:27 +0100
Subject: Update to QC 2.11

---
 haddock-api/haddock-api.cabal         | 2 +-
 haddock-library/haddock-library.cabal | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index ddd538c0..b66304d6 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -172,7 +172,7 @@ test-suite spec
                , haddock-library ^>= 1.5.0
                , xhtml           ^>= 3000.2.2
                , hspec           ^>= 2.4.4
-               , QuickCheck      ^>= 2.10
+               , QuickCheck      ^>= 2.11
 
   -- Versions for the dependencies below are transitively pinned by
   -- the non-reinstallable `ghc` package and hence need no version
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index d09b7f33..4ae1d65e 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -113,7 +113,7 @@ test-suite spec
     , containers   >= 0.4.2.1 && < 0.6
     , transformers   >= 0.3.0   && < 0.6
     , hspec         ^>= 2.4.4
-    , QuickCheck    ^>= 2.10
+    , QuickCheck    ^>= 2.11
 
   -- internal sub-lib
   build-depends: attoparsec
-- 
cgit v1.2.3


From 333aab8827b4a98ed68108751cf930012f79567c Mon Sep 17 00:00:00 2001
From: Herbert Valerio Riedel 
Date: Thu, 8 Mar 2018 10:39:37 +0100
Subject: Restore backward-compat with base-4.5 through base-4.8

---
 .../src/Documentation/Haddock/Parser.hs            | 29 ++++++++++++++++++++--
 haddock-library/src/Documentation/Haddock/Types.hs |  1 +
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 82515ab4..250b7f0d 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -1,5 +1,6 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns      #-}
 -- |
 -- Module      :  Documentation.Haddock.Parser
 -- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,
@@ -35,11 +36,35 @@ import           Documentation.Haddock.Types
 import           Documentation.Haddock.Utf8
 import           Prelude hiding (takeWhile)
 import qualified Prelude as P
-import           Text.Read.Lex (isSymbolChar)
+
+#if MIN_VERSION_base(4,9,0)
+import           Text.Read.Lex                      (isSymbolChar)
+#else
+import           Data.Char                          (GeneralCategory (..),
+                                                     generalCategory)
+#endif
 
 -- $setup
 -- >>> :set -XOverloadedStrings
 
+#if !MIN_VERSION_base(4,9,0)
+-- inlined from base-4.10.0.0
+isSymbolChar :: Char -> Bool
+isSymbolChar c = not (isPuncChar c) && case generalCategory c of
+    MathSymbol           -> True
+    CurrencySymbol       -> True
+    ModifierSymbol       -> True
+    OtherSymbol          -> True
+    DashPunctuation      -> True
+    OtherPunctuation     -> not (c `elem` ("'\"" :: String))
+    ConnectorPunctuation -> c /= '_'
+    _                    -> False
+  where
+    -- | The @special@ character class as defined in the Haskell Report.
+    isPuncChar :: Char -> Bool
+    isPuncChar = (`elem` (",;()[]{}`" :: String))
+#endif
+
 -- | Identifier string surrounded with opening and closing quotes/backticks.
 type Identifier = (Char, String, Char)
 
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 96653864..209f26e8 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -15,6 +15,7 @@
 module Documentation.Haddock.Types where
 
 #if !MIN_VERSION_base(4,8,0)
+import Control.Applicative
 import Data.Foldable
 import Data.Traversable
 #endif
-- 
cgit v1.2.3


From f67f5a208d5755c57493532790f6f7ef84aee9e2 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Thu, 8 Mar 2018 10:57:23 +0100
Subject: Bump lower bound for haddock-library

---
 haddock-api/haddock-api.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index b66304d6..8d9db877 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -44,7 +44,7 @@ library
                , Cabal           ^>= 2.2.0
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
-               , haddock-library ^>= 1.5.0
+               , haddock-library ^>= 1.5.0.1
                , xhtml           ^>= 3000.2.2
 
   -- Versions for the dependencies below are transitively pinned by
-- 
cgit v1.2.3


From 22d5e59a9bb7f5ad5612c9dde53419a48101be65 Mon Sep 17 00:00:00 2001
From: alexbiehl 
Date: Thu, 8 Mar 2018 11:00:13 +0100
Subject: Haddock: Straighten out base bound

---
 haddock.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock.cabal b/haddock.cabal
index 101d4ac2..3f6e76c4 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -65,7 +65,7 @@ executable haddock
 
   -- haddock typically only supports a single GHC major version
   build-depends:
-    base >= 4.3 && < 4.12
+    base ^>= 4.11.0
   if flag(in-ghc-tree)
     hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.13.1.0, haddock-library/src
     cpp-options: -DIN_GHC_TREE
-- 
cgit v1.2.3


From 7b3f6f3a5230dab898a8a824f03636e27b84bfb1 Mon Sep 17 00:00:00 2001
From: Alexander Biehl 
Date: Tue, 13 Mar 2018 08:45:06 +0100
Subject: extractDecl: Extract constructor patterns from data family instances
 (#776)

* extractDecl: Allow extraction of data family instance constructors

* extractDecl: extract data family instance constructors
---
 haddock-api/src/Haddock/Interface/Create.hs | 39 +++++++++++++++++++----------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index cac1e8b0..deef7ad3 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1054,19 +1054,32 @@ extractDecl declMap name decl
                              FamEqn { feqn_tycon = L _ n
                                     , feqn_pats  = tys
                                     , feqn_rhs   = defn }}))) ->
-        SigD <$> extractRecSel name n tys (dd_cons defn)
-      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
-        let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
-                               <- insts
-                             -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
-                           , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
-                           , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
-                           , L _ n <- ns
-                           , selectorFieldOcc n == name
-                      ]
-        in case matches of
-          [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
-          _ -> error "internal: extractDecl (ClsInstD)"
+        if isDataConName name
+        then SigD <$> extractPatternSyn name n tys (dd_cons defn)
+        else SigD <$> extractRecSel name n tys (dd_cons defn)
+      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts })
+        | isDataConName name ->
+            let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body =
+                                          FamEqn { feqn_rhs   = dd
+                                                 }
+                                         })) <- insts
+                               , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))
+                               ]
+            in case matches of
+                [d0] -> extractDecl declMap name (noLoc (InstD (DataFamInstD d0)))
+                _    -> error "internal: extractDecl (ClsInstD)"
+        | otherwise ->
+            let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
+                                   <- insts
+                                 -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
+                               , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
+                               , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
+                               , L _ n <- ns
+                               , selectorFieldOcc n == name
+                          ]
+            in case matches of
+              [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
+              _ -> error "internal: extractDecl (ClsInstD)"
       _ -> error "internal: extractDecl"
 
 
-- 
cgit v1.2.3


From 0541448991cfaa26526283b8cc3d927c6a0c3db5 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 08:26:42 +0100
Subject: Readme: Update GHC version (#778)

---
 README.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/README.md b/README.md
index 3e356ecc..bfc2261b 100644
--- a/README.md
+++ b/README.md
@@ -31,9 +31,9 @@ and then proceed using your favourite build tool.
 #### Using [`cabal new-build`](http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html)
 
 ```bash
-cabal new-build -w ghc-8.2.1
+cabal new-build -w ghc-8.4.1
 # build & run the test suite
-cabal new-test -w ghc-8.2.1
+cabal new-test -w ghc-8.4.1
 ```
 
 #### Using Cabal sandboxes
-- 
cgit v1.2.3


From e19e1a36ee42c3bff3a9dc0b8858537c2ba8725e Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 12:15:33 +0100
Subject: Add fixture test for definition lists

---
 haddock-library/fixtures/examples/definitionList.input  | 1 +
 haddock-library/fixtures/examples/definitionList.parsed | 1 +
 2 files changed, 2 insertions(+)
 create mode 100644 haddock-library/fixtures/examples/definitionList.input
 create mode 100644 haddock-library/fixtures/examples/definitionList.parsed

diff --git a/haddock-library/fixtures/examples/definitionList.input b/haddock-library/fixtures/examples/definitionList.input
new file mode 100644
index 00000000..e1bffb21
--- /dev/null
+++ b/haddock-library/fixtures/examples/definitionList.input
@@ -0,0 +1 @@
+[foo]: bar
diff --git a/haddock-library/fixtures/examples/definitionList.parsed b/haddock-library/fixtures/examples/definitionList.parsed
new file mode 100644
index 00000000..048aa141
--- /dev/null
+++ b/haddock-library/fixtures/examples/definitionList.parsed
@@ -0,0 +1 @@
+DocDefList [_×_ (DocString "foo") (DocString "bar")]
-- 
cgit v1.2.3


From 653a83ac6cd246f9f06409af23b5a5377c6ee479 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 12:18:26 +0100
Subject: Add fixture test for links

---
 haddock-library/fixtures/examples/link.input  | 1 +
 haddock-library/fixtures/examples/link.parsed | 5 +++++
 2 files changed, 6 insertions(+)
 create mode 100644 haddock-library/fixtures/examples/link.input
 create mode 100644 haddock-library/fixtures/examples/link.parsed

diff --git a/haddock-library/fixtures/examples/link.input b/haddock-library/fixtures/examples/link.input
new file mode 100644
index 00000000..a55c05a6
--- /dev/null
+++ b/haddock-library/fixtures/examples/link.input
@@ -0,0 +1 @@
+[link](http://example.com)
diff --git a/haddock-library/fixtures/examples/link.parsed b/haddock-library/fixtures/examples/link.parsed
new file mode 100644
index 00000000..0e85338c
--- /dev/null
+++ b/haddock-library/fixtures/examples/link.parsed
@@ -0,0 +1,5 @@
+DocParagraph
+  (DocHyperlink
+     Hyperlink
+       {hyperlinkLabel = Just "link",
+        hyperlinkUrl = "http://example.com"})
-- 
cgit v1.2.3


From ff97278e6e7e46f44d69036fad2de3c6cfae0ca2 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 12:35:27 +0100
Subject: Add fixture test for inline links

---
 haddock-library/fixtures/examples/linkInline.input  | 1 +
 haddock-library/fixtures/examples/linkInline.parsed | 6 ++++++
 2 files changed, 7 insertions(+)
 create mode 100644 haddock-library/fixtures/examples/linkInline.input
 create mode 100644 haddock-library/fixtures/examples/linkInline.parsed

diff --git a/haddock-library/fixtures/examples/linkInline.input b/haddock-library/fixtures/examples/linkInline.input
new file mode 100644
index 00000000..eeca5a07
--- /dev/null
+++ b/haddock-library/fixtures/examples/linkInline.input
@@ -0,0 +1 @@
+Bla [link](http://example.com)
diff --git a/haddock-library/fixtures/examples/linkInline.parsed b/haddock-library/fixtures/examples/linkInline.parsed
new file mode 100644
index 00000000..43470d7b
--- /dev/null
+++ b/haddock-library/fixtures/examples/linkInline.parsed
@@ -0,0 +1,6 @@
+DocParagraph
+  (DocAppend
+     (DocString "Bla ")
+     (DocHyperlink
+        Hyperlink
+          {hyperlinkLabel = Just "link", hyperlinkUrl = "http://example.com"}))
-- 
cgit v1.2.3


From e7a4bd3fc635f2dc3e9e14b9f334ec991c7d5d23 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 13:01:14 +0100
Subject: fixtures: Slightly unmangle output

---
 haddock-library/fixtures/Fixtures.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs
index f75ff664..54fca012 100644
--- a/haddock-library/fixtures/Fixtures.hs
+++ b/haddock-library/fixtures/Fixtures.hs
@@ -65,7 +65,7 @@ goldenFixture name expect actual cmp wrt = do
     case mres of
         Nothing  -> return (Result 1 1)
         Just str -> do
-            putStr str
+            putStrLn str
             return (Result 0 1)
   where
     handler :: Expr -> IOException -> IO Expr
-- 
cgit v1.2.3


From 896340a1407bf99bd5700ed5d296c668971876f3 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 14:17:23 +0100
Subject: fixtures: Prevent stdout buffering

---
 haddock-library/fixtures/Fixtures.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/haddock-library/fixtures/Fixtures.hs b/haddock-library/fixtures/Fixtures.hs
index 54fca012..282fd10d 100644
--- a/haddock-library/fixtures/Fixtures.hs
+++ b/haddock-library/fixtures/Fixtures.hs
@@ -14,6 +14,7 @@ import Prelude.Compat
 import System.Directory (getDirectoryContents)
 import System.Exit (exitFailure)
 import System.FilePath
+import System.IO
 
 import Data.TreeDiff
 import Data.TreeDiff.Golden
@@ -106,7 +107,9 @@ parseString = Parse.toRegular . _doc . Parse.parseParas
 data Cmd = CmdRun | CmdAccept | CmdList
 
 main :: IO ()
-main = runCmd =<< O.execParser opts
+main = do
+    hSetBuffering stdout NoBuffering -- For interleaved output when debugging
+    runCmd =<< O.execParser opts
   where
     opts = O.info (O.helper <*> cmdParser) O.fullDesc
 
-- 
cgit v1.2.3


From 754ce4715eac6076ff9f829418358127228408e3 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 14:20:04 +0100
Subject: haddock-library.cabal: Clean up GHC options

---
 haddock-library/haddock-library.cabal | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index 4ae1d65e..5e4b42f6 100644
--- a/haddock-library/haddock-library.cabal
+++ b/haddock-library/haddock-library.cabal
@@ -32,7 +32,6 @@ library
   build-depends:        attoparsec
 
   hs-source-dirs:       src
-  ghc-options:          -funbox-strict-fields -Wall -fwarn-tabs -O2
 
   exposed-modules:
     Documentation.Haddock.Doc
@@ -45,7 +44,7 @@ library
   other-modules:
     Documentation.Haddock.Parser.Util
 
-  ghc-options: -Wall
+  ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2
   if impl(ghc >= 8.0)
     ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
 
@@ -76,9 +75,7 @@ library attoparsec
     Data.Attoparsec.Internal.Types
     Data.Attoparsec.Number
 
-  ghc-options:          -funbox-strict-fields -Wall -fwarn-tabs -O2
-
-  ghc-options: -Wall
+  ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2
   if impl(ghc >= 8.0)
     ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances
   else
@@ -132,7 +129,7 @@ test-suite fixtures
   type:             exitcode-stdio-1.0
   default-language: Haskell2010
   main-is:          Fixtures.hs
-  ghc-options:      -Wall
+  ghc-options:      -Wall -O0
   hs-source-dirs:   fixtures
   build-depends:
       base-compat           ^>= 0.9.3
-- 
cgit v1.2.3


From e787b5712157bb0acbb8d886ef793cda5dc1b821 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Wed, 14 Mar 2018 14:21:18 +0100
Subject: Make a proper definition for the  parser

---
 haddock-library/src/Documentation/Haddock/Parser.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 250b7f0d..6cbc3922 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -742,10 +742,12 @@ codeblock =
           | otherwise = Just $ c == '\n'
 
 hyperlink :: Parser (DocH mod a)
-hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8
-              <$> disallowNewline ("<" *> takeUntil ">")
-            <|> autoUrl
-            <|> markdownLink
+hyperlink = angleBracketLink <|> markdownLink <|> autoUrl
+
+angleBracketLink :: Parser (DocH mod a)
+angleBracketLink =
+    DocHyperlink . makeLabeled Hyperlink . decodeUtf8
+    <$> disallowNewline ("<" *> takeUntil ">")
 
 markdownLink :: Parser (DocH mod a)
 markdownLink = DocHyperlink <$> linkParser
-- 
cgit v1.2.3


From b7a74c6702f087fde99f44f12d99c66afcf5790d Mon Sep 17 00:00:00 2001
From: Alec Theriault 
Date: Wed, 21 Mar 2018 01:16:57 -0700
Subject: Show where instances are defined (#748)

* Indicate source module of instances

Above instance, we now also display a link to the module where the
instance was defined. This is sometimes helpful in figuring out
what to import.

* Source module for type/data families too

* Remove parens

* Accept tests
---
 haddock-api/src/Haddock/Backends/LaTeX.hs          |   4 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs     |  18 ++-
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs   |  12 +-
 .../src/Haddock/Interface/AttachInstances.hs       |  18 ++-
 haddock-api/src/Haddock/Interface/Rename.hs        |   4 +-
 haddock-api/src/Haddock/Types.hs                   |   2 +-
 html-test/ref/Bug26.html                           |   6 +-
 html-test/ref/Bug294.html                          |  30 +++-
 html-test/ref/Bug548.html                          |  42 ++++-
 html-test/ref/Bug613.html                          |  18 ++-
 html-test/ref/Bug679.html                          |  12 +-
 html-test/ref/Bug7.html                            |   8 +
 html-test/ref/Hash.html                            |  18 ++-
 html-test/ref/HiddenInstances.html                 |  18 ++-
 html-test/ref/HiddenInstancesB.html                |   8 +
 html-test/ref/Instances.html                       | 156 +++++++++++++++---
 html-test/ref/OrphanInstances.html                 |   4 +-
 html-test/ref/OrphanInstancesClass.html            |   6 +-
 html-test/ref/OrphanInstancesType.html             |   6 +-
 html-test/ref/QuasiExpr.html                       |  12 +-
 html-test/ref/SpuriousSuperclassConstraints.html   |  12 +-
 html-test/ref/Test.html                            |  12 +-
 html-test/ref/TypeFamilies.html                    | 180 ++++++++++++++++++---
 html-test/ref/TypeFamilies2.html                   |  36 ++++-
 24 files changed, 530 insertions(+), 112 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 1043453d..38fccf0c 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -530,14 +530,14 @@ ppDocInstances unicode (i : rest)
     (is, rest') = spanWith isUndocdInstance rest
 
 isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
-isUndocdInstance (i,Nothing,_) = Just i
+isUndocdInstance (i,Nothing,_,_) = Just i
 isUndocdInstance _ = Nothing
 
 -- | Print a possibly commented instance. The instance header is printed inside
 -- an 'argBox'. The comment is printed to the right of the box in normal comment
 -- style.
 ppDocInstance :: Bool -> DocInstance DocNameI -> LaTeX
-ppDocInstance unicode (instHead, doc, _) =
+ppDocInstance unicode (instHead, doc, _, _) =
   declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6e733373..d92bdd3a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -566,8 +566,8 @@ ppInstances links origin instances splice unicode qual
   where
     instName = getOccString origin
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc origin False no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc origin False no inst mdl), loc)
 
 
 ppOrphanInstances :: LinksInfo
@@ -581,8 +581,8 @@ ppOrphanInstances links instances splice unicode qual
     instOrigin inst = OriginClass (ihdClsName inst)
 
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst mdl), loc)
 
 
 ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
@@ -591,13 +591,14 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
            -> Bool -- ^ Is instance orphan
            -> Int  -- ^ Normal
            -> InstHead DocNameI
+           -> Maybe Module
            -> SubDecl
-ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
+ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) mdl =
     case ihdInstType of
         ClassInst { .. } ->
             ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ
             , mdoc
-            , [subInstDetails iid ats sigs]
+            , [subInstDetails iid ats sigs mname]
             )
           where
             sigs = ppInstanceSigs links splice unicode qual clsiSigs
@@ -605,7 +606,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         TypeInst rhs ->
             ( subInstHead iid ptype
             , mdoc
-            , [subFamInstDetails iid prhs]
+            , [subFamInstDetails iid prhs mname]
             )
           where
             ptype = keyword "type" <+> typ
@@ -614,11 +615,12 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         DataInst dd ->
             ( subInstHead iid pdata
             , mdoc
-            , [subFamInstDetails iid pdecl])
+            , [subFamInstDetails iid pdecl mname])
           where
             pdata = keyword "data" <+> typ
             pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
   where
+    mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl
     iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdTypes unicode qual
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index e020b909..217ca2af 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -47,7 +47,7 @@ import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
 import Haddock.Utils (makeAnchorId, nameAnchorId)
 import qualified Data.Map as Map
-import Text.XHtml hiding ( name, title, p, quote )
+import Text.XHtml hiding ( name, title, quote )
 
 import FastString            ( unpackFS )
 import GHC
@@ -228,15 +228,17 @@ subInstHead iid hdr =
 subInstDetails :: String -- ^ Instance unique id (for anchor generation)
                -> [Html] -- ^ Associated type contents
                -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html   -- ^ Source module
                -> Html
-subInstDetails iid ats mets =
-    subInstSection iid << (subAssociatedTypes ats <+> subMethods mets)
+subInstDetails iid ats mets mdl =
+    subInstSection iid << (p mdl <+> subAssociatedTypes ats <+> subMethods mets)
 
 subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
                   -> Html   -- ^ Type or data family instance
+                  -> Html   -- ^ Source module TODO: use this
                   -> Html
-subFamInstDetails iid fi =
-    subInstSection iid << thediv ! [theclass "src"] << fi
+subFamInstDetails iid fi mdl =
+    subInstSection iid << (p mdl <+> (thediv ! [theclass "src"] << fi))
 
 subInstSection :: String -- ^ Instance unique id (for anchor generation)
                -> Html
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index ec8b98c8..d0ed1698 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -69,7 +69,7 @@ attachInstances expInfo ifaces instIfaceMap = do
 
 attachOrphanInstances :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> [ClsInst] -> [DocInstance GhcRn]
 attachOrphanInstances expInfo iface ifaceMap instIfaceMap cls_instances =
-  [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, (L (getSrcSpan n) n))
+  [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, (L (getSrcSpan n) n), Nothing)
   | let is = [ (instanceSig i, getName i) | i <- cls_instances, isOrphan (is_orphan i) ]
   , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
   , not $ isInstanceHidden expInfo cls tys
@@ -91,7 +91,11 @@ attachToExportItem index expInfo iface ifaceMap instIfaceMap export =
         let mb_instances  = lookupNameEnv index (tcdName d)
             cls_instances = maybeToList mb_instances >>= fst
             fam_instances = maybeToList mb_instances >>= snd
-            fam_insts = [ (synifyFamInst i opaque, doc,spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d)) )
+            fam_insts = [ ( synifyFamInst i opaque
+                          , doc
+                          , spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d))
+                          , nameModule_maybe n
+                          )
                         | i <- sortBy (comparing instFam) fam_instances
                         , let n = getName i
                         , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap
@@ -99,14 +103,18 @@ attachToExportItem index expInfo iface ifaceMap instIfaceMap export =
                         , not $ any (isTypeHidden expInfo) (fi_tys i)
                         , let opaque = isTypeHidden expInfo (fi_rhs i)
                         ]
-            cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, spanName n (synifyInstHead i) (L eSpan (tcdName d)))
+            cls_insts = [ ( synifyInstHead i
+                          , instLookup instDocMap n iface ifaceMap instIfaceMap
+                          , spanName n (synifyInstHead i) (L eSpan (tcdName d))
+                          , nameModule_maybe n
+                          )
                         | let is = [ (instanceSig i, getName i) | i <- cls_instances ]
                         , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
                         , not $ isInstanceHidden expInfo cls tys
                         ]
               -- fam_insts but with failing type fams filtered out
-            cleanFamInsts = [ (fi, n, L l r) | (Right fi, n, L l (Right r)) <- fam_insts ]
-            famInstErrs = [ errm | (Left errm, _, _) <- fam_insts ]
+            cleanFamInsts = [ (fi, n, L l r, m) | (Right fi, n, L l (Right r), m) <- fam_insts ]
+            famInstErrs = [ errm | (Left errm, _, _, _) <- fam_insts ]
         in do
           dfs <- getDynFlags
           let mkBug = (text "haddock-bug:" <+>) . text
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index df25e6a7..b2d0e1e1 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -627,11 +627,11 @@ renameWc rn_thing (HsWC { hswc_body = thing })
                       , hswc_wcs = PlaceHolder }) }
 
 renameDocInstance :: DocInstance GhcRn -> RnM (DocInstance DocNameI)
-renameDocInstance (inst, idoc, L l n) = do
+renameDocInstance (inst, idoc, L l n, m) = do
   inst' <- renameInstHead inst
   n' <- rename n
   idoc' <- mapM renameDoc idoc
-  return (inst', idoc',L l n')
+  return (inst', idoc', L l n', m)
 
 renameExportItem :: ExportItem GhcRn -> RnM (ExportItem DocNameI)
 renameExportItem item = case item of
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 725606b2..2810862f 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -388,7 +388,7 @@ mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
 
 
 -- | An instance head that may have documentation and a source location.
-type DocInstance name = (InstHead name, Maybe (MDoc (IdP name)), Located (IdP name))
+type DocInstance name = (InstHead name, Maybe (MDoc (IdP name)), Located (IdP name), Maybe Module)
 
 -- | The head of an instance. Consists of a class name, a list of type
 -- parameters (which may be annotated with kinds), and an instance type
diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html
index 820fde3f..e50169ba 100644
--- a/html-test/ref/Bug26.html
+++ b/html-test/ref/Bug26.html
@@ -180,7 +180,11 @@
 		  >
                      Instance details
                      Defined in Bug26
                       
                      Methods
                      Instance details
                      Defined in Bug294
                       
                      data 
                      Instance details
                      Defined in Bug294
                       
                      data 
                      Instance details
                      Defined in Bug294
                       
                      data 
                      Instance details
                      Defined in Bug294
                       
                      data 
                      Instance details
                      Defined in Bug294
                       
                      data 
                      Instance details
                      Defined in Control.Applicative
                       
                      Associated Types
                      Instance details
                      Defined in Control.Applicative
                       
                      Methods
                      Instance details
                      Defined in Control.Applicative
                       
                      Methods
                      Instance details
                      Defined in Control.Applicative
                       
                      Methods
                      Instance details
                      Defined in Control.Applicative
                       
                      Associated Types
                      Instance details
                      Defined in Control.Applicative
                       
                      type 
                      Instance details
                      Defined in Control.Applicative
                       
                      type 
                      Instance details
                      Defined in Bug613
                       
                      Methods
                      Instance details
                      Defined in Bug613
                       
                      Methods
                      Instance details
                      Defined in Bug613
                       
                      Methods
                      Instance details
                      Defined in Bug679
                       
                      Methods
                      Instance details
                      Defined in Bug679
                       
                      Methods
                      Instance details
                      Defined in Bug7
                      Since: 2.1Since: base-2.1
                      Since: 2.1Since: base-2.1
                      Since: 2.1Since: base-2.1
                       
                      Since: base-2.1
                      WrappedArrow a b a0 -> WrappedArrow a b b0 #
                       a b b0
                      (<$)WrappedArrow a b b0 -> WrappedArrow a b a0 #
                       a b a0
                      Since: base-2.1
                      pure :: a0 -> WrappedArrow a b a0 #
                       a b a0
                      (<*>)WrappedArrow a b a0 -> WrappedArrow a b b0 #
                       a b b0
                      liftA2WrappedArrow a b b0 -> WrappedArrow a b c #
                       a b c
                      (*>)WrappedArrow a b b0 -> WrappedArrow a b b0 #
                       a b b0
                      (<*)WrappedArrow a b b0 -> WrappedArrow a b a0 #
                       a b a0
                      Since: base-2.1
                      empty :: WrappedArrow a b a0 #
                       a b a0
                      (<|>)WrappedArrow a b a0 -> WrappedArrow a b a0 #
                       a b a0
                      someWrappedArrow a b a0 -> WrappedArrow a b [a0] #
                       a b [a0]
                      manyWrappedArrow a b a0 -> WrappedArrow a b [a0] #
                       a b [a0]
                      		    
                          
                      A Int
                      B Int
                       
                      D Int Int
                      E Int
                        
                      A a (a -> Int)
                        
                      SomeNewTypeConst String
                      		SomeOtherNewTypeConst String
                    • foo :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                    • fooName :: String
                      •  :: String
                    • fooValue :: Int
                      •  :: Int}fooName :: String :: String
                      some name
                      fooValue :: Int :: Int
                      data family SomeTypeFamily k :: * -> * k :: * -> *
                    • data family SomeOtherTypeFamily k :: * -> *
                      •  k :: * -> *
                      data family SomeTypeFamily k :: * -> *  k :: * -> * #
                      data family SomeOtherTypeFamily k :: * -> *  k :: * -> * #
                      type TypeSyn = String = String
                    • type OtherTypeSyn = String
                      •  = String
                      type TypeSyn = String  = String #
                      type OtherTypeSyn = String  = String #
                    • fib :: Integer -> Integer
                      •  :: Integer -> Integer
                      fib :: Integer -> Integer  :: Integer -> Integer #
                      Fibonacci number of given IntegerInteger.
                      Examples:
                      :: Ord a=> Int-> Bool (b :: ()). d ~ ()
                    • C2 :: Ord a => [a] ->  :: Ord a => [a] -> H1 a a
                    • C3 :: {..} -> H1 Int Int
                      •  Int Int
                    • C4 :: {..} -> H1 Int a
                      •  Int a
                    • new :: (Eq key,  :: (Eq key, Hash key) => Int -> IO ( key) => Int -> IO (HashTable key val)
                    • insert :: (Eq key,  :: (Eq key, Hash key) => key -> val -> IO ()
                      •  key) => key -> val -> IO ()
                    • lookup :: Hash key => key -> IO (Maybe val)
                      •  key => key -> IO (Maybe val)
                    • class
                    • hash :: a -> Int
                      •  :: a -> Intkey should be an instance of EqEq.
                      new :: (Eq key,  :: (Eq key, Hash key) => Int -> IO ( key) => Int -> IO (HashTable key val) #
                      insert :: (Eq key,  :: (Eq key, Hash key) => key -> val -> IO ()  key) => key -> val -> IO () #
                      lookup :: Hash key => key -> IO (Maybe val)  key => key -> IO (Maybe val) #
                      Looks up a key in the hash table, returns JustJust val if the key
  was found, or NothingNothing otherwise.
                      hash :: a -> Int  :: a -> Int #
                      hashes the value of type a into an IntInt
                      HashFloat Float#
                      hash :: Float -> Int  :: Float -> Int #
                      HashInt Int#
                      hash :: Int -> Int  :: Int -> Int #
                      hash :: (a, b) -> Int  :: (a, b) -> Int #
                      VisibleClassInt Int# Num  Num VisibleDataVisibleData -> VisibleData#
                      VisibleData -> VisibleData #
                      VisibleData -> VisibleData #
                      VisibleData -> VisibleData #
                      VisibleData -> VisibleData #
                      VisibleData -> VisibleData #
                      fromInteger :: Integer ->  :: Integer -> VisibleData #
                    • foo :: Int
                      •  :: Int
                      foo :: Int  :: Int #
                      foo :: (a <~~ Int) -> a0 -> a  Int) -> a0 -> a <~~ a0 #<~~ (a <~~ a0)) -> Int -> a  a0)) -> Int -> a <~~ (a <~~ Int)  Int) #
                      foo :: f Int -> a -> f a  :: f Int -> a -> f a #
                      foo' :: f (f a) -> Int -> f (f Int)  :: f (f a) -> Int -> f (f Int) #
                      foo :: [Int] -> a -> [a]  :: [Int] -> a -> [a] #
                      foo' :: [[a]] -> Int -> [[Int]]  :: [[a]] -> Int -> [[Int]] #
                      FooMaybe Maybe#
                      foo :: Maybe Int -> a -> Maybe a  :: Maybe Int -> a -> Maybe a #
                      foo' :: Maybe (Maybe a) -> Int -> Maybe (Maybe Int)  :: Maybe (Maybe a) -> Int -> Maybe (Maybe Int) #
                      Foo (Either a) (Either a)#
                      foo :: Either a Int -> a0 -> Either a a0  :: Either a Int -> a0 -> Either a a0 #
                      foo' :: Either a (Either a a0) -> Int -> Either a (Either a Int)  :: Either a (Either a a0) -> Int -> Either a (Either a Int) #
                       (Eq a,  (Eq a, Foo f) => Foo ((,) (f a)) ((,) (f a))#
                      foo :: (f a, Int) -> a0 -> (f a, a0)  :: (f a, Int) -> a0 -> (f a, a0) #
                      foo' :: (f a, (f a, a0)) -> Int -> (f a, (f a, Int))  :: (f a, (f a, a0)) -> Int -> (f a, (f a, Int)) #
                      foo :: (a <~~Int) -> a0 -> a  Int) -> a0 -> a <~~ a0 #<~~ (a <~~ a0)) -> Int -> a  a0)) -> Int -> a <~~ (a <~~Int)  Int) #
                      Foo ((,,) a a) ((,,) a a)#
                      foo :: (a, a, Int) -> a0 -> (a, a, a0)  :: (a, a, Int) -> a0 -> (a, a, a0) #
                      foo' :: (a, a, (a, a, a0)) -> Int -> (a, a, (a, a, Int))  :: (a, a, (a, a, a0)) -> Int -> (a, a, (a, a, Int)) #
                      foo :: Quux a b Int -> a0 ->  a b Int -> a0 -> Quux a b a0 #Quux a b (Quux a b a0) -> Int ->  a b a0) -> Int -> Quux a b (Quux a b Int)  a b Int) #
                      Foo ((->) a :: * -> *) ((->) a :: * -> *)#
                      foo :: (a -> Int) -> a0 -> a -> a0  :: (a -> Int) -> a0 -> a -> a0 #
                      foo' :: (a -> a -> a0) -> Int -> a -> a -> Int  :: (a -> (a -> a0)) -> Int -> a -> (a -> Int) #
                      bar :: f a -> f Bool -> a  :: f a -> f Bool -> a #
                       Bar Maybe Bool Maybe Bool #
                      bar :: Maybe Bool -> Maybe Bool -> Bool  :: Maybe Bool -> Maybe Bool -> Bool #
                      bar' :: Maybe (Maybe Bool) -> Maybe (Maybe (Maybe b))  :: Maybe (Maybe Bool) -> Maybe (Maybe (Maybe b)) #
                      bar0 :: (Maybe Bool, Maybe Bool) -> (Maybe b, Maybe c)  :: (Maybe Bool, Maybe Bool) -> (Maybe b, Maybe c) #
                      bar1 :: (Maybe Bool, Maybe Bool) -> (Maybe b, Maybe c)  :: (Maybe Bool, Maybe Bool) -> (Maybe b, Maybe c) #
                      BarMaybe [a] Maybe [a]#
                      bar :: Maybe [a] -> Maybe Bool -> [a]  :: Maybe [a] -> Maybe Bool -> [a] #
                      bar' :: Maybe (Maybe [a]) -> Maybe (Maybe (Maybe b))  :: Maybe (Maybe [a]) -> Maybe (Maybe (Maybe b)) #
                      bar0 :: (Maybe [a], Maybe [a]) -> (Maybe b, Maybe c)  :: (Maybe [a], Maybe [a]) -> (Maybe b, Maybe c) #
                      bar1 :: (Maybe [a], Maybe [a]) -> (Maybe b, Maybe c)  :: (Maybe [a], Maybe [a]) -> (Maybe b, Maybe c) #
                      bar :: [(a, a)] -> [Bool] -> (a, a)  :: [(a, a)] -> [Bool] -> (a, a) #
                      Foo f => Bar (Either a) (f a) (Either a) (f a) #
                      bar :: Either a (f a) -> Either a Bool -> f a  :: Either a (f a) -> Either a Bool -> f a #
                      bar' :: Either a (Either a (f a)) -> Either a (Either a (Either a b))  :: Either a (Either a (f a)) -> Either a (Either a (Either a b)) #
                      bar0 :: (Either a (f a), Either a (f a)) -> (Either a b, Either a c)  :: (Either a (f a), Either a (f a)) -> (Either a b, Either a c) #
                      bar1 :: (Either a (f a), Either a (f a)) -> (Either a b, Either a c)  :: (Either a (f a), Either a (f a)) -> (Either a b, Either a c) #
                      Foo ((,,) a b) =>  ((,,) a b) => Bar ((,,) a b) (a, b, a) ((,,) a b) (a, b, a)#
                      bar :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a)  :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a) #
                      Quux a b c) -> Quux a c Bool ->  a c Bool -> Quux a b c #foo :: Quux a b Int -> a0 ->  a b Int -> a0 -> Quux a b a0 #Quux a b (Quux a b a0) -> Int ->  a b a0) -> Int -> Quux a b (Quux a b Int)  a b Int) #
                      Quux a b c) -> Quux a c Bool ->  a c Bool -> Quux a b c #dataThudInt ( Int (Quux a [a] c)data ThudInt ( Int (Quux a [a] c) NorfIntBool Int Bool#typePlughInt c Bool :: * Int c Bool :: * #
                      data Thud Int c :: *  Int c :: * #
                      norf :: PlughInt c Bool -> Int -> (Int -> c) -> Bool Int c Bool -> Int -> (Int -> c) -> Bool #
                      typePlugh [a] c [b] :: * [a] c [b] :: * #
                      data Thud [a] c :: *  [a] c :: * #
                    • f :: Integer
                      •  :: Integer
                      f :: Integer  :: Integer #
                      foo :: Int  :: Int #
                    • g :: Int
                      •  :: Int
                      g :: Int  :: Int #
                      type a <>< b :: * b :: *
                    • datatype a <>< b :: *  b :: * infixl 2aClass :: AType -> Int  -> Int #
                      • aClass :: a -> Int  :: a -> Int #
                      aClass :: AType -> Int -> Int #
                       IntaClass :: AType -> Int -> Int #
                      dataBlubType = Show x =>  = Show x => BlubCtor x
                    • Blub :: () => forall x. Show x => x ->  x. Show x => x -> BlubType
                    • data (a :: *)  (a :: *) >< b = Emptypattern PatWithExplicitSig :: Eq somex => somex ->  :: Eq somex => somex -> FooType somex
                      • :: Ord a
                      => Int
                      First argument
                      -> Bool
                      Third argument
                      		:: forall (b :: ()). d ~ ()
                      C2 :: Ord a => [a] ->  :: Ord a => [a] -> H1 a aC3 :: {..} -> H1 Int IntC4 :: {..} -> H1 Int a
                                                                  
                      AType Int
                        
                       Integer String String Show  Show Expr
                      showsPrec :: Int ->  :: Int -> Expr -> ShowS #
                       -> ShowS
                      show :: Expr -> String #
                       -> String
                      showList :: [Expr] -> ShowS #
                      ] -> ShowS
                       Show  Show BinOp
                      showsPrec :: Int ->  :: Int -> BinOp -> ShowS #
                       -> ShowS
                      show :: BinOp -> String #
                       -> String
                      showList :: [BinOp] -> ShowS #
                      ] -> ShowS
                      eval :: Expr -> Integer -> Integer #
                      expr :: QuasiQuoter  :: QuasiQuoter #
                      parseExprExp :: String -> Q Exp  :: String -> Q Exp #
                      val :: Integer  :: Integer #
                      dataSomeType (f :: * -> *) a  (f :: * -> *) a #
                       Functor ( Functor (SomeType f) SomeType f a -> SomeType f b #
                       f b
                      (<$)SomeType f b -> SomeType f a #
                       f a
                       Applicative f => Applicative ( Applicative f => Applicative (SomeType f)pure :: a -> SomeType f a #
                       f a
                      (<*>)SomeType f a -> SomeType f b #
                       f b
                      liftA2SomeType f b -> SomeType f c #
                       f c
                      (*>)SomeType f b -> SomeType f b #
                       f b
                      (<*)SomeType f b -> SomeType f a #
                       f a
                      decl :: Q [Dec]  :: Q [Dec] #
                    • = A Int (Maybe Float)
                      •  Int (Maybe Float)
                    • | BT a b, T Int Float)
                      •  Int Float)
                    • p :: Int
                      •  :: Int
                    • qr, s :: Int
                      •  :: Int }
                    • t :: T1 -> T2 Int Int ->  Int Int -> T3 Bool Bool ->  Bool Bool -> T4 Float Float ->  Float Float -> T5 () ()
                    • u, v :: Int
                      •  :: Int }
                    • s1 :: Int
                      •  :: Int
                    • s2 :: Int
                      •  :: Int
                    • s3 :: Int
                      •  :: Int}
                    • p :: R -> Int
                      •  -> Int
                    • qu :: R -> Int
                      •  -> Int
                    • class
                    • a :: IO a
                      •  :: IO a
                    • ba :: C a => IO a
                      •  a => IO a
                    • f :: C a => a -> Int
                      •  a => a -> Int
                    • g :: Int -> IO CInt
                      •  :: Int -> IO CInt
                    • hidden :: Int -> Int
                      •  :: Int -> Int
                    • module VisibleT () () -> T2 Int Int -> ( Int Int -> (T3 Bool Bool ->  Bool Bool -> T4 Float Float) ->  Float Float) -> T5 () () -> IO ()
                      •  () () -> IO ()
                    • l :: (Int, Int, Float) -> Int
                      •  :: (Int, Int, Float) -> Int
                    • mR -> N1 () -> IO Int
                      •  () -> IO Int
                    • o :: Float -> IO Float
                      •  :: Float -> IO Float
                    • f' :: Int
                      •  :: Int
                    • withType :: Int
                      •  :: Int
                    • withoutType
                      •  Int (Maybe Float) Int Float)d :: TFloat b  Float b #
                      e :: (Float, Float)  :: (Float, Float) #
                      DInt Int#d :: TInt b  Int b #
                      e :: (Int, Int)  :: (Int, Int) #
                      a :: C a => IO a  a => IO a #
                      f :: C a => a -> Int  a => a -> Int #
                      g :: Int -> IO CInt  :: Int -> IO CInt #
                      hidden :: Int -> Int  :: Int -> Int #
                       Int Int Float Float)-> IO ()
                      Show x => Show x => BlubCtor xBlub :: () => forall x. Show x => x ->  x. Show x => x -> BlubType #
                      data (a :: *)  (a :: *) >< b #pattern PatWithExplicitSig :: Eq somex => somex ->  :: Eq somex => somex -> FooType somex #data Pattern :: [*] -> *  :: [*] -> * where #
                      		Cons :: Maybe h ->  :: Maybe h -> Pattern t -> PatternRevPattern :: RevList * -> *  * -> * where #RevCons :: Maybe h ->  :: Maybe h -> RevPattern t -> RevPatterndata Tuple :: (*, *) -> *  :: (*, *) -> * where #
                    • fib :: Integer -> Integer
                      •  :: Integer -> Integer
                      fib :: Integer -> Integer  :: Integer -> Integer #
                      Fibonacci number of given IntegerInteger.
                      fib n <= fib (n + 1)
                      		IntExpr Integer
                      AntiIntExpr String
                      AntiExpr String
                           
                      A Int (Maybe Float)
                      This comment describes the T a b, T Int Float)
                      This comment describes the p :: Int :: Int
                      This comment applies to the r, s :: Int :: Int
                      This comment applies to both t :: T1 -> T2 Int Int ->  Int Int -> T3 Bool Bool ->  Bool Bool -> T4 Float Float ->  Float Float -> T5 () ()
                      u, v :: Int :: Int
                      s1 :: Int :: Int
                      The s2 :: Int :: Int
                      The s3 :: Int :: Int
                      The p :: R -> Int  -> Int #
                      u :: R -> Int  -> Int #
                      a :: IO a  :: IO a #
                       D Float Float #
                      		     -> T2 Int Int
                      This argument has type 'T2 Int Int'
                      		-> (T3 Bool Bool ->  Bool Bool -> T4 Float Float)
                      This argument has type 
                      -> IO ()
                      This is the result type
                      :: (Int, Int, Float)-> Int-> IO Int
                      :: (Int, Int, Float)
                      takes a triple
                      -> Int
                      returns an IntInt
                      -> IO Int
                      and the return value
                      :: Float-> IO FloatX<> (a :: *) (a :: *)#X<> (a :: *) =  (a :: *) = XAssocDY :: * :: * #
                      AssocT Y :: *  :: * #
                      Y<> (a :: *) (a :: *)#Y<> (a :: *) = a (a :: *) = a
                    • BatZ1 ::  :: forall (z :: Z). Z -> Bat ZA
                    • BatZ2 ::  :: forall (z :: Z). {..} -> Bat ZBdata family Bat (a :: k) :: *  (a :: k) :: * #
                    • BatZ1 ::  :: forall (z :: Z). Z -> Bat ZA
                    • BatZ2 ::  :: forall (z :: Z). {..} -> Bat ZBdata AssocD a :: *  a :: * #
                      type AssocT a :: *  a :: * #
                      AssocD Y :: *  :: * #
                      AssocT Y :: *  :: * #
                      AssocD X :: *  :: * #
                      AssocT X :: *  :: * #
                      Y <> (a :: *) (a :: *) #Y <> (a :: *) = a (a :: *) = aX <> (a :: *) (a :: *) #X <> (a :: *) =  (a :: *) = X
                    • x :: Int
                      •  :: Int
                      x :: Int  :: Int #
                      visible :: Int -> Int  :: Int -> Int #
                      
Date: Wed, 13 Jun 2018 23:54:37 +0200
Subject: Bump bounds on Cabal

---
 haddock-api/haddock-api.cabal | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index ea294fdc..3e972877 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -41,7 +41,7 @@ library
 
   -- this package typically supports only single major versions
   build-depends: base            ^>= 4.12.0
-               , Cabal           ^>= 2.2.0
+               , Cabal           ^>= 2.3.0
                , ghc             ^>= 8.5
                , ghc-paths       ^>= 0.1.0.9
                , haddock-library ^>= 1.6.0
@@ -166,7 +166,7 @@ test-suite spec
     Haddock.Backends.Hyperlinker.Parser
     Haddock.Backends.Hyperlinker.Types
 
-  build-depends: Cabal           ^>= 2.2
+  build-depends: Cabal           ^>= 2.3
                , ghc             ^>= 8.4
                , ghc-paths       ^>= 0.1.0.9
                , haddock-library ^>= 1.6.0
-- 
cgit v1.2.3


From 9816929b2e1e34cb33637329f7f1af37e1035f07 Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Thu, 14 Jun 2018 02:33:27 +0200
Subject: Bump ghc bound for haddock-api spec test-suite

---
 haddock-api/haddock-api.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 3e972877..6a7a932b 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -167,7 +167,7 @@ test-suite spec
     Haddock.Backends.Hyperlinker.Types
 
   build-depends: Cabal           ^>= 2.3
-               , ghc             ^>= 8.4
+               , ghc             ^>= 8.5
                , ghc-paths       ^>= 0.1.0.9
                , haddock-library ^>= 1.6.0
                , xhtml           ^>= 3000.2.2
-- 
cgit v1.2.3


From 095fa970b32c818ed4c06cefc00ba98aaff756fa Mon Sep 17 00:00:00 2001
From: Simon Jakobi 
Date: Thu, 14 Jun 2018 12:37:48 +0200
Subject: Travis: `--allow-newer` for all packages

---
 .travis.yml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 39135739..5f9b731d 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -51,8 +51,8 @@ install:
  - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
  - rm -fv cabal.project.local
  - rm -f cabal.project.freeze
- - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all
- - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 --allow-newer=base,Cabal --constraint 'setup.Cabal installed' all
+ - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 --allow-newer --constraint 'setup.Cabal installed' all
+ - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 --allow-newer --constraint 'setup.Cabal installed' all
 
 # Here starts the actual work to be performed for the package under test;
 # any command which exits with a non-zero exit code causes the build to fail.
@@ -69,12 +69,12 @@ script:
  - rm -fv cabal.project.local
  # this builds all libraries and executables (without tests/benchmarks)
  - rm -f cabal.project.freeze
- - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --allow-newer=base,Cabal --constraint 'setup.Cabal installed'  all
+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --allow-newer --constraint 'setup.Cabal installed'  all
  # this builds all libraries and executables (including tests/benchmarks)
  # - rm -rf ./dist-newstyle
 
  # build & run tests
- - cabal new-build -w ${HC} ${TEST} ${BENCH} --allow-newer=base,Cabal --constraint 'setup.Cabal installed'   all
- - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} --allow-newer=base,Cabal --constraint 'setup.Cabal installed'  all; fi 
+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --allow-newer --constraint 'setup.Cabal installed'   all
+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} --allow-newer --constraint 'setup.Cabal installed'  all; fi 
 
 # EOF
-- 
cgit v1.2.3


                      :: Float
                      The input float
                      -> IO Float
                      The output float
                      f' :: Int  :: Int #
                      withType :: Int  :: Int #
                    • f :: Integer
                      •  :: Integer
                      f :: Integer  :: Integer #
                    • forkTH :: Q Exp
                      •  :: Q Exp
                      forkTH :: Q Exp  :: Q Exp #
                      ...given a raw Addr#Addr# to the string, and the length of the string.
                    • f :: Int
                      •  :: Int
                      f :: Int  :: Int #
                    • foo :: Integer
                      •  :: Integer
                    • bar :: Integer
                      •  :: Integer
                      foo :: Integer  :: Integer #
                      bar :: Integer  :: Integer #
                      data family Bat (a :: k) :: * (a :: k) :: *
                    • classdata AssocD a :: *
                      •  a :: *
                    • type AssocT a :: *
                      •  a :: *
                    • AssocD X :: *  :: * #
                      AssocT X :: *  :: * #
                      • Foo X :: *)
                       :: *)