Commit e4b86e60 authored by ijones's avatar ijones

Added upgrade command

cabal upgrade installs the latest version of any currently installed
package.
parent 1c8139d8
......@@ -15,6 +15,7 @@ module Hackage.Dependency
resolveDependencies
, resolveDependenciesLocal
, packagesToInstall
, getUpgradableDeps
) where
import Hackage.Config (listInstalledPackages)
......@@ -34,8 +35,8 @@ import Distribution.Simple.Program (ProgramConfiguration)
import qualified Distribution.Simple.Setup as Cabal
import Control.Monad (mplus)
import Data.List (nub, nubBy, maximumBy)
import Data.Maybe (fromMaybe)
import Data.List (nub, nubBy, maximumBy, sort)
import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
import qualified System.Info (arch,os)
......@@ -143,3 +144,59 @@ packagesToInstall xs | null missing = Right toInstall
flatten (Available _ p opts deps) = concatMap flatten deps ++ [Right (p,opts)]
flatten (Unavailable dep) = [Left dep]
-- |Given the list of installed packages and installable packages, figure
-- out which packages can be upgraded.
getUpgradableDeps :: ConfigFlags
-> Compiler
-> ProgramConfiguration
-> IO [PkgInfo]
getUpgradableDeps cfg comp conf
= do allInstalled <- listInstalledPackages cfg comp conf
-- we should only consider the latest version of each package:
let latestInstalled = getLatest allInstalled
available <- getKnownPackages cfg
let mNeedingUpgrade = map (\x -> newerAvailable x available)
latestInstalled
return $ catMaybes mNeedingUpgrade
where newerAvailable :: PackageIdentifier
-> [PkgInfo] -- ^installable packages
-> Maybe PkgInfo -- ^greatest available
newerAvailable pkgToUpdate pkgs
= foldl (newerThan pkgToUpdate) Nothing pkgs
newerThan :: PackageIdentifier
-> Maybe PkgInfo
-> PkgInfo
-> Maybe PkgInfo
newerThan pkgToUpdate mFound testPkg
= case (pkgName pkgToUpdate == (pkgName $ pkgInfoId testPkg), mFound) of
(False, _) -> mFound
(True, Nothing) -- compare to given package
-> if ((pkgInfoId testPkg) `isNewer` pkgToUpdate)
then Just testPkg
else Nothing -- none found so far
(True, Just lastNewestPkg) -- compare to latest package
-> if ((pkgInfoId testPkg) `isNewer` (pkgInfoId lastNewestPkg))
then Just testPkg
else mFound
-- trim out the old versions of packages with multiple versions installed
getLatest :: [PackageIdentifier]
-> [PackageIdentifier]
getLatest pkgs = catMaybes [latestPkgVersion (pkgName pkg) pkgs | pkg <- pkgs]
isNewer :: PackageIdentifier -> PackageIdentifier -> Bool
isNewer p1 p2 = pkgVersion p1 > pkgVersion p2
-- |Given a package and the list of installed packages, get the latest
-- version of the given package. That is, if multiple versions of
-- this package are installed, figure out which is the lastest one.
latestPkgVersion :: String -- ^Package name
-> [PackageIdentifier] -- installed packages
-> Maybe PackageIdentifier
latestPkgVersion name pkgs =
let matches = [pkg | pkg <- pkgs, (pkgName pkg == name)] in
listToMaybe $ reverse $ sort matches
......@@ -15,6 +15,7 @@ module Hackage.Setup
, installCommand --Cabal.InstallFlags(..)
, listCommand
, updateCommand
, upgradeCommand
, infoCommand
, fetchCommand
, uploadCommand, UploadFlags(..)
......@@ -128,6 +129,14 @@ updateCommand = CommandUI {
commandOptions = \_ -> [optionVerbose id const]
}
upgradeCommand :: CommandUI Cabal.ConfigFlags
upgradeCommand = (Cabal.configureCommand defaultProgramConfiguration) {
commandName = "upgrade",
commandSynopsis = "Upgrades installed packages to the latest available version",
commandDescription = Nothing,
commandUsage = usagePackages "upgrade"
}
{-
cleanCommand :: CommandUI ()
cleanCommand = makeCommand name shortDesc longDesc emptyFlags options
......
-----------------------------------------------------------------------------
-- |
-- Module : Hackage.Upgrade
-- Copyright : (c) Isaac Potoczny-Jones 2007
-- License : BSD-like
--
-- Maintainer : ijones@syntaxpolice.org
-- Stability : provisional
-- Portability : portable
--
-- High level interface to package upgrade. Gets list of installed packages
-- and if there are any newer versions available, upgrades them.
-----------------------------------------------------------------------------
module Hackage.Upgrade
( upgrade
) where
import Hackage.Dependency (getUpgradableDeps)
import Hackage.Install (install)
import Hackage.Types (ConfigFlags(..), PkgInfo (..), UnresolvedDependency(..))
import Distribution.Simple.Program (ProgramConfiguration)
import Distribution.Simple.Compiler (Compiler)
import Distribution.Package (showPackageId, PackageIdentifier(..))
import Distribution.Version (VersionRange(..), Dependency(..))
import qualified Distribution.Simple.Setup as Cabal
upgrade :: ConfigFlags
-> Compiler
-> ProgramConfiguration
-> Cabal.ConfigFlags
-> IO ()
upgrade config comp conf configFlags = do
upgradable <- getUpgradableDeps config comp conf
putStrLn "Upgrading the following packages: "
mapM_ putStrLn [showPackageId (pkgInfoId x) | x <- upgradable]
install config comp conf configFlags
[UnresolvedDependency (identifierToDependency $ pkgInfoId x) []
| x <- upgradable]
identifierToDependency :: PackageIdentifier -> Dependency
identifierToDependency (PackageIdentifier name version)
= Dependency name (ThisVersion version)
......@@ -26,6 +26,7 @@ import Hackage.List (list)
import Hackage.Install (install)
import Hackage.Info (info)
import Hackage.Update (update)
import Hackage.Upgrade (upgrade)
import Hackage.Fetch (fetch)
--import Hackage.Clean (clean)
import Hackage.Upload (upload)
......@@ -76,6 +77,7 @@ mainWorker args =
,infoCommand `commandAddAction` infoAction
,listCommand `commandAddAction` listAction
,updateCommand `commandAddAction` updateAction
,upgradeCommand `commandAddActionWithEmptyFlags` upgradeAction
,fetchCommand `commandAddAction` fetchAction
,uploadCommand `commandAddAction` uploadAction
......@@ -160,6 +162,14 @@ updateAction flags _extraArgs = do
let config = config0 { configVerbose = fromFlagOrDefault normal flags }
update config
upgradeAction :: Cabal.ConfigFlags -> [String] -> IO ()
upgradeAction flags _extraArgs = do
configFile <- defaultConfigFile --FIXME
config0 <- loadConfig configFile
let config = updateConfig flags config0
(comp, conf) <- findCompiler config
upgrade config comp conf flags
fetchAction :: Flag Verbosity -> [String] -> IO ()
fetchAction flags extraArgs = do
configFile <- defaultConfigFile --FIXME
......
......@@ -11,10 +11,12 @@ License-File: LICENSE
Author: Lemmih <lemmih@gmail.com>
Paolo Martini <paolo@nemail.it>
Bjorn Bringert <bjorn@bringert.net>
Isaac Potoczny-Jones <ijones@syntaxpolice.org>
Maintainer: cabal-devel@haskell.org
Copyright: 2005 Lemmih <lemmih@gmail.com>
2006 Paolo Martini <paolo@nemail.it>
2007 Bjorn Bringert <bjorn@bringert.net>
2007 Isaac Potoczny-Jones <ijones@syntaxpolice.org>
Stability: Experimental
Category: Distribution
Build-type: Simple
......@@ -43,6 +45,7 @@ Executable cabal
Hackage.Tar
Hackage.Types
Hackage.Update
Hackage.Upgrade
Hackage.Upload
Hackage.Utils
......
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