Permalink
Browse files

The package-db flag can now correctly handles relative paths

  • Loading branch information...
craffit authored and tibbe committed May 4, 2013
1 parent 4edd38c commit 234417c2a603d4d23222048e09cb2caa254ac755
Showing with 26 additions and 4 deletions.
  1. +15 −0 Cabal/Distribution/Simple/Compiler.hs
  2. +7 −2 Cabal/Distribution/Simple/Setup.hs
  3. +4 −2 cabal-install/Main.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
-- ------------------------------------------------------------
@@ -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,
@@ -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'

0 comments on commit 234417c

Please sign in to comment.