Commit ff1f6c83 authored by Alec Theriault's avatar Alec Theriault Committed by Mikhail Glushenkov
Browse files

Add a 'quickjump' option, implied by 'for-hackage'

This options only works for Haddock >=2.19.
parent 44235509
......@@ -90,6 +90,8 @@ data HaddockArgs = HaddockArgs {
-- ^ (Template for modules, template for symbols, template for lines).
argLinkedSource :: Flag Bool,
-- ^ Generate hyperlinked sources
argQuickJump :: Flag Bool,
-- ^ Generate quickjump index
argCssFile :: Flag FilePath,
-- ^ Optional custom CSS file.
argContents :: Flag String,
......@@ -156,6 +158,7 @@ haddock pkg_descr lbi suffixes flags' = do
, haddockHtmlLocation = Flag (pkg_url ++ "/docs")
, haddockContents = Flag (toPathTemplate pkg_url)
, haddockLinkedSource = Flag True
, haddockQuickJump = Flag True
}
pkg_url = "/package/$pkg-$version"
flag f = fromFlag $ f flags
......@@ -176,6 +179,10 @@ haddock pkg_descr lbi suffixes flags' = do
&& version < mkVersion [2,2]) $
die' verbosity "haddock 2.0 and 2.1 do not support the --hoogle flag."
when ( flag haddockQuickJump
&& version < mkVersion [2,19]) $
die' verbosity "haddock prior to 2.19 does not support the --quickjump flag."
haddockGhcVersionStr <- getProgramOutput verbosity haddockProg
["--ghc-version"]
case (simpleParse haddockGhcVersionStr, compilerCompatVersion GHC comp) of
......@@ -276,6 +283,7 @@ fromFlags env flags =
,"src/%{MODULE/./-}.html#line-%{LINE}")
else NoFlag,
argLinkedSource = haddockLinkedSource flags,
argQuickJump = haddockQuickJump flags,
argCssFile = haddockCss flags,
argContents = fmap (fromPathTemplate . substPathTemplate env)
(haddockContents flags),
......@@ -547,6 +555,9 @@ renderPureArgs version comp platform args = concat
, [ "--since-qual=external" | version >= mkVersion [2, 19, 1] ]
, [ "--quickjump" | isVersion 2 19
, fromFlag . argQuickJump $ args ]
, [ "--hyperlinked-source" | isVersion 2 17
, fromFlag . argLinkedSource $ args ]
......
......@@ -1377,6 +1377,7 @@ data HaddockFlags = HaddockFlags {
haddockInternal :: Flag Bool,
haddockCss :: Flag FilePath,
haddockLinkedSource :: Flag Bool,
haddockQuickJump :: Flag Bool,
haddockHscolourCss :: Flag FilePath,
haddockContents :: Flag PathTemplate,
haddockDistPref :: Flag FilePath,
......@@ -1402,6 +1403,7 @@ defaultHaddockFlags = HaddockFlags {
haddockInternal = Flag False,
haddockCss = NoFlag,
haddockLinkedSource = Flag False,
haddockQuickJump = Flag False,
haddockHscolourCss = NoFlag,
haddockContents = NoFlag,
haddockDistPref = NoFlag,
......@@ -1519,6 +1521,11 @@ haddockOptions showOrParseArgs =
haddockLinkedSource (\v flags -> flags { haddockLinkedSource = v })
trueArg
,option "" ["quickjump"]
"Generate an index for interactive documentation navigation"
haddockQuickJump (\v flags -> flags { haddockQuickJump = v })
trueArg
,option "" ["hscolour-css"]
"Use PATH as the HsColour stylesheet"
haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v })
......
......@@ -408,6 +408,7 @@ instance Semigroup SavedConfig where
haddockInternal = combine haddockInternal,
haddockCss = combine haddockCss,
haddockLinkedSource = combine haddockLinkedSource,
haddockQuickJump = combine haddockQuickJump,
haddockHscolourCss = combine haddockHscolourCss,
haddockContents = combine haddockContents,
haddockDistPref = combine haddockDistPref,
......
......@@ -411,6 +411,7 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags =
haddockInternal = packageConfigHaddockInternal,
haddockCss = packageConfigHaddockCss,
haddockLinkedSource = packageConfigHaddockLinkedSource,
haddockQuickJump = packageConfigHaddockQuickJump,
haddockHscolourCss = packageConfigHaddockHscolourCss,
haddockContents = packageConfigHaddockContents
} = haddockFlags
......@@ -729,6 +730,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
haddockInternal = packageConfigHaddockInternal,
haddockCss = packageConfigHaddockCss,
haddockLinkedSource = packageConfigHaddockLinkedSource,
haddockQuickJump = packageConfigHaddockQuickJump,
haddockHscolourCss = packageConfigHaddockHscolourCss,
haddockContents = packageConfigHaddockContents,
haddockDistPref = mempty,
......
......@@ -270,6 +270,7 @@ data PackageConfig
packageConfigHaddockInternal :: Flag Bool, --TODO: [required eventually] use this
packageConfigHaddockCss :: Flag FilePath, --TODO: [required eventually] use this
packageConfigHaddockLinkedSource :: Flag Bool, --TODO: [required eventually] use this
packageConfigHaddockQuickJump :: Flag Bool, --TODO: [required eventually] use this
packageConfigHaddockHscolourCss :: Flag FilePath, --TODO: [required eventually] use this
packageConfigHaddockContents :: Flag PathTemplate, --TODO: [required eventually] use this
packageConfigHaddockForHackage :: Flag HaddockTarget
......
......@@ -1828,6 +1828,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
elabHaddockInternal = perPkgOptionFlag pkgid False packageConfigHaddockInternal
elabHaddockCss = perPkgOptionMaybe pkgid packageConfigHaddockCss
elabHaddockLinkedSource = perPkgOptionFlag pkgid False packageConfigHaddockLinkedSource
elabHaddockQuickJump = perPkgOptionFlag pkgid False packageConfigHaddockQuickJump
elabHaddockHscolourCss = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss
elabHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents
......@@ -3441,6 +3442,7 @@ setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir =
haddockInternal = toFlag elabHaddockInternal,
haddockCss = maybe mempty toFlag elabHaddockCss,
haddockLinkedSource = toFlag elabHaddockLinkedSource,
haddockQuickJump = toFlag elabHaddockQuickJump,
haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss,
haddockContents = maybe mempty toFlag elabHaddockContents,
haddockDistPref = toFlag builddir,
......
......@@ -277,6 +277,7 @@ data ElaboratedConfiguredPackage
elabHaddockInternal :: Bool,
elabHaddockCss :: Maybe FilePath,
elabHaddockLinkedSource :: Bool,
elabHaddockQuickJump :: Bool,
elabHaddockHscolourCss :: Maybe FilePath,
elabHaddockContents :: Maybe PathTemplate,
......
......@@ -602,9 +602,10 @@ instance Arbitrary PackageConfig where
, packageConfigHaddockInternal = x36
, packageConfigHaddockCss = x37
, packageConfigHaddockLinkedSource = x38
, packageConfigHaddockHscolourCss = x39
, packageConfigHaddockContents = x40
, packageConfigHaddockForHackage = x41 } =
, packageConfigHaddockQuickJump = x39
, packageConfigHaddockHscolourCss = x40
, packageConfigHaddockContents = x41
, packageConfigHaddockForHackage = x42 } =
[ PackageConfig { packageConfigProgramPaths = postShrink_Paths x00'
, packageConfigProgramArgs = postShrink_Args x01'
, packageConfigProgramPathExtra = x02'
......@@ -647,9 +648,10 @@ instance Arbitrary PackageConfig where
, packageConfigHaddockInternal = x36'
, packageConfigHaddockCss = fmap getNonEmpty x37'
, packageConfigHaddockLinkedSource = x38'
, packageConfigHaddockHscolourCss = fmap getNonEmpty x39'
, packageConfigHaddockContents = x40'
, packageConfigHaddockForHackage = x41' }
, packageConfigHaddockQuickJump = x39'
, packageConfigHaddockHscolourCss = fmap getNonEmpty x40'
, packageConfigHaddockContents = x41'
, packageConfigHaddockForHackage = x42' }
| (((x00', x01', x02', x03', x04'),
(x05', x42', x06', x07', x08', x09'),
(x10', x11', x12', x13', x14'),
......@@ -657,8 +659,8 @@ instance Arbitrary PackageConfig where
((x20', x20_1', x21', x22', x23', x24'),
(x25', x26', x27', x28', x29'),
(x30', x31', x32', (x33', x33_1'), x34'),
(x35', x36', x37', x38', x39'),
(x40', x41')))
(x35', x36', x37', x38', x39', x40'),
(x41', x42')))
<- shrink
(((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04),
(x05, x42, x06, x07, x08, x09),
......@@ -670,8 +672,8 @@ instance Arbitrary PackageConfig where
((x20, x20_1, x21, x22, x23, x24),
(x25, x26, x27, x28, x29),
(x30, x31, x32, (x33, x33_1), x34),
(x35, x36, fmap NonEmpty x37, x38, fmap NonEmpty x39),
(x40, x41)))
(x35, x36, fmap NonEmpty x37, x38, x39, fmap NonEmpty x40),
(x41, x42)))
]
where
preShrink_Paths = Map.map NonEmpty
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment