Skip to content

Commit

Permalink
Remove support for Haddock versions < 2.0
Browse files Browse the repository at this point in the history
Dropping this support is unlikely to be a problem in practice.  Debian
oldstable is currently on version 2.6.0 of Haddock, for example.

This change enables future code simplification.  Currently we
preprocess both Haskell files requiring the CPP and Literate Haskell
files; newer versions of Haddock can handle these natively.

Fixes issue haskell#1718.
  • Loading branch information
iainnicol committed May 10, 2014
1 parent a718eb0 commit 98c537f
Show file tree
Hide file tree
Showing 3 changed files with 33 additions and 63 deletions.
79 changes: 30 additions & 49 deletions Cabal/Distribution/Simple/Haddock.hs
Expand Up @@ -8,11 +8,10 @@
-- Portability : portable
--
-- This module deals with the @haddock@ and @hscolour@ commands. Sadly this is a
-- rather complicated module. It deals with two versions of haddock (0.x and
-- 2.x). It has to do pre-processing which involves \'unlit\'ing and using
-- @-D__HADDOCK__@ for any source code that uses @cpp@. It uses information
-- about installed packages (from @ghc-pkg@) to find the locations of
-- documentation for dependent packages, so it can create links.
-- rather complicated module. It has to do pre-processing which involves
-- \'unlit\'ing and using @-D__HADDOCK__@ for any source code that uses @cpp@.
-- It uses information about installed packages (from @ghc-pkg@) to find the
-- locations of documentation for dependent packages, so it can create links.
--
-- The @hscolour@ support allows generating HTML versions of the original
-- source, with coloured syntax highlighting.
Expand Down Expand Up @@ -81,7 +80,7 @@ import Language.Haskell.Extension
-- Base
import System.Directory(removeFile, doesFileExist, createDirectoryIfMissing)

import Control.Monad ( when, guard, forM_ )
import Control.Monad ( when, forM_ )
import Control.Exception (assert)
import Data.Either ( rights )
import Data.Monoid
Expand Down Expand Up @@ -110,8 +109,8 @@ data HaddockArgs = HaddockArgs {
argOutputDir :: Directory, -- ^ where to generate the documentation.
argTitle :: Flag String, -- ^ page's title, required.
argPrologue :: Flag String, -- ^ prologue text, required.
argGhcOptions :: Flag (GhcOptions, Version), -- ^ additional flags to pass to ghc for haddock-2
argGhcLibDir :: Flag FilePath, -- ^ to find the correct ghc, required by haddock-2.
argGhcOptions :: Flag (GhcOptions, Version), -- ^ additional flags to pass to ghc
argGhcLibDir :: Flag FilePath, -- ^ to find the correct ghc, required.
argTargets :: [FilePath] -- ^ modules to process.
}

Expand Down Expand Up @@ -144,32 +143,25 @@ haddock pkg_descr lbi suffixes flags = do
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(confHaddock, version, _) <-
requireProgramVersion verbosity haddockProgram
(orLaterVersion (Version [0,6] [])) (withPrograms lbi)
(orLaterVersion (Version [2,0] [])) (withPrograms lbi)

-- various sanity checks
let isVersion2 = version >= Version [2,0] []

when ( flag haddockHoogle
&& version >= Version [2] []
&& version < Version [2,2] []) $
die "haddock 2.0 and 2.1 do not support the --hoogle flag."

when (flag haddockHscolour && version < Version [0,8] []) $
die "haddock --hyperlink-source requires Haddock version 0.8 or later"

