Rewrite getUpgradableDeps so it's simpler and linear time

Also change so that instead of giving the available package with
the highest version number (where that is higher than the installed
package) it gives us a dependency on a version of the package that
is strictly greater than the one installed. This is more flexible
since when resolving we do not necessarily have to pick the very
latest version if that turns out not to be possible.

Hackage/Dependency.hs

@@ -13,12 +13,11 @@
 module Hackage.Dependency
     (
       resolveDependencies
-    , getUpgradableDeps
+    , upgradableDependencies
     ) where
 
 import Hackage.Dependency.Naive (naiveResolver)
 import Hackage.Dependency.Bogus (bogusResolver)
-import Distribution.InstalledPackageInfo (InstalledPackageInfo_(package))
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.PackageIndex (PackageIndex)
 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
@@ -27,16 +26,18 @@ import Hackage.InstallPlan (InstallPlan)
 import Hackage.Types
          ( UnresolvedDependency(..), AvailablePackage(..) )
 import Distribution.Package
-         ( PackageIdentifier(..), Dependency(..)
-         , Package(..), PackageFixedDeps(..) )
+         ( PackageIdentifier(..), packageVersion, packageName
+         , Dependency(..), Package(..), PackageFixedDeps(..) )
+import Distribution.Version
+         ( VersionRange(LaterVersion) )
 import Distribution.Compiler
          ( CompilerId )
 import Distribution.System
          ( OS, Arch )
 import Distribution.Simple.Utils (comparing)
+import Hackage.Utils (mergeBy, MergeResult(..))
 
 import Data.List (maximumBy)
-import Data.Maybe (catMaybes)
 import Data.Monoid (Monoid(mempty))
 import Control.Exception (assert)
 
@@ -97,48 +98,21 @@ failingResolver :: DependencyResolver a
 failingResolver _ _ _ _ _ deps = Left
   [ dep | UnresolvedDependency dep _ <- deps ]
 
--- |Given the list of installed packages and installable packages, figure
+-- | Given the list of installed packages and available packages, figure
 -- out which packages can be upgraded.
-
-getUpgradableDeps :: PackageIndex InstalledPackageInfo
-                  -> PackageIndex AvailablePackage
-                  -> [AvailablePackage]
-getUpgradableDeps installed available =
-  let latestInstalled = getLatestPackageVersions installed
-      mNeedingUpgrade = map (flip newerAvailable available) latestInstalled
-   in catMaybes mNeedingUpgrade
-
-  where newerAvailable :: PackageIdentifier
-                       -> PackageIndex AvailablePackage -- ^installable packages
-                       -> Maybe AvailablePackage -- ^greatest available
-        newerAvailable pkgToUpdate index
-            = foldl (newerThan pkgToUpdate) Nothing (PackageIndex.allPackages index)
-        newerThan :: PackageIdentifier 
-                  -> Maybe AvailablePackage
-                  -> AvailablePackage
-                  -> Maybe AvailablePackage
-        newerThan pkgToUpdate mFound testPkg
-            = case (pkgName pkgToUpdate == (pkgName $ packageId testPkg), mFound) of
-               (False, _) -> mFound
-               (True, Nothing) -- compare to given package
-                   -> if ((packageId testPkg) `isNewer` pkgToUpdate)
-                      then Just testPkg
-                      else Nothing -- none found so far
-               (True, Just lastNewestPkg) -- compare to latest package
-                   -> if ((packageId testPkg) `isNewer` (packageId lastNewestPkg))
-                      then Just testPkg
-                      else mFound
-
-        -- trim out the old versions of packages with multiple versions installed
-        isNewer :: PackageIdentifier -> PackageIdentifier -> Bool
-        isNewer p1 p2 = pkgVersion p1 > pkgVersion p2
-
-
--- | Given the index of installed packages, get the latest version of each
--- package. That is, if multiple versions of this package are installed, figure
--- out which is the lastest one.
 --
-getLatestPackageVersions :: PackageIndex InstalledPackageInfo -> [PackageIdentifier]
-getLatestPackageVersions index =
-  [ maximumBy (comparing pkgVersion) $ map package pkgs
-  | pkgs <- PackageIndex.allPackagesByName index ]
+upgradableDependencies :: PackageIndex InstalledPackageInfo
+                       -> PackageIndex AvailablePackage
+                       -> [Dependency]
+upgradableDependencies installed available =
+  [ Dependency name (LaterVersion latestVersion)
+    -- This is really quick (linear time). The trick is that we're doing a
+    -- merge join of two tables. We can do it as a merge because they're in
+    -- a comparable order because we're getting them from the package indexs.
+  | InBoth latestInstalled allAvailable
+      <- mergeBy (\a (b:_) -> packageName a `compare` packageName b)
+                 [ maximumBy (comparing packageVersion) pkgs
+                 | pkgs <- PackageIndex.allPackagesByName installed ]
+                 (PackageIndex.allPackagesByName available)
+  , let (PackageIdentifier name latestVersion) = packageId latestInstalled
+  , any (\p -> packageVersion p > latestVersion) allAvailable ]

Hackage/Upgrade.hs

@@ -17,16 +17,14 @@ module Hackage.Upgrade
     ) where
 
 import qualified Hackage.IndexUtils as IndexUtils
-import Hackage.Dependency (getUpgradableDeps)
+import Hackage.Dependency (upgradableDependencies)
 import Hackage.Install (install)
 import Hackage.Types (UnresolvedDependency(..), Repo)
 import Hackage.Setup (InstallFlags(..))
 
 import Distribution.Simple.Program (ProgramConfiguration)
 import Distribution.Simple.Compiler (Compiler, PackageDB)
 import Distribution.Simple.Configure (getInstalledPackages)
-import Distribution.Package (PackageIdentifier(..), Package(..), Dependency(..))
-import Distribution.Version (VersionRange(..))
 import Distribution.Verbosity (Verbosity)
 import qualified Distribution.Simple.Setup as Cabal
 
@@ -42,11 +40,6 @@ upgrade :: Verbosity
 upgrade verbosity packageDB repos comp conf configFlags installFlags = do
   Just installed <- getInstalledPackages verbosity comp packageDB conf
   available <- fmap mconcat (mapM (IndexUtils.readRepoIndex verbosity) repos)      
-  let upgradable = getUpgradableDeps installed available
+  let upgradable = upgradableDependencies installed available
   install verbosity packageDB repos comp conf configFlags installFlags
-              [UnresolvedDependency (identifierToDependency $ packageId x) []
-                                  | x <- upgradable]
-
-identifierToDependency :: PackageIdentifier -> Dependency
-identifierToDependency (PackageIdentifier name version)
-    = Dependency name (ThisVersion version)
+    [ UnresolvedDependency dep [] | dep <- upgradable ]