Commit 55beae12 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Generalise and rename PkgInfo to include local packages

Renamed to AvailablePackage since that what it is really.
Now instead of just representing packages from a remote hackage repo
it includes an alternative for a local unpacked package. In future
we should add more alternatives, eg for other local packages (ie not
just the one that's unpacked in the current dir) and for remote
packages in source control like darcs, git etc.
parent a290d516
......@@ -35,7 +35,7 @@ import Data.List
import Control.Exception
( assert )
data ResolvedPackage = ResolvedPackage PkgInfo FlagAssignment [PackageIdentifier]
data ResolvedPackage = ResolvedPackage AvailablePackage FlagAssignment [PackageIdentifier]
deriving Show
instance Package ResolvedPackage where
......
......@@ -23,7 +23,7 @@ import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Hackage.DepGraph as DepGraph
import Hackage.Types
( UnresolvedDependency(..), PkgInfo(..) )
( UnresolvedDependency(..), AvailablePackage(..) )
import Distribution.Package (PackageIdentifier(..), Package(..), Dependency(..))
import Distribution.PackageDescription
( PackageDescription(buildDepends), GenericPackageDescription
......@@ -45,7 +45,7 @@ resolveDependencies :: OS
-> Arch
-> CompilerId
-> Maybe (PackageIndex InstalledPackageInfo)
-> PackageIndex PkgInfo
-> PackageIndex AvailablePackage
-> [UnresolvedDependency]
-> Either [Dependency] DepGraph.DepGraph
resolveDependencies os arch comp (Just installed) available deps =
......@@ -57,7 +57,7 @@ resolveDependencies _ _ _ Nothing available deps =
-- | We're using a compiler where we cannot track installed packages so just
-- pretend everything is installed and hope for the best. Yay!
resolveDependenciesBogusly :: PackageIndex PkgInfo
resolveDependenciesBogusly :: PackageIndex AvailablePackage
-> [UnresolvedDependency]
-> [ResolvedDependency]
resolveDependenciesBogusly available = map resolveFromAvailable
......@@ -72,7 +72,7 @@ resolveDependenciesLocal :: OS
-> Arch
-> CompilerId
-> Maybe (PackageIndex InstalledPackageInfo)
-> PackageIndex PkgInfo
-> PackageIndex AvailablePackage
-> GenericPackageDescription
-> FlagAssignment
-> Either [Dependency] DepGraph.DepGraph
......@@ -88,7 +88,7 @@ resolveDependency :: OS
-> Arch
-> CompilerId
-> PackageIndex InstalledPackageInfo -- ^ Installed packages.
-> PackageIndex PkgInfo -- ^ Installable packages
-> PackageIndex AvailablePackage -- ^ Installable packages
-> Dependency
-> FlagAssignment
-> ResolvedDependency
......@@ -98,7 +98,7 @@ resolveDependency os arch comp installed available dep flags
resolveFromInstalled = fmap (InstalledDependency dep) $ latestInstalledSatisfying installed dep
resolveFromAvailable =
do pkg <- latestAvailableSatisfying available dep
let deps = getDependencies os arch comp installed available (pkgDesc pkg) flags
let deps = getDependencies os arch comp installed available (packageDescription pkg) flags
resolved = map (\d -> resolveDependency os arch comp installed available d []) deps
return $ AvailableDependency dep pkg flags resolved
......@@ -110,7 +110,9 @@ latestInstalledSatisfying index dep =
pkgs -> Just (maximumBy (comparing pkgVersion) (map package pkgs))
-- | Gets the latest available package satisfying a dependency.
latestAvailableSatisfying :: PackageIndex PkgInfo -> Dependency -> Maybe PkgInfo
latestAvailableSatisfying :: PackageIndex AvailablePackage
-> Dependency
-> Maybe AvailablePackage
latestAvailableSatisfying index dep =
case PackageIndex.lookupDependency index dep of
[] -> Nothing
......@@ -121,7 +123,7 @@ getDependencies :: OS
-> Arch
-> CompilerId
-> PackageIndex InstalledPackageInfo -- ^ Installed packages.
-> PackageIndex PkgInfo -- ^ Available packages
-> PackageIndex AvailablePackage -- ^ Available packages
-> GenericPackageDescription
-> FlagAssignment
-> [Dependency]
......@@ -169,7 +171,7 @@ packagesToInstall deps0 = case unzipEithers (map getDeps deps0) of
-- TODO: kill this data type
data ResolvedDependency
= InstalledDependency Dependency PackageIdentifier
| AvailableDependency Dependency PkgInfo FlagAssignment [ResolvedDependency]
| AvailableDependency Dependency AvailablePackage FlagAssignment [ResolvedDependency]
| UnavailableDependency Dependency
deriving (Show)
......@@ -177,22 +179,22 @@ data ResolvedDependency
-- out which packages can be upgraded.
getUpgradableDeps :: PackageIndex InstalledPackageInfo
-> PackageIndex PkgInfo
-> [PkgInfo]
-> PackageIndex AvailablePackage
-> [AvailablePackage]
getUpgradableDeps installed available =
let latestInstalled = getLatestPackageVersions installed
mNeedingUpgrade = map (flip newerAvailable available) latestInstalled
in catMaybes mNeedingUpgrade
where newerAvailable :: PackageIdentifier
-> PackageIndex PkgInfo -- ^installable packages
-> Maybe PkgInfo -- ^greatest available
-> PackageIndex AvailablePackage -- ^installable packages
-> Maybe AvailablePackage -- ^greatest available
newerAvailable pkgToUpdate index
= foldl (newerThan pkgToUpdate) Nothing (PackageIndex.allPackages index)
newerThan :: PackageIdentifier
-> Maybe PkgInfo
-> PkgInfo
-> Maybe PkgInfo
-> Maybe AvailablePackage
-> AvailablePackage
-> Maybe AvailablePackage
newerThan pkgToUpdate mFound testPkg
= case (pkgName pkgToUpdate == (pkgName $ packageId testPkg), mFound) of
(False, _) -> mFound
......
......@@ -23,8 +23,9 @@ module Hackage.Fetch
import Network.URI (URI,parseURI,uriScheme,uriPath)
import Network.HTTP (ConnError(..), Response(..))
import Hackage.Types (UnresolvedDependency (..), Repo(..), repoURL,
PkgInfo, packageURL, packageFile, packageDir)
import Hackage.Types
( UnresolvedDependency (..), AvailablePackage(..)
, AvailablePackageSource(..), Repo(..), repoURL )
import Hackage.Dependency (resolveDependencies)
import qualified Hackage.IndexUtils as IndexUtils
import qualified Hackage.DepGraph as DepGraph
......@@ -32,12 +33,13 @@ import Hackage.Utils (showDependencies)
import Hackage.HttpUtils (getHTTP)
import Distribution.Package
( Package(..) )
( PackageIdentifier(..), Package(..) )
import Distribution.Simple.Compiler
( Compiler(compilerId), PackageDB )
import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Simple.Utils (die, notice, debug, setupMessage)
import Distribution.Simple.Utils
( die, notice, debug, setupMessage, intercalate )
import Distribution.System
( buildOS, buildArch )
import Distribution.Text
......@@ -81,7 +83,7 @@ downloadFile verbosity path url
-- Downloads a package to [config-dir/packages/package-id] and returns the path to the package.
downloadPackage :: Verbosity -> PkgInfo -> IO String
downloadPackage :: Verbosity -> AvailablePackage -> IO String
downloadPackage verbosity pkg
= do let url = packageURL pkg
dir = packageDir pkg
......@@ -106,11 +108,11 @@ downloadIndex verbosity repo
Nothing -> return path
-- |Returns @True@ if the package has already been fetched.
isFetched :: PkgInfo -> IO Bool
isFetched :: AvailablePackage -> IO Bool
isFetched pkg = doesFileExist (packageFile pkg)
-- |Fetch a package if we don't have it already.
fetchPackage :: Verbosity -> PkgInfo -> IO String
fetchPackage :: Verbosity -> AvailablePackage -> IO String
fetchPackage verbosity pkg
= do fetched <- isFetched pkg
if fetched
......@@ -140,3 +142,28 @@ fetch verbosity packageDB repos comp conf deps
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
-- |Generate the full path to the locally cached copy of
-- the tarball for a given @PackageIdentifer@.
packageFile :: AvailablePackage -> FilePath
packageFile pkg = packageDir pkg
</> display (packageId pkg)
<.> "tar.gz"
-- |Generate the full path to the directory where the local cached copy of
-- the tarball for a given @PackageIdentifer@ is stored.
packageDir :: AvailablePackage -> FilePath
packageDir AvailablePackage { packageInfoId = p
, packageSource = RepoTarballPackage repo } =
repoCacheDir repo
</> pkgName p
</> display (pkgVersion p)
-- | Generate the URL of the tarball for a given package.
packageURL :: AvailablePackage -> String
packageURL AvailablePackage { packageInfoId = p
, packageSource = RepoTarballPackage repo } =
intercalate "/"
[repoURL repo,
pkgName p, display (pkgVersion p),
display p ++ ".tar.gz"]
......@@ -17,7 +17,9 @@ module Hackage.IndexUtils (
) where
import Hackage.Tar
import Hackage.Types (UnresolvedDependency(..), PkgInfo(..), Repo(..))
import Hackage.Types
( UnresolvedDependency(..), AvailablePackage(..)
, AvailablePackageSource(..), Repo(..) )
import Distribution.Package (PackageIdentifier(..), Package(..), Dependency(Dependency))
import Distribution.Simple.PackageIndex (PackageIndex)
......@@ -39,7 +41,7 @@ import System.IO.Error (isDoesNotExistError)
-- | Read a repository index from disk, from the local file specified by
-- the 'Repo'.
--
readRepoIndex :: Verbosity -> Repo -> IO (PackageIndex PkgInfo)
readRepoIndex :: Verbosity -> Repo -> IO (PackageIndex AvailablePackage)
readRepoIndex verbosity repo =
let indexFile = repoCacheDir repo </> "00-index.tar"
in fmap parseRepoIndex (BS.readFile indexFile)
......@@ -52,9 +54,9 @@ readRepoIndex verbosity repo =
where
-- | Parse a repository index file from a 'ByteString'.
--
-- All the 'PkgInfo's are marked as having come from the given 'Repo'.
-- All the 'AvailablePackage's are marked as having come from the given 'Repo'.
--
parseRepoIndex :: ByteString -> PackageIndex PkgInfo
parseRepoIndex :: ByteString -> PackageIndex AvailablePackage
parseRepoIndex s = PackageIndex.fromList $ do
(hdr, content) <- readTarArchive s
if takeExtension (tarFileName hdr) == ".cabal"
......@@ -67,10 +69,10 @@ readRepoIndex verbosity repo =
_ -> error $ "Couldn't read cabal file "
++ show (tarFileName hdr)
in case simpleParse vers of
Just ver -> return PkgInfo {
pkgInfoId = PackageIdentifier pkgname ver,
pkgRepo = repo,
pkgDesc = descr
Just ver -> return AvailablePackage {
packageInfoId = PackageIdentifier pkgname ver,
packageDescription = descr,
packageSource = RepoTarballPackage repo
}
_ -> []
_ -> []
......@@ -79,7 +81,7 @@ readRepoIndex verbosity repo =
-- | Disambiguate a set of packages using 'disambiguatePackage' and report any
-- ambiguities to the user.
--
disambiguateDependencies :: PackageIndex PkgInfo
disambiguateDependencies :: PackageIndex AvailablePackage
-> [UnresolvedDependency]
-> IO [UnresolvedDependency]
disambiguateDependencies index deps = do
......@@ -103,7 +105,7 @@ disambiguateDependencies index deps = do
-- The only problem is if it matches multiple packages case-insensitively, in
-- that case it is ambigious.
--
disambiguatePackageName :: PackageIndex PkgInfo
disambiguatePackageName :: PackageIndex AvailablePackage
-> String
-> Either String [String]
disambiguatePackageName index name =
......
......@@ -29,8 +29,8 @@ import qualified Hackage.IndexUtils as IndexUtils
import qualified Hackage.DepGraph as DepGraph
import Hackage.Setup (InstallFlags(..))
import Hackage.Tar (extractTarGzFile)
import Hackage.Types
( UnresolvedDependency(..), PkgInfo(..), Repo )
import Hackage.Types as Available
( UnresolvedDependency(..), AvailablePackage(..), Repo )
import Hackage.Utils (showDependencies)
import Hackage.SetupWrapper
( setupWrapper, SetupScriptOptions(..) )
......@@ -48,7 +48,7 @@ import Distribution.Simple.Utils
( defaultPackageDesc, inDir, rawSystemExit, withTempDirectory )
import Distribution.Package
( PackageIdentifier(..), Package(..) )
import Distribution.PackageDescription
import Distribution.PackageDescription as PackageDescription
( GenericPackageDescription(packageDescription), FlagAssignment )
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.InstalledPackageInfo
......@@ -265,7 +265,7 @@ installPkg :: Verbosity
-> SetupScriptOptions
-> InstallMisc
-> Cabal.ConfigFlags -- ^Options which will be parse to every package.
-> PkgInfo
-> AvailablePackage
-> FlagAssignment
-> IO BuildResult
installPkg verbosity scriptOptions miscOptions configFlags pkg flags = do
......@@ -286,7 +286,8 @@ installPkg verbosity scriptOptions miscOptions configFlags pkg flags = do
Cabal.configConfigurationsFlags =
Cabal.configConfigurationsFlags configFlags ++ flags
}
installUnpackedPkg verbosity scriptOptions miscOptions (pkgDesc pkg) configFlags' (Just path)
installUnpackedPkg verbosity scriptOptions miscOptions
(Available.packageDescription pkg) configFlags' (Just path)
installUnpackedPkg :: Verbosity
-> SetupScriptOptions
......@@ -310,7 +311,8 @@ installUnpackedPkg verbosity scriptOptions miscOptions pkg configFlags mpath
buildCommand = Cabal.buildCommand defaultProgramConfiguration
setup cmd flags = inDir mpath $
setupWrapper verbosity scriptOptions
(Just $ packageDescription pkg) cmd flags []
(Just $ PackageDescription.packageDescription pkg)
cmd flags []
reexec cmd = do
-- look for our on executable file and re-exec ourselves using
-- a helper program like sudo to elevate priviledges:
......
......@@ -33,7 +33,7 @@ module Hackage.InstallPlan (
) where
import Hackage.Types
( PkgInfo(pkgDesc) )
( AvailablePackage(packageDescription), UnresolvedDependency )
import Distribution.Package
( PackageIdentifier(..), Package(..), PackageFixedDeps(..) )
import Distribution.InstalledPackageInfo
......@@ -107,7 +107,7 @@ import Control.Exception
-- final configure process will be independent of the environment.
--
data ConfiguredPackage = ConfiguredPackage
PkgInfo -- ^ package info, including repo
AvailablePackage -- ^ package info, including repo
FlagAssignment -- ^ complete flag assignment for the package
[PackageIdentifier] -- ^ exact dependencies, must be consistent with the
-- version constraints in the package info
......@@ -197,8 +197,8 @@ consistent index =
validConfiguredPackage :: OS -> Arch -> CompilerId -> ConfiguredPackage -> Bool
validConfiguredPackage os arch comp (ConfiguredPackage pkginfo flags deps) =
flagsTotal (pkgDesc pkginfo)
&& depsValid (pkgDesc pkginfo)
flagsTotal (packageDescription pkginfo)
&& depsValid (packageDescription pkginfo)
where
flagsTotal :: GenericPackageDescription -> Bool
......
......@@ -35,7 +35,7 @@ import Distribution.Verbosity (Verbosity)
import qualified Hackage.IndexUtils as IndexUtils (readRepoIndex)
import Hackage.Setup (ListFlags(..))
import Hackage.Types (PkgInfo(..), Repo)
import Hackage.Types (AvailablePackage(..), Repo)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Simple.Compiler (Compiler,PackageDB)
import Distribution.Simple.Program (ProgramConfiguration)
......@@ -131,7 +131,7 @@ showPackageInfo pkg =
-- package name.
--
mergePackageInfo :: [InstalledPackageInfo]
-> [PkgInfo]
-> [AvailablePackage]
-> PackageDisplayInfo
mergePackageInfo installed available =
assert (length installed + length available > 0) $
......@@ -153,7 +153,7 @@ mergePackageInfo installed available =
combine f x g y = fromJust (fmap f x `mplus` fmap g y)
latestInstalled = latestOf installed
latestAvailable = latestOf available
latestAvailableDesc = fmap (Available.packageDescription . pkgDesc)
latestAvailableDesc = fmap (Available.packageDescription . packageDescription)
latestAvailable
latestOf :: Package pkg => [pkg] -> Maybe pkg
latestOf = listToMaybe . sortBy (comparing (pkgVersion . packageId))
......@@ -162,8 +162,8 @@ mergePackageInfo installed available =
-- same package by name. In the result pairs, the lists are guaranteed to not
-- both be empty.
--
mergePackages :: [InstalledPackageInfo] -> [PkgInfo]
-> [([InstalledPackageInfo], [PkgInfo])]
mergePackages :: [InstalledPackageInfo] -> [AvailablePackage]
-> [([InstalledPackageInfo], [AvailablePackage])]
mergePackages installed available =
map (\(is, as) -> (maybe [] snd is
,maybe [] snd as))
......
......@@ -16,48 +16,37 @@ import Distribution.Package
( PackageIdentifier(..), Package(..), Dependency )
import Distribution.PackageDescription
( GenericPackageDescription, FlagAssignment )
import Distribution.Text
( display )
import Distribution.Simple.Utils (intercalate)
import System.FilePath ((</>), (<.>))
type Username = String
type Password = String
-- | We re-use @GenericPackageDescription@ and use the @package-url@
-- field to store the tarball URL.
data PkgInfo = PkgInfo {
pkgInfoId :: PackageIdentifier,
pkgRepo :: Repo,
pkgDesc :: GenericPackageDescription
data AvailablePackage = AvailablePackage {
packageInfoId :: PackageIdentifier,
packageDescription :: GenericPackageDescription,
packageSource :: AvailablePackageSource
}
deriving (Show)
deriving Show
instance Package AvailablePackage where packageId = packageInfoId
instance Package PkgInfo where packageId = pkgInfoId
data AvailablePackageSource =
-- |Generate the full path to the locally cached copy of
-- the tarball for a given @PackageIdentifer@.
packageFile :: PkgInfo -> FilePath
packageFile pkg = packageDir pkg
</> display (packageId pkg)
<.> "tar.gz"
-- | The unpacked package in the current dir
LocalUnpackedPackage
-- | A package available as a tarball from a remote repository, with a
-- locally cached copy. ie a package available from hackage
| RepoTarballPackage Repo
-- |Generate the full path to the directory where the local cached copy of
-- the tarball for a given @PackageIdentifer@ is stored.
packageDir :: PkgInfo -> FilePath
packageDir PkgInfo { pkgInfoId = p, pkgRepo = repo } =
repoCacheDir repo
</> pkgName p
</> display (pkgVersion p)
-- | ScmPackage
deriving Show
-- | Generate the URL of the tarball for a given package.
packageURL :: PkgInfo -> String
packageURL pkg = intercalate "/"
[repoURL (pkgRepo pkg),
pkgName p, display (pkgVersion p),
display p ++ ".tar.gz"]
where p = packageId pkg
--TODO:
-- * generalise local package to any local unpacked package, not just in the
-- current dir, ie add a FilePath param
-- * add support for darcs and other SCM style remote repos with a local cache
data RemoteRepo = RemoteRepo {
remoteRepoName :: String,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment