Commit bb2026c4 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺 Committed by GitHub

Make `Version` type opaque (#3905)

Similiar to dabd9d98 which made
`PackageName` opaque, this makes `Distribution.Version.Version` opaque.

The most common version numbers occuring on Hackage are 3- and
4-part versions. This results in significant Heap overhead due to
`Data.Version`'s inefficient internal representation.

So like the `PackageName` commit, this commit is a preparatory commit to
pave the way for replacing `Version`'s internal representation by a
representation with a memory footprint which can be an order of
magnitude smaller.

Finally, this also adds a new functor-like convenience function

    alterVersion :: ([Int] -> [Int]) -> Version -> Version

for modifying the version number components.
parent c70ae433
......@@ -48,7 +48,7 @@ import Distribution.Compat.Prelude
import Language.Haskell.Extension
import Distribution.Version (Version(..))
import Distribution.Version (Version, mkVersion', nullVersion)
import qualified System.Info (compilerName, compilerVersion)
import Distribution.Text (Text(..), display)
......@@ -112,7 +112,7 @@ buildCompilerFlavor :: CompilerFlavor
buildCompilerFlavor = classifyCompilerFlavor System.Info.compilerName
buildCompilerVersion :: Version
buildCompilerVersion = System.Info.compilerVersion
buildCompilerVersion = mkVersion' System.Info.compilerVersion
buildCompilerId :: CompilerId
buildCompilerId = CompilerId buildCompilerFlavor buildCompilerVersion
......@@ -138,12 +138,13 @@ data CompilerId = CompilerId CompilerFlavor Version
instance Binary CompilerId
instance Text CompilerId where
disp (CompilerId f (Version [] _)) = disp f
disp (CompilerId f v) = disp f <<>> Disp.char '-' <<>> disp v
disp (CompilerId f v)
| v == nullVersion = disp f
| otherwise = disp f <<>> Disp.char '-' <<>> disp v
parse = do
flavour <- parse
version <- (Parse.char '-' >> parse) Parse.<++ return (Version [] [])
version <- (Parse.char '-' >> parse) Parse.<++ return nullVersion
return (CompilerId flavour version)
lowercase :: String -> String
......
......@@ -133,7 +133,7 @@ instance IsNode InstalledPackageInfo where
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId = PackageIdentifier (mkPackageName "") (Version [] []),
sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion,
installedUnitId = mkUnitId "",
compatPackageKey = "",
license = UnspecifiedLicense,
......
......@@ -129,12 +129,12 @@ knownLicenses = [ GPL unversioned, GPL (version [2]), GPL (version [3])
, LGPL unversioned, LGPL (version [2, 1]), LGPL (version [3])
, AGPL unversioned, AGPL (version [3])
, BSD2, BSD3, MIT, ISC
, MPL (Version [2, 0] [])
, MPL (mkVersion [2, 0])
, Apache unversioned, Apache (version [2, 0])
, PublicDomain, AllRightsReserved, OtherLicense]
where
unversioned = Nothing
version v = Just (Version v [])
version = Just . mkVersion
instance Text License where
disp (GPL version) = Disp.text "GPL" <<>> dispOptVersion version
......
......@@ -59,7 +59,7 @@
module Distribution.Make (
module Distribution.Package,
License(..), Version(..),
License(..), Version,
defaultMain, defaultMainArgs, defaultMainNoRead
) where
......
......@@ -54,8 +54,9 @@ import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Version
( Version(..), VersionRange, anyVersion, thisVersion
, notThisVersion, simplifyVersionRange )
( Version, VersionRange, anyVersion, thisVersion
, notThisVersion, simplifyVersionRange
, nullVersion )
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
......@@ -122,13 +123,13 @@ data PackageIdentifier
instance Binary PackageIdentifier
instance Text PackageIdentifier where
disp (PackageIdentifier n v) = case v of
Version [] _ -> disp n -- if no version, don't show version.
_ -> disp n <<>> Disp.char '-' <<>> disp v
disp (PackageIdentifier n v)
| v == nullVersion = disp n -- if no version, don't show version.
| otherwise = disp n <<>> Disp.char '-' <<>> disp v
parse = do
n <- parse
v <- (Parse.char '-' >> parse) <++ return (Version [] [])
v <- (Parse.char '-' >> parse) <++ return nullVersion
return (PackageIdentifier n v)
instance NFData PackageIdentifier where
......
......@@ -113,7 +113,7 @@ check True pc = Just pc
checkSpecVersion :: PackageDescription -> [Int] -> Bool -> PackageCheck
-> Maybe PackageCheck
checkSpecVersion pkg specver cond pc
| specVersion pkg >= Version specver [] = Nothing
| specVersion pkg >= mkVersion specver = Nothing
| otherwise = check cond pc
-- ------------------------------------------------------------
......@@ -169,7 +169,7 @@ checkSanity pkg =
check (null . unPackageName . packageName $ pkg) $
PackageBuildImpossible "No 'name' field."
, check (null . versionBranch . packageVersion $ pkg) $
, check (nullVersion == packageVersion pkg) $
PackageBuildImpossible "No 'version' field."
, check (all ($ pkg) [ null . executables
......@@ -258,7 +258,7 @@ checkLibrary pkg lib =
where
checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion ver cond pc
| specVersion pkg >= Version ver [] = Nothing
| specVersion pkg >= mkVersion ver = Nothing
| otherwise = check cond pc
moduleDuplicates = dups (libModules lib ++
......@@ -937,7 +937,7 @@ checkCabalVersion pkg =
catMaybes [
-- check syntax of cabal-version field
check (specVersion pkg >= Version [1,10] []
check (specVersion pkg >= mkVersion [1,10]
&& not simpleSpecVersionRangeSyntax) $
PackageBuildWarning $
"Packages relying on Cabal 1.10 or later must only specify a "
......@@ -945,7 +945,7 @@ checkCabalVersion pkg =
++ "'cabal-version: >= " ++ display (specVersion pkg) ++ "'."
-- check syntax of cabal-version field
, check (specVersion pkg < Version [1,9] []
, check (specVersion pkg < mkVersion [1,9]
&& not simpleSpecVersionRangeSyntax) $
PackageDistSuspicious $
"It is recommended that the 'cabal-version' field only specify a "
......@@ -976,7 +976,7 @@ checkCabalVersion pkg =
"To use the 'default-language' field the package needs to specify "
++ "at least 'cabal-version: >= 1.10'."
, check (specVersion pkg >= Version [1,10] []
, check (specVersion pkg >= mkVersion [1,10]
&& (any isNothing (buildInfoField defaultLanguage))) $
PackageBuildWarning $
"Packages using 'cabal-version: >= 1.10' must specify the "
......@@ -1028,7 +1028,7 @@ checkCabalVersion pkg =
++ "at least 'cabal-version: >= 1.10'."
-- check use of extensions field
, check (specVersion pkg >= Version [1,10] []
, check (specVersion pkg >= mkVersion [1,10]
&& (any (not . null) (buildInfoField oldExtensions))) $
PackageBuildWarning $
"For packages using 'cabal-version: >= 1.10' the 'extensions' "
......@@ -1144,7 +1144,7 @@ checkCabalVersion pkg =
++ "compatibility with earlier Cabal versions then you may be able to "
++ "use an equivalent compiler-specific flag."
, check (specVersion pkg >= Version [1,23] []
, check (specVersion pkg >= mkVersion [1,23]
&& isNothing (setupBuildInfo pkg)
&& buildType pkg == Just Custom) $
PackageBuildWarning $
......@@ -1154,7 +1154,7 @@ checkCabalVersion pkg =
++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
++ "so a simple example would be 'setup-depends: base, Cabal'."
, check (specVersion pkg < Version [1,23] []
, check (specVersion pkg < mkVersion [1,23]
&& isNothing (setupBuildInfo pkg)
&& buildType pkg == Just Custom) $
PackageDistSuspiciousWarn $
......@@ -1165,7 +1165,7 @@ checkCabalVersion pkg =
++ "The 'setup-depends' field uses the same syntax as 'build-depends', "
++ "so a simple example would be 'setup-depends: base, Cabal'."
, check (specVersion pkg >= Version [1,25] []
, check (specVersion pkg >= mkVersion [1,25]
&& elem (autogenPathsModuleName pkg) allModuleNames
&& not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) ) $
PackageDistInexcusable $
......@@ -1184,7 +1184,7 @@ checkCabalVersion pkg =
-- version.
checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck
checkVersion ver cond pc
| specVersion pkg >= Version ver [] = Nothing
| specVersion pkg >= mkVersion ver = Nothing
| otherwise = check cond pc
buildInfoField field = map field (allBuildInfo pkg)
......@@ -1373,8 +1373,9 @@ displayRawVersionRange =
(\(r, _ ) -> (Disp.parens r, 0)) -- parens
where
dispWild (Version b _) =
Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int b))
dispWild v =
Disp.hcat (Disp.punctuate (Disp.char '.')
(map Disp.int $ versionNumbers v))
<<>> Disp.text ".*"
punct p p' | p < p' = Disp.parens
| otherwise = id
......@@ -1424,7 +1425,7 @@ checkPackageVersions pkg =
[] defaultComponentRequestedSpec (const True)
buildPlatform
(unknownCompilerInfo
(CompilerId buildCompilerFlavor (Version [] []))
(CompilerId buildCompilerFlavor nullVersion)
NoAbiTag)
[] pkg
baseDependency = case finalised of
......
......@@ -697,10 +697,10 @@ parsePackageDescription file = do
head $ [ minVersionBound versionRange
| Just versionRange <- [ simpleParse v
| F _ "cabal-version" v <- fields0 ] ]
++ [Version [0] []]
++ [mkVersion [0]]
minVersionBound versionRange =
case asVersionIntervals versionRange of
[] -> Version [0] []
[] -> mkVersion [0]
((LowerBound version _, _):_) -> version
handleFutureVersionParseFailure cabalVersionNeeded $ do
......@@ -753,13 +753,13 @@ parsePackageDescription file = do
++ " Tabs were used at (line,column): " ++ show tabs
maybeWarnCabalVersion newsyntax pkg
| newsyntax && specVersion pkg < Version [1,2] []
| newsyntax && specVersion pkg < mkVersion [1,2]
= lift $ warning $
"A package using section syntax must specify at least\n"
++ "'cabal-version: >= 1.2'."
maybeWarnCabalVersion newsyntax pkg
| not newsyntax && specVersion pkg >= Version [1,2] []
| not newsyntax && specVersion pkg >= mkVersion [1,2]
= lift $ warning $
"A package using 'cabal-version: "
++ displaySpecVersion (specVersionRaw pkg)
......
......@@ -660,7 +660,7 @@ parseVersionRangeQ = parseQuoted parse <++ parse
parseOptVersion :: ReadP r Version
parseOptVersion = parseQuoted ver <++ ver
where ver :: ReadP r Version
ver = parse <++ return (Version [] [])
ver = parse <++ return nullVersion
parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange)
parseTestedWithQ = parseQuoted tw <++ tw
......
......@@ -120,7 +120,7 @@ generateMacros macro_prefix name version =
]
,"\n"]
where
(major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
(major1:major2:minor:_) = map show (versionNumbers version ++ repeat 0)
-- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
-- of the current package.
......
......@@ -100,8 +100,8 @@ generate pkg_descr lbi clbi =
"catchIO = Exception.catch\n" ++
"\n"++
"version :: Version"++
"\nversion = Version " ++ show branch ++ " " ++ show tags
where Version branch tags = packageVersion pkg_descr
"\nversion = Version " ++ show branch ++ " []"
where branch = versionNumbers $ packageVersion pkg_descr
body
| reloc =
......@@ -237,7 +237,7 @@ generate pkg_descr lbi clbi =
supports_language_pragma =
(compilerFlavor (compiler lbi) == GHC &&
(compilerVersion (compiler lbi)
`withinRange` orLaterVersion (Version [6,6,1] []))) ||
`withinRange` orLaterVersion (mkVersion [6,6,1]))) ||
compilerFlavor (compiler lbi) == GHCJS
-- | Generates the name of the environment variable controlling the path
......
......@@ -249,7 +249,7 @@ currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (mkPackageName System.Info.compilerName)
System.Info.compilerVersion
(mkVersion' System.Info.compilerVersion)
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
......@@ -650,7 +650,7 @@ configure (pkg_descr0', pbi) cfg = do
if not (fromFlag $ configSplitObjs cfg)
then return False
else case compilerFlavor comp of
GHC | compilerVersion comp >= Version [6,5] []
GHC | compilerVersion comp >= mkVersion [6,5]
-> return True
GHCJS
-> return True
......@@ -1346,7 +1346,7 @@ interpretPackageDbFlags userInstall specificDBs =
extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs
newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion = Version [1,7,1] []
newPackageDepsBehaviourMinVersion = mkVersion [1,7,1]
-- In older cabal versions, there was only one set of package dependencies for
-- the whole package. In this version, we can have separate dependencies per
......@@ -1456,7 +1456,7 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled
| otherwise = do
(_, _, progdb') <- requireProgramVersion
(lessVerbose verbosity) pkgConfigProgram
(orLaterVersion $ Version [0,9,0] []) progdb
(orLaterVersion $ mkVersion [0,9,0]) progdb
traverse_ requirePkg allpkgs
mlib' <- traverse addPkgConfigBILib (library pkg_descr)
libs' <- traverse addPkgConfigBILib (subLibraries pkg_descr)
......
......@@ -88,7 +88,6 @@ import Distribution.Utils.NubList
import Language.Haskell.Extension
import qualified Data.Map as Map
import Data.Version ( showVersion )
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile )
......@@ -107,7 +106,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, progdb1) <-
requireProgramVersion verbosity ghcProgram
(orLaterVersion (Version [6,11] []))
(orLaterVersion (mkVersion [6,11]))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion
......@@ -149,7 +148,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
-- `--supported-extensions` when it's not available.
-- for older GHCs we can use the "Have interpreter" property to
-- filter out `TemplateHaskell`
extensions | ghcVersion < Version [8] []
extensions | ghcVersion < mkVersion [8]
, Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap
= filter ((/= EnableExtension TemplateHaskell) . fst)
extensions0
......@@ -348,7 +347,7 @@ getUserPackageDB _verbosity ghcProg (Platform arch os) = do
, Internal.showOsString os
, display ghcVersion ]
packageConfFileName
| ghcVersion >= Version [6,12] [] = "package.conf.d"
| ghcVersion >= mkVersion [6,12] = "package.conf.d"
| otherwise = "package.conf"
Just ghcVersion = programVersion ghcProg
......@@ -397,7 +396,7 @@ removeMingwIncludeDir pkg =
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs progdb
| ghcVersion >= Version [6,9] [] =
| ghcVersion >= mkVersion [6,9] =
sequenceA
[ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
return (packagedb, pkgs)
......@@ -426,7 +425,7 @@ getInstalledPackages' verbosity packagedbs progdb = do
-- instance to parse the package file and then convert.
-- It's a bit yuck. But that's what we get for using Read/Show.
readPackages
| ghcVersion >= Version [6,4,2] []
| ghcVersion >= mkVersion [6,4,2]
= \file content -> case reads content of
[(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
_ -> failToRead file
......@@ -663,17 +662,17 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
stubObjs <- catMaybes <$> sequenceA
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
| ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
stubProfObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
| ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
stubSharedObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
| ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
hObjs <- Internal.getHaskellObjects implInfo lib lbi
......@@ -723,7 +722,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-- at build time. This only applies to GHC < 7.8 - see the
-- discussion in #1660.
ghcOptDylibName = if hostOS == OSX
&& ghcVersion < Version [7,8] []
&& ghcVersion < mkVersion [7,8]
then toFlag sharedLibInstallPath
else mempty,
ghcOptNoAutoLinkPackages = toFlag True,
......@@ -957,7 +956,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
-- Work around old GHCs not relinking in this
-- situation, see #3294
let target = targetDir </> exeNameReal
when (compilerVersion comp < Version [7,7] []) $ do
when (compilerVersion comp < mkVersion [7,7]) $ do
e <- doesFileExist target
when e (removeFile target)
runGhcProg linkOpts { ghcOptOutputFile = toFlag target }
......@@ -1031,7 +1030,7 @@ hackThreadedFlag verbosity comp prof bi
++ "profiling in ghc-6.8 and older. It will be disabled."
return bi { options = filterHcOptions (/= "-threaded") (options bi) }
where
mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] []
mustFilterThreaded = prof && compilerVersion comp < mkVersion [6, 10]
&& "-threaded" `elem` hcOptions GHC bi
filterHcOptions p hcoptss =
[ (hc, if hc == GHC then filter p opts else opts)
......@@ -1201,7 +1200,7 @@ hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.recacheMultiInstance = v >= [6,12]
}
where
v = versionBranch ver
v = versionNumbers ver
Just ghcPkgProg = lookupProgram ghcPkgProgram progdb
Just ver = programVersion ghcPkgProg
......@@ -1231,7 +1230,7 @@ pkgRoot verbosity lbi = pkgRoot'
appDir <- getAppUserDataDirectory "ghc"
let ver = compilerVersion (compiler lbi)
subdir = System.Info.arch ++ '-':System.Info.os
++ '-':showVersion ver
++ '-':display ver
rootDir = appDir </> subdir
-- We must create the root directory for the user package database if it
-- does not yet exists. Otherwise '${pkgroot}' will resolve to a
......
......@@ -57,7 +57,7 @@ getImplInfo comp =
", but found " ++ show x)
ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo (Version v _) = GhcImplInfo
ghcVersionImplInfo ver = GhcImplInfo
{ supportsHaskell2010 = v >= [7]
, reportsNoExt = v >= [7]
, alwaysNondecIndent = v < [7,1]
......@@ -66,6 +66,8 @@ ghcVersionImplInfo (Version v _) = GhcImplInfo
, flagPackageConf = v < [7,5]
, flagDebugInfo = v >= [7,10]
}
where
v = versionNumbers ver
ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo
......
......@@ -58,7 +58,7 @@ configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
configure verbosity hcPath hcPkgPath progdb0 = do
(ghcjsProg, ghcjsVersion, progdb1) <-
requireProgramVersion verbosity ghcjsProgram
(orLaterVersion (Version [0,1] []))
(orLaterVersion (mkVersion [0,1]))
(userMaybeSpecifyPath "ghcjs" hcPath progdb0)
Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg)
let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion
......@@ -109,7 +109,7 @@ configure verbosity hcPath hcPkgPath progdb0 = do
let comp = Compiler {
compilerId = CompilerId GHCJS ghcjsVersion,
compilerAbiTag = AbiTag $
"ghc" ++ intercalate "_" (map show . versionBranch $ ghcjsGhcVersion),
"ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion),
compilerCompat = [CompilerId GHC ghcjsGhcVersion],
compilerLanguages = languages,
compilerExtensions = extensions,
......@@ -855,12 +855,12 @@ hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
, HcPkg.supportsDirDbs = True
, HcPkg.requiresDirDbs = v >= [7,10]
, HcPkg.nativeMultiInstance = v >= [7,10]
, HcPkg.requiresDirDbs = ver >= v7_10
, HcPkg.nativeMultiInstance = ver >= v7_10
, HcPkg.recacheMultiInstance = True
}
where
v = versionBranch ver
v7_10 = mkVersion [7,10]
Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram progdb
Just ver = programVersion ghcjsPkgProg
......
......@@ -157,11 +157,11 @@ haddock pkg_descr lbi suffixes flags' = do
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(haddockProg, version, _) <-
requireProgramVersion verbosity haddockProgram
(orLaterVersion (Version [2,0] [])) (withPrograms lbi)
(orLaterVersion (mkVersion [2,0])) (withPrograms lbi)
-- various sanity checks
when ( flag haddockHoogle
&& version < Version [2,2] []) $
&& version < mkVersion [2,2]) $
die "haddock 2.0 and 2.1 do not support the --hoogle flag."
haddockGhcVersionStr <- getProgramOutput verbosity haddockProg
......@@ -410,7 +410,7 @@ getGhcCppOpts haddockVersion bi =
haddockVersionMacro = "-D__HADDOCK_VERSION__="
++ show (v1 * 1000 + v2 * 10 + v3)
where
[v1, v2, v3] = take 3 $ versionBranch haddockVersion ++ [0,0]
[v1, v2, v3] = take 3 $ versionNumbers haddockVersion ++ [0,0]
getGhcLibDir :: Verbosity -> LocalBuildInfo
-> IO HaddockArgs
......@@ -450,8 +450,8 @@ renderArgs :: Verbosity
-> (([String], FilePath) -> IO a)
-> IO a
renderArgs verbosity tmpFileOpts version comp platform args k = do
let haddockSupportsUTF8 = version >= Version [2,14,4] []
haddockSupportsResponseFiles = version > Version [2,16,2] []
let haddockSupportsUTF8 = version >= mkVersion [2,14,4]
haddockSupportsResponseFiles = version > mkVersion [2,16,2]
createDirectoryIfMissingVerbose verbosity True outputDir
withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $
\prologueFileName h -> do
......@@ -558,7 +558,7 @@ renderPureArgs version comp platform args = concat
map (\(i,mh) -> "--read-interface=" ++
maybe "" (++",") mh ++ i)
bool a b c = if c then a else b
isVersion major minor = version >= Version [major,minor] []
isVersion major minor = version >= mkVersion [major,minor]
verbosityFlag
| isVersion 2 5 = "--verbosity=1"
| otherwise = "--verbose"
......@@ -658,7 +658,7 @@ hscolour' :: (String -> IO ()) -- ^ Called when the 'hscolour' exe is not found.
hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
either onNoHsColour (\(hscolourProg, _, _) -> go hscolourProg) =<<
lookupProgramVersion verbosity hscolourProgram
(orLaterVersion (Version [1,8] [])) (withPrograms lbi)
(orLaterVersion (mkVersion [1,8])) (withPrograms lbi)
where
go :: ConfiguredProgram -> IO ()
go hscolourProg = do
......@@ -696,7 +696,7 @@ hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
createDirectoryIfMissingVerbose verbosity True outputDir
case stylesheet of -- copy the CSS file
Nothing | programVersion prog >= Just (Version [1,9] []) ->
Nothing | programVersion prog >= Just (mkVersion [1,9]) ->
runProgram verbosity prog
["-print-css", "-o" ++ outputDir </> "hscolour.css"]
| otherwise -> return ()
......
......@@ -6,7 +6,6 @@ module Distribution.Simple.HaskellSuite where
import Prelude ()
import Distribution.Compat.Prelude
import Data.Version
import qualified Data.Map as Map (empty)
import Distribution.Simple.Program
......@@ -14,6 +13,7 @@ import Distribution.Simple.Compiler as Compiler
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.Verbosity
import Distribution.Version
import Distribution.Text
import Distribution.Package
import Distribution.InstalledPackageInfo hiding (includeDirs)
......
......@@ -56,7 +56,7 @@ configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
configure verbosity hcPath _hcPkgPath progdb = do
(jhcProg, _, progdb') <- requireProgramVersion verbosity
jhcProgram (orLaterVersion (Version [0,7,2] []))
jhcProgram (orLaterVersion (mkVersion [0,7,2]))
(userMaybeSpecifyPath "jhc" hcPath progdb)
let Just version = programVersion jhcProg
......
......@@ -83,12 +83,12 @@ configure verbosity hcPath hcPkgPath progdb = do
(lhcProg, lhcVersion, progdb') <-
requireProgramVersion verbosity lhcProgram
(orLaterVersion (Version [0,7] []))
(orLaterVersion (mkVersion [0,7]))
(userMaybeSpecifyPath "lhc" hcPath progdb)
(lhcPkgProg, lhcPkgVersion, progdb'') <-
requireProgramVersion verbosity lhcPkgProgram
(orLaterVersion (Version [0,7] []))
(orLaterVersion (mkVersion [0,7]))
(userMaybeSpecifyPath "lhc-pkg" hcPkgPath progdb')
when (lhcVersion /= lhcPkgVersion) $ die $
......@@ -258,7 +258,7 @@ getInstalledPackages' lhcPkg verbosity packagedbs progdb