when isVersion2 $ do
haddockGhcVersionStr <- rawSystemProgramStdout verbosity confHaddock
["--ghc-version"]
case simpleParse haddockGhcVersionStr of
Nothing -> die "Could not get GHC version from Haddock"
Just haddockGhcVersion
| haddockGhcVersion == ghcVersion -> return ()
| otherwise -> die $
"Haddock's internal GHC version must match the configured "
++ "GHC version.\n"
++ "The GHC version is " ++ display ghcVersion ++ " but "
++ "haddock is using GHC version " ++ display haddockGhcVersion
where ghcVersion = compilerVersion comp
haddockGhcVersionStr <- rawSystemProgramStdout verbosity confHaddock
["--ghc-version"]
case simpleParse haddockGhcVersionStr of
Nothing -> die "Could not get GHC version from Haddock"
Just haddockGhcVersion
| haddockGhcVersion == ghcVersion -> return ()
| otherwise -> die $
"Haddock's internal GHC version must match the configured "
++ "GHC version.\n"
++ "The GHC version is " ++ display ghcVersion ++ " but "
++ "haddock is using GHC version " ++ display haddockGhcVersion
where ghcVersion = compilerVersion comp

-- the tools match the requests, we can proceed

Expand All @@ -178,7 +170,7 @@ haddock pkg_descr lbi suffixes flags = do
when (flag haddockHscolour) $ hscolour' pkg_descr lbi suffixes $
defaultHscolourFlags `mappend` haddockToHscolour flags

