From 5b5b74105089537c6e0e43cfa54c9dd3ab966135 Mon Sep 17 00:00:00 2001 From: Iain Nicol Date: Fri, 9 May 2014 19:42:36 +0100 Subject: [PATCH] Remove support for Haddock versions < 2.0 This will allow code to be simplified. Currently we preprocess both Literate Haskell files and Haskell files requiring the CPP, but newer versions of Haddock can handle these natively. Fixes issue #1718. --- Cabal/Distribution/Simple/Haddock.hs | 79 ++++++++++--------------- Cabal/Distribution/Simple/PreProcess.hs | 15 +---- 2 files changed, 32 insertions(+), 62 deletions(-) diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index ea6c7510fee..874b6689001 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -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 diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index 21175473adf..8490ff5e66b 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -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 {