Commit 2c3a1b07 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add packageName, packageVersion and use them

(pkgName . packageId) and (pkgVersion . packageId)
turn out to be very common so give them names.
parent b9a124cf
...@@ -61,8 +61,9 @@ import Distribution.ParseUtils ( ...@@ -61,8 +61,9 @@ import Distribution.ParseUtils (
showFilePath, showToken, parseReadS, parseOptVersion, parseQuoted, showFilePath, showToken, parseReadS, parseOptVersion, parseQuoted,
showFreeText) showFreeText)
import Distribution.License ( License(..) ) import Distribution.License ( License(..) )
import Distribution.Package ( PackageIdentifier(..), showPackageId, import Distribution.Package
parsePackageId ) ( PackageIdentifier(..), packageName, packageVersion
, showPackageId, parsePackageId )
import qualified Distribution.Package as Package import qualified Distribution.Package as Package
( Package(..), PackageFixedDeps(..) ) ( Package(..), PackageFixedDeps(..) )
import Distribution.Version ( Version(..), showVersion ) import Distribution.Version ( Version(..), showVersion )
...@@ -197,10 +198,10 @@ basicFieldDescrs :: [FieldDescr InstalledPackageInfo] ...@@ -197,10 +198,10 @@ basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
basicFieldDescrs = basicFieldDescrs =
[ simpleField "name" [ simpleField "name"
text parsePackageNameQ text parsePackageNameQ
(pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}}) packageName (\name pkg -> pkg{package=(package pkg){pkgName=name}})
, simpleField "version" , simpleField "version"
(text . showVersion) parseOptVersion (text . showVersion) parseOptVersion
(pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}}) packageVersion (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
, simpleField "license" , simpleField "license"
(text . show) parseLicenseQ (text . show) parseLicenseQ
license (\l pkg -> pkg{license=l}) license (\l pkg -> pkg{license=l})
......
...@@ -45,7 +45,7 @@ module Distribution.Package ( ...@@ -45,7 +45,7 @@ module Distribution.Package (
showPackageId, parsePackageId, parsePackageName, showPackageId, parsePackageId, parsePackageName,
-- * Package classes -- * Package classes
Package(..), Package(..), packageName, packageVersion,
PackageFixedDeps(..), PackageFixedDeps(..),
) where ) where
...@@ -66,7 +66,7 @@ data PackageIdentifier ...@@ -66,7 +66,7 @@ data PackageIdentifier
showPackageId :: PackageIdentifier -> String showPackageId :: PackageIdentifier -> String
showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version. showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version.
showPackageId pkgid = showPackageId pkgid =
pkgName pkgid ++ '-': showVersion (pkgVersion pkgid) pkgName pkgid ++ '-': showVersion (packageVersion pkgid)
parsePackageName :: ReadP r String parsePackageName :: ReadP r String
parsePackageName = do ns <- sepBy1 component (char '-') parsePackageName = do ns <- sepBy1 component (char '-')
...@@ -93,6 +93,12 @@ parsePackageId = do ...@@ -93,6 +93,12 @@ parsePackageId = do
class Package pkg where class Package pkg where
packageId :: pkg -> PackageIdentifier packageId :: pkg -> PackageIdentifier
packageName :: Package pkg => pkg -> String
packageName = pkgName . packageId
packageVersion :: Package pkg => pkg -> Version
packageVersion = pkgVersion . packageId
instance Package PackageIdentifier where instance Package PackageIdentifier where
packageId = id packageId = id
......
...@@ -79,7 +79,7 @@ import Data.List (nub) ...@@ -79,7 +79,7 @@ import Data.List (nub)
import Data.Monoid (Monoid(mempty, mappend)) import Data.Monoid (Monoid(mempty, mappend))
import Text.PrettyPrint.HughesPJ import Text.PrettyPrint.HughesPJ
import Distribution.Package (PackageIdentifier(..), Package(..)) import Distribution.Package (PackageIdentifier(PackageIdentifier), Package(..))
import Distribution.Version (Version(Version), VersionRange(AnyVersion)) import Distribution.Version (Version(Version), VersionRange(AnyVersion))
import Distribution.License (License(AllRightsReserved)) import Distribution.License (License(AllRightsReserved))
import Distribution.Version (Dependency, showVersionRange) import Distribution.Version (Dependency, showVersionRange)
......
...@@ -57,7 +57,8 @@ import Distribution.License (License(..)) ...@@ -57,7 +57,8 @@ import Distribution.License (License(..))
import Distribution.Simple.Utils (cabalVersion, intercalate) import Distribution.Simple.Utils (cabalVersion, intercalate)
import Distribution.Version (Version(..), withinRange, showVersionRange) import Distribution.Version (Version(..), withinRange, showVersionRange)
import Distribution.Package (PackageIdentifier(..)) import Distribution.Package
( packageName, packageVersion )
import Language.Haskell.Extension (Extension(..)) import Language.Haskell.Extension (Extension(..))
import System.FilePath (takeExtension, isRelative, splitDirectories, (</>)) import System.FilePath (takeExtension, isRelative, splitDirectories, (</>))
...@@ -132,10 +133,10 @@ checkSanity :: PackageDescription -> [PackageCheck] ...@@ -132,10 +133,10 @@ checkSanity :: PackageDescription -> [PackageCheck]
checkSanity pkg = checkSanity pkg =
catMaybes [ catMaybes [
check (null . pkgName . package $ pkg) $ check (null . packageName $ pkg) $
PackageBuildImpossible "No 'name' field." PackageBuildImpossible "No 'name' field."
, check (null . versionBranch . pkgVersion . package $ pkg) $ , check (null . versionBranch . packageVersion $ pkg) $
PackageBuildImpossible "No 'version' field." PackageBuildImpossible "No 'version' field."
, check (null (executables pkg) && isNothing (library pkg)) $ , check (null (executables pkg) && isNothing (library pkg)) $
......
...@@ -69,7 +69,9 @@ import Distribution.Compat.ReadP hiding (get) ...@@ -69,7 +69,9 @@ import Distribution.Compat.ReadP hiding (get)
import Distribution.ParseUtils import Distribution.ParseUtils
import Distribution.PackageDescription import Distribution.PackageDescription
import Distribution.Package (PackageIdentifier(..), parsePackageName) import Distribution.Package
( PackageIdentifier(..), packageName, packageVersion
, parsePackageName )
import Distribution.Version (Dependency, showVersion, parseVersion, import Distribution.Version (Dependency, showVersion, parseVersion,
showVersionRange, parseVersionRange, isAnyVersion) showVersionRange, parseVersionRange, isAnyVersion)
import Distribution.Verbosity (Verbosity) import Distribution.Verbosity (Verbosity)
...@@ -86,10 +88,10 @@ pkgDescrFieldDescrs :: [FieldDescr PackageDescription] ...@@ -86,10 +88,10 @@ pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
pkgDescrFieldDescrs = pkgDescrFieldDescrs =
[ simpleField "name" [ simpleField "name"
text parsePackageName text parsePackageName
(pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}}) packageName (\name pkg -> pkg{package=(package pkg){pkgName=name}})
, simpleField "version" , simpleField "version"
(text . showVersion) parseVersion (text . showVersion) parseVersion
(pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}}) packageVersion (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
, simpleField "cabal-version" , simpleField "cabal-version"
(text . showVersionRange) parseVersionRange (text . showVersionRange) parseVersionRange
descCabalVersion (\v pkg -> pkg{descCabalVersion=v}) descCabalVersion (\v pkg -> pkg{descCabalVersion=v})
...@@ -443,7 +445,7 @@ parsePackageDescription file = do ...@@ -443,7 +445,7 @@ parsePackageDescription file = do
"Do not use tabs for indentation (use spaces instead)\n" "Do not use tabs for indentation (use spaces instead)\n"
++ " Tabs were used at (line,column): " ++ show tabs ++ " Tabs were used at (line,column): " ++ show tabs
maybeWarnCabalVersion pkg = maybeWarnCabalVersion pkg =
when (pkgName (package pkg) /= "Cabal" -- supress warning for Cabal when (packageName pkg /= "Cabal" -- supress warning for Cabal
&& isAnyVersion (descCabalVersion pkg)) $ && isAnyVersion (descCabalVersion pkg)) $
lift $ warning $ lift $ warning $
"A package using section syntax should require\n" "A package using section syntax should require\n"
......
...@@ -49,7 +49,8 @@ import Distribution.Simple.Compiler ( Compiler(..), CompilerFlavor(..) ) ...@@ -49,7 +49,8 @@ import Distribution.Simple.Compiler ( Compiler(..), CompilerFlavor(..) )
import Distribution.PackageDescription import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), ( PackageDescription(..), BuildInfo(..),
Executable(..), Library(..) ) Executable(..), Library(..) )
import Distribution.Package ( PackageIdentifier(..), showPackageId, Package(..) ) import Distribution.Package
( packageVersion, showPackageId, Package(..) )
import Distribution.Simple.Setup ( CopyDest(..), BuildFlags(..), import Distribution.Simple.Setup ( CopyDest(..), BuildFlags(..),
MakefileFlags(..), fromFlag ) MakefileFlags(..), fromFlag )
import Distribution.Simple.PreProcess ( preprocessSources, PPSuffixHandler ) import Distribution.Simple.PreProcess ( preprocessSources, PPSuffixHandler )
...@@ -172,7 +173,7 @@ buildPathsModule pkg_descr lbi = ...@@ -172,7 +173,7 @@ buildPathsModule pkg_descr lbi =
"import Data.Version"++ "import Data.Version"++
"\n"++ "\n"++
"\nversion :: Version"++ "\nversion :: Version"++
"\nversion = " ++ show (pkgVersion (packageId pkg_descr))++ "\nversion = " ++ show (packageVersion pkg_descr)++
"\n" "\n"
body body
......
...@@ -62,7 +62,8 @@ module Distribution.Simple.BuildPaths ( ...@@ -62,7 +62,8 @@ module Distribution.Simple.BuildPaths (
import System.FilePath (FilePath, (</>), (<.>)) import System.FilePath (FilePath, (</>), (<.>))
import Distribution.Package (PackageIdentifier(..), Package(..)) import Distribution.Package
( PackageIdentifier(PackageIdentifier), packageName )
import Distribution.PackageDescription (PackageDescription) import Distribution.PackageDescription (PackageDescription)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir)) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(buildDir))
import Distribution.Version (showVersion) import Distribution.Version (showVersion)
...@@ -82,7 +83,7 @@ hscolourPref = haddockPref ...@@ -82,7 +83,7 @@ hscolourPref = haddockPref
haddockPref :: PackageDescription -> FilePath haddockPref :: PackageDescription -> FilePath
haddockPref pkg_descr haddockPref pkg_descr
= foldl1 (</>) [distPref, "doc", "html", pkgName (packageId pkg_descr)] = foldl1 (</>) [distPref, "doc", "html", packageName pkg_descr]
-- |The directory in which we put auto-generated modules -- |The directory in which we put auto-generated modules
autogenModulesDir :: LocalBuildInfo -> String autogenModulesDir :: LocalBuildInfo -> String
...@@ -92,12 +93,12 @@ autogenModulesDir lbi = buildDir lbi </> "autogen" ...@@ -92,12 +93,12 @@ autogenModulesDir lbi = buildDir lbi </> "autogen"
-- |The name of the auto-generated module associated with a package -- |The name of the auto-generated module associated with a package
autogenModuleName :: PackageDescription -> String autogenModuleName :: PackageDescription -> String
autogenModuleName pkg_descr = autogenModuleName pkg_descr =
"Paths_" ++ map fixchar (pkgName (packageId pkg_descr)) "Paths_" ++ map fixchar (packageName pkg_descr)
where fixchar '-' = '_' where fixchar '-' = '_'
fixchar c = c fixchar c = c
haddockName :: PackageDescription -> FilePath haddockName :: PackageDescription -> FilePath
haddockName pkg_descr = pkgName (packageId pkg_descr) <.> "haddock" haddockName pkg_descr = packageName pkg_descr <.> "haddock"
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Library file names -- Library file names
......
...@@ -60,7 +60,7 @@ module Distribution.Simple.Compiler ( ...@@ -60,7 +60,7 @@ module Distribution.Simple.Compiler (
import Distribution.Compiler import Distribution.Compiler
import Distribution.Version (Version(..)) import Distribution.Version (Version(..))
import Distribution.Package (PackageIdentifier(..), showPackageId) import Distribution.Package (PackageIdentifier, packageVersion, showPackageId)
import Language.Haskell.Extension (Extension(..)) import Language.Haskell.Extension (Extension(..))
import Data.List (nub) import Data.List (nub)
...@@ -77,7 +77,7 @@ showCompilerId :: Compiler -> String ...@@ -77,7 +77,7 @@ showCompilerId :: Compiler -> String
showCompilerId = showPackageId . compilerId showCompilerId = showPackageId . compilerId
compilerVersion :: Compiler -> Version compilerVersion :: Compiler -> Version
compilerVersion = pkgVersion . compilerId compilerVersion = packageVersion . compilerId
-- ------------------------------------------------------------ -- ------------------------------------------------------------
-- * Package databases -- * Package databases
......
...@@ -58,7 +58,8 @@ import Distribution.Simple.Compiler ...@@ -58,7 +58,8 @@ import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(compilerFlavor), compilerVersion, showCompilerId ( CompilerFlavor(..), Compiler(compilerFlavor), compilerVersion, showCompilerId
, unsupportedExtensions, PackageDB(..) ) , unsupportedExtensions, PackageDB(..) )
import Distribution.Package import Distribution.Package
( PackageIdentifier(..), showPackageId, parsePackageId, Package(..) ) ( PackageIdentifier(PackageIdentifier), packageVersion, Package(..)
, showPackageId, parsePackageId )
import Distribution.InstalledPackageInfo import Distribution.InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo ) ( InstalledPackageInfo, emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
...@@ -478,7 +479,7 @@ configDependency verbosity index dep@(Dependency pkgname vrange) = ...@@ -478,7 +479,7 @@ configDependency verbosity index dep@(Dependency pkgname vrange) =
++ pkgname ++ showVersionRange vrange ++ "\n" ++ pkgname ++ showVersionRange vrange ++ "\n"
++ "Perhaps you need to download and install it from\n" ++ "Perhaps you need to download and install it from\n"
++ hackageUrl ++ pkgname ++ "?" ++ hackageUrl ++ pkgname ++ "?"
pkgs -> do let pkgid = maximumBy (comparing pkgVersion) (map packageId pkgs) pkgs -> do let pkgid = maximumBy (comparing packageVersion) (map packageId pkgs)
info verbosity $ "Dependency " ++ pkgname info verbosity $ "Dependency " ++ pkgname
++ showVersionRange vrange ++ showVersionRange vrange
++ ": using " ++ showPackageId pkgid ++ ": using " ++ showPackageId pkgid
......
...@@ -66,7 +66,7 @@ import Distribution.Simple.LocalBuildInfo ...@@ -66,7 +66,7 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils import Distribution.Simple.Utils
import Distribution.Package import Distribution.Package
( PackageIdentifier(..), showPackageId, Package(..) ) ( PackageIdentifier(PackageIdentifier), showPackageId, Package(..) )
import Distribution.Simple.Program ( rawSystemProgram, rawSystemProgramConf, import Distribution.Simple.Program ( rawSystemProgram, rawSystemProgramConf,
rawSystemProgramStdoutConf, rawSystemProgramStdoutConf,
rawSystemProgramStdout, rawSystemProgramStdout,
......
...@@ -71,7 +71,7 @@ import System.FilePath ( (</>), takeExtension, (<.>), ...@@ -71,7 +71,7 @@ import System.FilePath ( (</>), takeExtension, (<.>),
import Distribution.System import Distribution.System
( OS(..), buildOS ) ( OS(..), buildOS )
import Distribution.Verbosity import Distribution.Verbosity
import Distribution.Package ( PackageIdentifier(..) ) import Distribution.Package ( PackageIdentifier(PackageIdentifier) )
import Data.Char ( isSpace ) import Data.Char ( isSpace )
import Data.Maybe ( mapMaybe, catMaybes ) import Data.Maybe ( mapMaybe, catMaybes )
......
...@@ -74,7 +74,8 @@ import System.FilePath ((</>), isPathSeparator, pathSeparator) ...@@ -74,7 +74,8 @@ import System.FilePath ((</>), isPathSeparator, pathSeparator)
import System.FilePath (dropDrive) import System.FilePath (dropDrive)
#endif #endif
import Distribution.Package (PackageIdentifier(..), showPackageId) import Distribution.Package
( PackageIdentifier, packageName, packageVersion, showPackageId )
import Distribution.Version (showVersion) import Distribution.Version (showVersion)
import Distribution.System import Distribution.System
( OS(..), buildOS ) ( OS(..), buildOS )
...@@ -405,8 +406,8 @@ initialPathTemplateEnv :: PackageIdentifier -> PackageIdentifier ...@@ -405,8 +406,8 @@ initialPathTemplateEnv :: PackageIdentifier -> PackageIdentifier
-> [(PathTemplateVariable, PathTemplate)] -> [(PathTemplateVariable, PathTemplate)]
initialPathTemplateEnv pkgId compilerId = initialPathTemplateEnv pkgId compilerId =
map (\(v,s) -> (v, PathTemplate [Ordinary s])) map (\(v,s) -> (v, PathTemplate [Ordinary s]))
[(PkgNameVar, pkgName pkgId) [(PkgNameVar, packageName pkgId)
,(PkgVerVar, showVersion (pkgVersion pkgId)) ,(PkgVerVar, showVersion (packageVersion pkgId))
,(PkgIdVar, showPackageId pkgId) ,(PkgIdVar, showPackageId pkgId)
,(CompilerVar, showPackageId compilerId)] ,(CompilerVar, showPackageId compilerId)]
......
...@@ -67,8 +67,9 @@ import Distribution.Simple.Program ( ConfiguredProgram(..), jhcProgram, ...@@ -67,8 +67,9 @@ import Distribution.Simple.Program ( ConfiguredProgram(..), jhcProgram,
requireProgram, lookupProgram, requireProgram, lookupProgram,
rawSystemProgram, rawSystemProgramStdoutConf ) rawSystemProgram, rawSystemProgramStdoutConf )
import Distribution.Version ( VersionRange(AnyVersion) ) import Distribution.Version ( VersionRange(AnyVersion) )
import Distribution.Package ( PackageIdentifier(..), showPackageId, import Distribution.Package
parsePackageId, Package(..) ) ( PackageIdentifier(PackageIdentifier), showPackageId, parsePackageId
, Package(..) )
import Distribution.Simple.Utils import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, copyFileVerbose ( createDirectoryIfMissingVerbose, copyFileVerbose
, die, info, intercalate ) , die, info, intercalate )
......
...@@ -59,7 +59,7 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs ...@@ -59,7 +59,7 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.Setup (CopyDest(..)) import Distribution.Simple.Setup (CopyDest(..))
import Distribution.Simple.Program (ProgramConfiguration) import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.PackageDescription (PackageDescription(..)) import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Package (PackageIdentifier(..), Package(..)) import Distribution.Package (PackageIdentifier, Package(..))
import Distribution.Simple.Compiler import Distribution.Simple.Compiler
( Compiler(..), PackageDB, OptimisationLevel ) ( Compiler(..), PackageDB, OptimisationLevel )
import Distribution.Simple.PackageIndex (PackageIndex) import Distribution.Simple.PackageIndex (PackageIndex)
......
...@@ -46,7 +46,7 @@ module Distribution.Simple.NHC ...@@ -46,7 +46,7 @@ module Distribution.Simple.NHC
) where ) where
import Distribution.Package import Distribution.Package
( PackageIdentifier(..), Package(..) ) ( PackageIdentifier(PackageIdentifier), packageName )
import Distribution.PackageDescription import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..), ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..),
withLib, withExe, hcOptions ) withLib, withExe, hcOptions )
...@@ -147,7 +147,7 @@ build pkg_descr lbi verbosity = do ...@@ -147,7 +147,7 @@ build pkg_descr lbi verbosity = do
++ extensionFlags ++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo) ++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr) (library pkg_descr)
++ concat [ ["-package", pkgName pkg] | pkg <- packageDeps lbi ] ++ concat [ ["-package", packageName pkg] | pkg <- packageDeps lbi ]
++ inFiles ++ inFiles
{- {-
-- build any C sources -- build any C sources
...@@ -167,7 +167,7 @@ build pkg_descr lbi verbosity = do ...@@ -167,7 +167,7 @@ build pkg_descr lbi verbosity = do
info verbosity "Linking..." info verbosity "Linking..."
let --cObjs = [ targetDir </> cFile `replaceExtension` objExtension let --cObjs = [ targetDir </> cFile `replaceExtension` objExtension
-- | cFile <- cSources bi ] -- | cFile <- cSources bi ]
libName = mkLibName targetDir (pkgName (packageId pkg_descr)) libName = mkLibName targetDir (packageName pkg_descr)
hObjs = [ targetDir </> dotToSep m <.> objExtension hObjs = [ targetDir </> dotToSep m <.> objExtension
| m <- modules ] | m <- modules ]
...@@ -205,7 +205,7 @@ build pkg_descr lbi verbosity = do ...@@ -205,7 +205,7 @@ build pkg_descr lbi verbosity = do
++ extensionFlags ++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo) ++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr) (library pkg_descr)
++ concat [ ["-package", pkgName pkg] | pkg <- packageDeps lbi ] ++ concat [ ["-package", packageName pkg] | pkg <- packageDeps lbi ]
++ inFiles ++ inFiles
++ [exeName exe] ++ [exeName exe]
...@@ -252,6 +252,6 @@ installLib verbosity pref buildPref pkgid lib ...@@ -252,6 +252,6 @@ installLib verbosity pref buildPref pkgid lib
= do let bi = libBuildInfo lib = do let bi = libBuildInfo lib
modules = exposedModules lib ++ otherModules bi modules = exposedModules lib ++ otherModules bi
smartCopySources verbosity [buildPref] pref modules ["hi"] smartCopySources verbosity [buildPref] pref modules ["hi"]
let name = pkgName pkgid let name = packageName pkgid
libTargetLoc = mkLibName pref name libTargetLoc = mkLibName pref name
copyFileVerbose verbosity (mkLibName buildPref name) libTargetLoc copyFileVerbose verbosity (mkLibName buildPref name) libTargetLoc
...@@ -52,7 +52,8 @@ import Data.Monoid (Monoid(..)) ...@@ -52,7 +52,8 @@ import Data.Monoid (Monoid(..))
import Data.Maybe (isNothing) import Data.Maybe (isNothing)
import Distribution.Package import Distribution.Package
( PackageIdentifier(..), Package(..), PackageFixedDeps(..) ) ( PackageIdentifier, Package(..), packageName, packageVersion
, PackageFixedDeps(..) )
import Distribution.Version (Version, Dependency(Dependency), withinRange) import Distribution.Version (Version, Dependency(Dependency), withinRange)
import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf) import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf)
...@@ -85,7 +86,7 @@ invariant (PackageIndex m) = all (uncurry goodBucket) (Map.toList m) ...@@ -85,7 +86,7 @@ invariant (PackageIndex m) = all (uncurry goodBucket) (Map.toList m)
where goodBucket name pkgs = where goodBucket name pkgs =
lowercase name == name lowercase name == name
&& not (null pkgs) && not (null pkgs)
&& all ((lowercase name==) . lowercase . pkgName . packageId) pkgs && all ((lowercase name==) . lowercase . packageName) pkgs
-- && all (\pkg -> pkgInfoId pkg -- && all (\pkg -> pkgInfoId pkg
-- == (packageId . packageDescription . pkgDesc) pkg) pkgs -- == (packageId . packageDescription . pkgDesc) pkg) pkgs
&& distinct (map packageId pkgs) && distinct (map packageId pkgs)
...@@ -118,7 +119,7 @@ lookup index@(PackageIndex m) name = ...@@ -118,7 +119,7 @@ lookup index@(PackageIndex m) name =
fromList :: Package pkg => [pkg] -> PackageIndex pkg fromList :: Package pkg => [pkg] -> PackageIndex pkg
fromList pkgs = fromList pkgs =
let index = (PackageIndex . Map.map stripDups . Map.fromListWith (++)) let index = (PackageIndex . Map.map stripDups . Map.fromListWith (++))
[ let key = (lowercase . pkgName . packageId) pkg [ let key = (lowercase . packageName) pkg
in (key, [pkg]) in (key, [pkg])
| pkg <- pkgs ] | pkg <- pkgs ]
in assert (invariant index) index in assert (invariant index) index
...@@ -148,8 +149,8 @@ allPackages (PackageIndex m) = concat (Map.elems m) ...@@ -148,8 +149,8 @@ allPackages (PackageIndex m) = concat (Map.elems m)
allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]] allPackagesByName :: Package pkg => PackageIndex pkg -> [[pkg]]
allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m) allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m)
where groupByName :: Package pkg => [pkg] -> [[pkg]] where groupByName :: Package pkg => [pkg] -> [[pkg]]
groupByName = groupBy (equating (pkgName . packageId)) groupByName = groupBy (equating packageName)
. sortBy (comparing (pkgName . packageId)) . sortBy (comparing packageName)
-- | Does a case-insensitive search by package name. -- | Does a case-insensitive search by package name.
-- --
...@@ -165,12 +166,12 @@ allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m) ...@@ -165,12 +166,12 @@ allPackagesByName (PackageIndex m) = concatMap groupByName (Map.elems m)
-- --
searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg] searchByName :: Package pkg => PackageIndex pkg -> String -> SearchResult [pkg]
searchByName index name = searchByName index name =
case groupBy (equating (pkgName . packageId)) case groupBy (equating packageName)
. sortBy (comparing (pkgName . packageId)) . sortBy (comparing packageName)
$ lookup index name of $ lookup index name of
[] -> None [] -> None
[pkgs] -> Unambiguous pkgs [pkgs] -> Unambiguous pkgs
pkgss -> case find ((name==) . pkgName . packageId . head) pkgss of pkgss -> case find ((name==) . packageName . head) pkgss of
Just pkgs -> Unambiguous pkgs Just pkgs -> Unambiguous pkgs
Nothing -> Ambiguous pkgss Nothing -> Ambiguous pkgss
...@@ -195,7 +196,7 @@ searchByNameSubstring (PackageIndex m) searchterm = ...@@ -195,7 +196,7 @@ searchByNameSubstring (PackageIndex m) searchterm =
-- --
lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg
lookupPackageId index pkgid = lookupPackageId index pkgid =
case [ pkg | pkg <- lookup index (pkgName pkgid) case [ pkg | pkg <- lookup index (packageName pkgid)
, packageId pkg == pkgid ] of , packageId pkg == pkgid ] of
[] -> Nothing [] -> Nothing
[pkg] -> Just pkg [pkg] -> Just pkg
...@@ -209,9 +210,8 @@ lookupPackageId index pkgid = ...@@ -209,9 +210,8 @@ lookupPackageId index pkgid =
lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg] lookupDependency :: Package pkg => PackageIndex pkg -> Dependency -> [pkg]
lookupDependency index (Dependency name versionRange) = lookupDependency index (Dependency name versionRange) =
[ pkg | pkg <- lookup index name [ pkg | pkg <- lookup index name
, let pkgid = packageId pkg , packageName pkg == name
, pkgName pkgid == name , packageVersion pkg `withinRange` versionRange ]
, pkgVersion pkgid `withinRange` versionRange ]
-- | All packages that have depends that are not in the index. -- | All packages that have depends that are not in the index.
-- --
...@@ -276,7 +276,7 @@ dependencyInconsistencies index topPkg = ...@@ -276,7 +276,7 @@ dependencyInconsistencies index topPkg =
, not (null inconsistencies) ] , not (null inconsistencies) ]
where inverseIndex = Map.fromListWith (++) where inverseIndex = Map.fromListWith (++)
[ (pkgName dep, [(packageId pkg, pkgVersion dep)]) [ (packageName dep, [(packageId pkg, packageVersion dep)])
| pkg <- topPkg : allPackages index