[commit: packages/Cabal] ghc-head: The package-db flag can now correctly handles relative paths (234417c)

[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=234417c2a603d4d23222048e09cb2caa254ac755

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

commit 234417c2a603d4d23222048e09cb2caa254ac755
Author: Bram <bramschuur at gmail.com>
Date:   Sat May 4 10:35:33 2013 +0200

    The package-db flag can now correctly handles relative paths


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

234417c2a603d4d23222048e09cb2caa254ac755
 Cabal/Distribution/Simple/Compiler.hs |   15 +++++++++++++++
 Cabal/Distribution/Simple/Setup.hs    |    9 +++++++--
 cabal-install/Main.hs                 |    6 ++++--
 3 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/Cabal/Distribution/Simple/Compiler.hs b/Cabal/Distribution/Simple/Compiler.hs
index 09a9cf9..ed3e7f5 100644
--- a/Cabal/Distribution/Simple/Compiler.hs
+++ b/Cabal/Distribution/Simple/Compiler.hs
@@ -57,6 +57,8 @@ module Distribution.Simple.Compiler (
         PackageDB(..),
         PackageDBStack,
         registrationPackageDB,
+        absolutePackageDBPaths,
+        absolutePackageDBPath,
 
         -- * Support for optimisation levels
         OptimisationLevel(..),
@@ -75,8 +77,10 @@ import Distribution.Version (Version(..))
 import Distribution.Text (display)
 import Language.Haskell.Extension (Language(Haskell98), Extension)
 
+import Control.Monad (liftM)
 import Data.List (nub)
 import Data.Maybe (catMaybes, isNothing)
+import System.Directory (canonicalizePath)
 
 data Compiler = Compiler {
         compilerId              :: CompilerId,
@@ -135,6 +139,17 @@ registrationPackageDB :: PackageDBStack -> PackageDB
 registrationPackageDB []  = error "internal error: empty package db set"
 registrationPackageDB dbs = last dbs
 
+-- | Make package paths absolute
+
+
+absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack
+absolutePackageDBPaths = mapM absolutePackageDBPath
+
+absolutePackageDBPath :: PackageDB -> IO PackageDB
+absolutePackageDBPath GlobalPackageDB        = return GlobalPackageDB
+absolutePackageDBPath UserPackageDB          = return UserPackageDB
+absolutePackageDBPath (SpecificPackageDB db) = SpecificPackageDB `liftM` canonicalizePath db
+
 -- ------------------------------------------------------------
 -- * Optimisation levels
 -- ------------------------------------------------------------
diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
index d587705..b2ee9fa 100644
--- a/Cabal/Distribution/Simple/Setup.hs
+++ b/Cabal/Distribution/Simple/Setup.hs
@@ -59,7 +59,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
 module Distribution.Simple.Setup (
 
   GlobalFlags(..),   emptyGlobalFlags,   defaultGlobalFlags,   globalCommand,
-  ConfigFlags(..),   emptyConfigFlags,   defaultConfigFlags,   configureCommand,
+  ConfigFlags(..),   emptyConfigFlags,   defaultConfigFlags,   configureCommand, configAbsolutePaths,
   CopyFlags(..),     emptyCopyFlags,     defaultCopyFlags,     copyCommand,
   InstallFlags(..),  emptyInstallFlags,  defaultInstallFlags,  installCommand,
   HaddockFlags(..),  emptyHaddockFlags,  defaultHaddockFlags,  haddockCommand,
@@ -102,7 +102,7 @@ import Distribution.Simple.Command hiding (boolOpt, boolOpt')
 import qualified Distribution.Simple.Command as Command
 import Distribution.Simple.Compiler
          ( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
-         , OptimisationLevel(..), flagToOptimisationLevel )
+         , OptimisationLevel(..), flagToOptimisationLevel, absolutePackageDBPath )
 import Distribution.Simple.Utils
          ( wrapLine, lowercase, intercalate )
 import Distribution.Simple.Program (Program(..), ProgramConfiguration,
@@ -116,6 +116,7 @@ import Distribution.Simple.InstallDirs
            PathTemplate, toPathTemplate, fromPathTemplate )
 import Distribution.Verbosity
 
+import Control.Monad (liftM)
 import Data.List   ( sort )
 import Data.Char   ( isSpace, isAlpha )
 import Data.Monoid ( Monoid(..) )
@@ -306,6 +307,10 @@ data ConfigFlags = ConfigFlags {
   }
   deriving (Read,Show)
 
+configAbsolutePaths :: ConfigFlags -> IO ConfigFlags
+configAbsolutePaths f = (\v -> f { configPackageDBs = v })
+               `liftM` mapM (maybe (return Nothing) (liftM Just . absolutePackageDBPath)) (configPackageDBs f)
+
 defaultConfigFlags :: ProgramConfiguration -> ConfigFlags
 defaultConfigFlags progConf = emptyConfigFlags {
     configPrograms     = progConf,
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 4ba8b0b..6d1a860 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -43,7 +43,9 @@ import Distribution.Simple.Setup
          , CleanFlags(..), cleanCommand
          , TestFlags(..), testCommand
          , BenchmarkFlags(..), benchmarkCommand
-         , Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe, toFlag )
+         , Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe, toFlag
+         , configAbsolutePaths
+         )
 
 import Distribution.Client.SetupWrapper
          ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
@@ -467,7 +469,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
   -- If we're working inside a sandbox and the user has set the -w option, we
   -- may need to create a sandbox-local package DB for this compiler and add a
   -- timestamp record for this compiler to the timestamp file.
-  let configFlags'' = case useSandbox of
+  configFlags'' <- configAbsolutePaths $ case useSandbox of
         NoSandbox               -> configFlags'
         (UseSandbox sandboxDir) -> setPackageDB sandboxDir
                                    comp platform configFlags'