libdirArgs <- getGhcLibDir verbosity lbi isVersion2
libdirArgs <- getGhcLibDir verbosity lbi
let commonArgs = mconcat
[ libdirArgs
, fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
Expand Down Expand Up @@ -259,9 +251,7 @@ prepareSources verbosity tmp lbi haddockVersion bi args@HaddockArgs{argTargets=f

return hsFile
needsCpp = EnableExtension CPP `elem` allExtensions bi
isVersion2 = haddockVersion >= Version [2,0] []
defines | isVersion2 = [haddockVersionMacro]
| otherwise = ["-D__HADDOCK__", haddockVersionMacro]
defines = [haddockVersionMacro]
haddockVersionMacro = "-D__HADDOCK_VERSION__="
++ show (v1 * 1000 + v2 * 10 + v3)
where
Expand Down Expand Up @@ -413,14 +403,10 @@ getInterfaces verbosity lbi clbi htmlTemplate = do
}

getGhcLibDir :: Verbosity -> LocalBuildInfo
-> Bool -- ^ are we using haddock-2.x ?
-> IO HaddockArgs
getGhcLibDir verbosity lbi isVersion2
| isVersion2 =
do l <- ghcLibDir verbosity lbi
return $ mempty { argGhcLibDir = Flag l }
| otherwise =
return mempty
getGhcLibDir verbosity lbi = do
l <- ghcLibDir verbosity lbi
return $ mempty { argGhcLibDir = Flag l }

-- ------------------------------------------------------------------------------
-- | Call haddock with the specified arguments.
Expand Down Expand Up @@ -458,7 +444,6 @@ renderArgs verbosity tmpFileOpts version comp args k = do
let pflag = "--prologue=" ++ prologFileName
k (pflag : renderPureArgs version comp args, result)
where
isVersion2 = version >= Version [2,0] []
outputDir = (unDir $ argOutputDir args)
result = intercalate ", "
. map (\o -> outputDir </>
Expand All @@ -467,8 +452,7 @@ renderArgs verbosity tmpFileOpts version comp args k = do
Hoogle -> pkgstr <.> "txt")
$ arg argOutput
where
pkgstr | isVersion2 = display $ packageName pkgid
| otherwise = display pkgid
pkgstr = display $ packageName pkgid
pkgid = arg argPackageName
arg f = fromFlag $ f args

Expand All @@ -477,9 +461,8 @@ renderPureArgs version comp args = concat
[
(:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) </> f)
. fromFlag . argInterfaceFile $ args,
(\pname -> if isVersion2
then ["--optghc=-package-name", "--optghc=" ++ pname]
else ["--package=" ++ pname]) . display . fromFlag . argPackageName $ args,
(\pname -> ["--optghc=-package-name", "--optghc=" ++ pname]
) . display . fromFlag . argPackageName $ args,
(\(All b,xs) -> bool (map (("--hide=" ++). display) xs) [] b) . argHideModules $ args,
bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args,
maybe [] (\(m,e,l) -> ["--source-module=" ++ m
Expand All @@ -495,18 +478,16 @@ renderPureArgs version comp args = concat
(:[]).("--odir="++) . unDir . argOutputDir $ args,
(:[]).("--title="++) . (bool (++" (internal documentation)") id (getAny $ argIgnoreExports args))
. fromFlag . argTitle $ args,
[ "--optghc=" ++ opt | isVersion2
, (opts, _ghcVer) <- flagToList (argGhcOptions args)
[ "--optghc=" ++ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args)
, opt <- renderGhcOptions comp opts ],
maybe [] (\l -> ["-B"++l]) $ guard isVersion2 >> flagToMaybe (argGhcLibDir args), -- error if isVersion2 and Nothing?
maybe [] (\l -> ["-B"++l]) $ flagToMaybe (argGhcLibDir args), -- error if Nothing?
argTargets $ args
]
where
renderInterfaces =
map (\(i,mh) -> "--read-interface=" ++
maybe "" (++",") mh ++ i)
bool a b c = if c then a else b
isVersion2 = version >= Version [2,0] []
isVersion2_5 = version >= Version [2,5] []
isVersion2_14 = version >= Version [2,14] []
verbosityFlag
Expand Down
15 changes: 2 additions & 13 deletions Cabal/Distribution/Simple/PreProcess.hs
Expand Up @@ -54,10 +54,10 @@ import Distribution.Simple.Utils
, findFileWithExtension, findFileWithExtension' )
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), programPath
, lookupProgram, requireProgram, requireProgramVersion
, requireProgram, requireProgramVersion
, rawSystemProgramConf, rawSystemProgram
, greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram
, happyProgram, alexProgram, haddockProgram, ghcProgram, gccProgram )
, happyProgram, alexProgram, ghcProgram, gccProgram )
import Distribution.Simple.Test.LibV09
( writeSimpleTestStub, stubFilePath, stubName )
import Distribution.System
Expand Down Expand Up @@ -355,7 +355,6 @@ ppGhcCpp extraArgs _bi lbi =
-- double-unlitted. In the future we might switch to
-- using cpphs --unlit instead.
++ (if ghcVersion >= Version [6,6] [] then ["-x", "hs"] else [])
++ (if use_optP_P lbi then ["-optP-P"] else [])
++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
++ ["-o", outFile, inFile]
++ extraArgs
Expand All @@ -377,16 +376,6 @@ ppCpphs extraArgs _bi lbi =
++ extraArgs
}

-- Haddock versions before 0.8 choke on #line and #file pragmas. Those
-- pragmas are necessary for correct links when we preprocess. So use
-- -optP-P only if the Haddock version is prior to 0.8.
use_optP_P :: LocalBuildInfo -> Bool
use_optP_P lbi
= case lookupProgram haddockProgram (withPrograms lbi) of
Just (ConfiguredProgram { programVersion = Just version })
| version >= Version [0,8] [] -> False
_ -> True

ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi =
PreProcessor {
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Simple/Setup.hs
Expand Up @@ -1167,7 +1167,7 @@ haddockCommand = makeCommand name shortDesc longDesc defaultHaddockFlags options
where
name = "haddock"
shortDesc = "Generate Haddock HTML documentation."
longDesc = Just $ \_ -> "Requires the program haddock, either version 0.x or 2.x.\n"
longDesc = Just $ \_ -> "Requires the program haddock, version 2.x.\n"
options showOrParseArgs = haddockOptions showOrParseArgs
++ programConfigurationPaths progConf ParseArgs
haddockProgramPaths (\v flags -> flags { haddockProgramPaths = v})
Expand Down

0 comments on commit 98c537f

Please sign in to comment.