[commit: packages/Cabal] ghc-head: Add a workaround for issue #1463. (bcf8b2d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=bcf8b2d4922e0709bfbe0c676c5e3a686f485989

>---------------------------------------------------------------

commit bcf8b2d4922e0709bfbe0c676c5e3a686f485989
Author: Mikhail Glushenkov <mikhail.glushenkov at gmail.com>
Date:   Wed Sep 4 00:45:36 2013 +0200

    Add a workaround for issue #1463.


>---------------------------------------------------------------

bcf8b2d4922e0709bfbe0c676c5e3a686f485989
 cabal-install/Distribution/Client/SetupWrapper.hs |   20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs
index 94c1699..a5fa7e3 100644
--- a/cabal-install/Distribution/Client/SetupWrapper.hs
+++ b/cabal-install/Distribution/Client/SetupWrapper.hs
@@ -87,7 +87,7 @@ import System.IO         ( Handle, hPutStr )
 import System.Exit       ( ExitCode(..), exitWith )
 import System.Process    ( runProcess, waitForProcess )
 import Control.Monad     ( when, unless )
-import Data.List         ( maximumBy )
+import Data.List         ( foldl1' )
 import Data.Maybe        ( fromMaybe, isJust )
 import Data.Monoid       ( mempty )
 import Data.Char         ( isSpace )
@@ -270,8 +270,24 @@ externalSetupMethod verbosity options pkg bt mkargs = do
       pkgs -> return $ bestVersion id (map fst pkgs)
 
   bestVersion :: (a -> Version) -> [a] -> a
-  bestVersion f = maximumBy (comparing (preference . f))
+  bestVersion f = firstMaximumBy (comparing (preference . f))
     where
+      -- Like maximumBy, but picks the first maximum element instead of the
+      -- last. In general, we expect the preferred version to go first in the
+      -- list. For the default case, this has the effect of choosing the version
+      -- installed in the user package DB instead of the global one. See #1463.
+      --
+      -- Note: firstMaximumBy could be written as just
+      -- `maximumBy cmp . reverse`, but the problem is that the behaviour of
+      -- maximumBy is not fully specified in the case when there is not a single
+      -- greatest element.
+      firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a
+      firstMaximumBy _ []   =
+        error "Distribution.Client.firstMaximumBy: empty list"
+      firstMaximumBy cmp xs =  foldl1' maxBy xs
+        where
+          maxBy x y = case cmp x y of { GT -> x; EQ -> x; LT -> y; }
+
       preference version   = (sameVersion, sameMajorVersion
                              ,stableVersion, latestVersion)
         where