Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Remove support for Haddock versions < 2.0

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 #1718.
  • Loading branch information...
commit 98c537f1263a1e46786d9abba55301768ca12fe5 1 parent a718eb0
Iain Nicol iainnicol authored
79 Cabal/Distribution/Simple/Haddock.hs
View
@@ -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.
@@ -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
@@ -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.
}
@@ -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
@@ -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
@@ -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
@@ -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.
@@ -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 </>
@@ -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
@@ -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
@@ -495,10 +478,9 @@ 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
@@ -506,7 +488,6 @@ renderPureArgs version comp args = concat
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
15 Cabal/Distribution/Simple/PreProcess.hs
View
@@ -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
@@ -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
@@ -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 {
2  Cabal/Distribution/Simple/Setup.hs
View
@@ -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})
Please sign in to comment.
Something went wrong with that request. Please try again.