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 ...@@ -15,6 +15,7 @@ module Hackage.Dependency
resolveDependencies resolveDependencies
, resolveDependenciesLocal , resolveDependenciesLocal
, packagesToInstall , packagesToInstall
, getUpgradableDeps
) where ) where
import Hackage.Config (listInstalledPackages) import Hackage.Config (listInstalledPackages)
...@@ -34,8 +35,8 @@ import Distribution.Simple.Program (ProgramConfiguration) ...@@ -34,8 +35,8 @@ import Distribution.Simple.Program (ProgramConfiguration)
import qualified Distribution.Simple.Setup as Cabal import qualified Distribution.Simple.Setup as Cabal
import Control.Monad (mplus) import Control.Monad (mplus)
import Data.List (nub, nubBy, maximumBy) import Data.List (nub, nubBy, maximumBy, sort)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
import qualified System.Info (arch,os) import qualified System.Info (arch,os)
...@@ -143,3 +144,59 @@ packagesToInstall xs | null missing = Right toInstall ...@@ -143,3 +144,59 @@ packagesToInstall xs | null missing = Right toInstall
flatten (Available _ p opts deps) = concatMap flatten deps ++ [Right (p,opts)] flatten (Available _ p opts deps) = concatMap flatten deps ++ [Right (p,opts)]
flatten (Unavailable dep) = [Left dep] 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 ...@@ -15,6 +15,7 @@ module Hackage.Setup
, installCommand --Cabal.InstallFlags(..) , installCommand --Cabal.InstallFlags(..)
, listCommand , listCommand
, updateCommand , updateCommand
, upgradeCommand
, infoCommand , infoCommand
, fetchCommand , fetchCommand
, uploadCommand, UploadFlags(..) , uploadCommand, UploadFlags(..)
...@@ -128,6 +129,14 @@ updateCommand = CommandUI { ...@@ -128,6 +129,14 @@ updateCommand = CommandUI {
commandOptions = \_ -> [optionVerbose id const] 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 :: CommandUI ()
cleanCommand = makeCommand name shortDesc longDesc emptyFlags options 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) ...@@ -26,6 +26,7 @@ import Hackage.List (list)
import Hackage.Install (install) import Hackage.Install (install)
import Hackage.Info (info) import Hackage.Info (info)
import Hackage.Update (update) import Hackage.Update (update)
import Hackage.Upgrade (upgrade)
import Hackage.Fetch (fetch) import Hackage.Fetch (fetch)
--import Hackage.Clean (clean) --import Hackage.Clean (clean)
import Hackage.Upload (upload) import Hackage.Upload (upload)
...@@ -76,6 +77,7 @@ mainWorker args = ...@@ -76,6 +77,7 @@ mainWorker args =
,infoCommand `commandAddAction` infoAction ,infoCommand `commandAddAction` infoAction
,listCommand `commandAddAction` listAction ,listCommand `commandAddAction` listAction
,updateCommand `commandAddAction` updateAction ,updateCommand `commandAddAction` updateAction
,upgradeCommand `commandAddActionWithEmptyFlags` upgradeAction
,fetchCommand `commandAddAction` fetchAction ,fetchCommand `commandAddAction` fetchAction
,uploadCommand `commandAddAction` uploadAction ,uploadCommand `commandAddAction` uploadAction
...@@ -160,6 +162,14 @@ updateAction flags _extraArgs = do ...@@ -160,6 +162,14 @@ updateAction flags _extraArgs = do
let config = config0 { configVerbose = fromFlagOrDefault normal flags } let config = config0 { configVerbose = fromFlagOrDefault normal flags }
update config 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 :: Flag Verbosity -> [String] -> IO ()
fetchAction flags extraArgs = do fetchAction flags extraArgs = do
configFile <- defaultConfigFile --FIXME configFile <- defaultConfigFile --FIXME
......
...@@ -11,10 +11,12 @@ License-File: LICENSE ...@@ -11,10 +11,12 @@ License-File: LICENSE
Author: Lemmih <lemmih@gmail.com> Author: Lemmih <lemmih@gmail.com>
Paolo Martini <paolo@nemail.it> Paolo Martini <paolo@nemail.it>
Bjorn Bringert <bjorn@bringert.net> Bjorn Bringert <bjorn@bringert.net>
Isaac Potoczny-Jones <ijones@syntaxpolice.org>
Maintainer: cabal-devel@haskell.org Maintainer: cabal-devel@haskell.org
Copyright: 2005 Lemmih <lemmih@gmail.com> Copyright: 2005 Lemmih <lemmih@gmail.com>
2006 Paolo Martini <paolo@nemail.it> 2006 Paolo Martini <paolo@nemail.it>
2007 Bjorn Bringert <bjorn@bringert.net> 2007 Bjorn Bringert <bjorn@bringert.net>
2007 Isaac Potoczny-Jones <ijones@syntaxpolice.org>
Stability: Experimental Stability: Experimental
Category: Distribution Category: Distribution
Build-type: Simple Build-type: Simple
...@@ -43,6 +45,7 @@ Executable cabal ...@@ -43,6 +45,7 @@ Executable cabal
Hackage.Tar Hackage.Tar
Hackage.Types Hackage.Types
Hackage.Update Hackage.Update
Hackage.Upgrade
Hackage.Upload Hackage.Upload
Hackage.Utils 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