Added upgrade command

cabal upgrade installs the latest version of any currently installed
package.

cabal-install/Hackage/Dependency.hs

@@ -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

cabal-install/Hackage/Setup.hs

@@ -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

cabal-install/Hackage/Upgrade.hs

+-----------------------------------------------------------------------------
+-- |
+-- 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)

cabal-install/Main.hs

@@ -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

cabal-install/cabal-install.cabal

@@ -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