diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 3c03149b7fc42f3eed19f0e1ff949c428dfeace1..98523c353fdadee3b7098b7cbadcdf31e94669a9 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -25,7 +25,7 @@ build-type: Simple
extra-source-files:
README.md tests/README.md changelog
- doc/developing-packages.markdown doc/index.markdown
+ doc/Cabal.css doc/developing-packages.markdown doc/index.markdown
doc/installing-packages.markdown
doc/misc.markdown
@@ -296,6 +296,8 @@ library
other-modules:
Distribution.Compat.CopyFile
+ Distribution.Compat.GetShortPathName
+ Distribution.Compat.MonadFail
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
@@ -310,9 +312,6 @@ library
Distribution.Compat.Binary.Generic
default-language: Haskell98
- -- starting with GHC 7.0, rely on {-# LANGUAGE CPP #-} instead
- if !impl(ghc >= 7.0)
- default-extensions: CPP
-- Small, fast running tests.
test-suite unit-tests
@@ -367,7 +366,7 @@ test-suite package-tests
regex-posix,
old-time
if !os(windows)
- build-depends: unix
+ build-depends: unix, exceptions
ghc-options: -Wall -rtsopts
default-extensions: CPP
default-language: Haskell98
diff --git a/Cabal/Distribution/Compat/GetShortPathName.hs b/Cabal/Distribution/Compat/GetShortPathName.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9a101dda7084fb5978385c307899f6a98651f8a7
--- /dev/null
+++ b/Cabal/Distribution/Compat/GetShortPathName.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Compat.GetShortPathName
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : Windows-only
+--
+-- Win32 API 'GetShortPathName' function.
+
+module Distribution.Compat.GetShortPathName ( getShortPathName )
+ where
+
+#ifdef mingw32_HOST_OS
+import Control.Monad (void)
+
+import qualified System.Win32 as Win32
+import System.Win32 (LPCTSTR, LPTSTR, DWORD)
+import Foreign.Marshal.Array (allocaArray)
+
+#ifdef x86_64_HOST_ARCH
+#define WINAPI ccall
+#else
+#define WINAPI stdcall
+#endif
+
+foreign import WINAPI unsafe "windows.h GetShortPathNameW"
+ c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> IO DWORD
+
+-- | On Windows, retrieves the short path form of the specified path. On
+-- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.
+getShortPathName :: FilePath -> IO FilePath
+getShortPathName path =
+ Win32.withTString path $ \c_path ->
+ allocaArray arr_len $ \c_out -> do
+ void $ Win32.failIfZero "GetShortPathName failed!" $
+ c_GetShortPathName c_path c_out c_len
+ Win32.peekTString c_out
+ where
+ arr_len = length path + 1
+ c_len = fromIntegral arr_len
+
+#else
+
+getShortPathName :: FilePath -> IO FilePath
+getShortPathName path = return path
+
+#endif
diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs
index 4571ef6d686634f9425a46c6cc47f4bbbabdf415..3861972975e255639a578fd3e72e6034b3402d25 100644
--- a/Cabal/Distribution/Simple.hs
+++ b/Cabal/Distribution/Simple.hs
@@ -87,12 +87,13 @@ import Distribution.License
import Distribution.Text
-- Base
-import System.Environment(getArgs, getProgName)
-import System.Directory(removeFile, doesFileExist,
- doesDirectoryExist, removeDirectoryRecursive)
-import System.Exit (exitWith,ExitCode(..))
-import System.FilePath(searchPathSeparator)
-import Distribution.Compat.Environment (getEnvironment)
+import System.Environment (getArgs, getProgName)
+import System.Directory (removeFile, doesFileExist
+ ,doesDirectoryExist, removeDirectoryRecursive)
+import System.Exit (exitWith,ExitCode(..))
+import System.FilePath (searchPathSeparator)
+import Distribution.Compat.Environment (getEnvironment)
+import Distribution.Compat.GetShortPathName (getShortPathName)
import Control.Monad (when)
import Data.Foldable (traverse_)
@@ -612,6 +613,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
env <- getEnvironment
let programConfig = withPrograms lbi
(ccProg, ccFlags) <- configureCCompiler verbosity programConfig
+ ccProgShort <- getShortPathName ccProg
-- The C compiler's compilation and linker flags (e.g.
-- "C compiler flags" and "Gcc Linker flags" from GHC) have already
-- been merged into ccFlags, so we set both CFLAGS and LDFLAGS
@@ -623,7 +625,7 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
spSep = [searchPathSeparator]
pathEnv = maybe (intercalate spSep extraPath) ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
overEnv = ("CFLAGS", Just cflagsEnv) : [("PATH", Just pathEnv) | not (null extraPath)]
- args' = args ++ ["CC=" ++ ccProg]
+ args' = args ++ ["CC=" ++ ccProgShort]
shProg = simpleProgram "sh"
progDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb
shConfiguredProg <- lookupProgram shProg `fmap` configureProgram verbosity shProg progDb
diff --git a/Cabal/tests/PackageTests/GhcPkgGuess/Symlink/ghc b/Cabal/tests/PackageTests/GhcPkgGuess/Symlink/ghc
deleted file mode 120000
index 6533aff70cbf6d083f9800be50013bef88af8cab..0000000000000000000000000000000000000000
--- a/Cabal/tests/PackageTests/GhcPkgGuess/Symlink/ghc
+++ /dev/null
@@ -1 +0,0 @@
-bin/ghc
\ No newline at end of file
diff --git a/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/ghc b/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/ghc
deleted file mode 120000
index c6c92d767566d1afb94bd076e3f85db3cb9d81a2..0000000000000000000000000000000000000000
--- a/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/ghc
+++ /dev/null
@@ -1 +0,0 @@
-bin/ghc-7.10
\ No newline at end of file
diff --git a/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkVersion/ghc b/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkVersion/ghc
deleted file mode 120000
index c6c92d767566d1afb94bd076e3f85db3cb9d81a2..0000000000000000000000000000000000000000
--- a/Cabal/tests/PackageTests/GhcPkgGuess/SymlinkVersion/ghc
+++ /dev/null
@@ -1 +0,0 @@
-bin/ghc-7.10
\ No newline at end of file
diff --git a/Cabal/tests/PackageTests/PackageTester.hs b/Cabal/tests/PackageTests/PackageTester.hs
index ae97edfd072092263f9cb5d693935d17ae2788eb..74c84b247f0d864df301e8bf66460020c838b5aa 100644
--- a/Cabal/tests/PackageTests/PackageTester.hs
+++ b/Cabal/tests/PackageTests/PackageTester.hs
@@ -48,6 +48,7 @@ module PackageTests.PackageTester
, assertOutputDoesNotContain
, assertFindInFile
, concatOutput
+ , withSymlink
-- * Test trees
, TestTreeM
@@ -111,6 +112,12 @@ import System.IO.Error (isDoesNotExistError)
import System.Process (runProcess, waitForProcess, showCommandForUser)
import Test.Tasty (TestTree, askOption, testGroup)
+#ifndef mingw32_HOST_OS
+import Control.Monad.Catch ( bracket_ )
+import System.Directory ( removeFile )
+import System.Posix.Files ( createSymbolicLink )
+#endif
+
-- | Our test monad maintains an environment recording the global test
-- suite configuration 'SuiteConfig', and the local per-test
-- configuration 'TestConfig'.
@@ -624,6 +631,20 @@ assertFindInFile needle path =
concatOutput :: String -> String
concatOutput = unwords . lines . filter ((/=) '\r')
+-- | Create a symlink for the duration of the provided action. If the symlink
+-- already exists, it is deleted. Does not work on Windows.
+withSymlink :: FilePath -> FilePath -> TestM a -> TestM a
+#ifdef mingw32_HOST_OS
+withSymlink _oldpath _newpath _act =
+ error "PackageTests.PackageTester.withSymlink: does not work on Windows!"
+#else
+withSymlink oldpath newpath act = do
+ symlinkExists <- liftIO $ doesFileExist newpath
+ when symlinkExists $ liftIO $ removeFile newpath
+ bracket_ (liftIO $ createSymbolicLink oldpath newpath)
+ (liftIO $ removeFile newpath) act
+#endif
+
------------------------------------------------------------------------
-- * Test trees
diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs
index 91b71bdd0713bbd11cf367d1b45f01272c1e0a1c..106c8e2802b93094a9f9b8dcd12cd6d1e92a83ff 100644
--- a/Cabal/tests/PackageTests/Tests.hs
+++ b/Cabal/tests/PackageTests/Tests.hs
@@ -263,9 +263,21 @@ tests config = do
tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10"
unlessWindows $ do
- tc "GhcPkgGuess/Symlink" $ ghc_pkg_guess "ghc"
- tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc"
- tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc"
+ tc "GhcPkgGuess/Symlink" $ do
+ -- We don't want to distribute a tarball with symlinks. See #3190.
+ withSymlink "bin/ghc"
+ "tests/PackageTests/GhcPkgGuess/Symlink/ghc" $
+ ghc_pkg_guess "ghc"
+
+ tc "GhcPkgGuess/SymlinkVersion" $ do
+ withSymlink "bin/ghc-7.10"
+ "tests/PackageTests/GhcPkgGuess/SymlinkVersion/ghc" $
+ ghc_pkg_guess "ghc"
+
+ tc "GhcPkgGuess/SymlinkGhcVersion" $ do
+ withSymlink "bin/ghc-7.10"
+ "tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/ghc" $
+ ghc_pkg_guess "ghc"
where
ghc_pkg_guess bin_name = do
diff --git a/cabal-install/Distribution/Client/BuildTarget.hs b/cabal-install/Distribution/Client/BuildTarget.hs
index 651790e9c80376d1d8cec5739c56f9977ca2612f..324288c2c5ed7c65f2a4c222258bbd86e46f6c1c 100644
--- a/cabal-install/Distribution/Client/BuildTarget.hs
+++ b/cabal-install/Distribution/Client/BuildTarget.hs
@@ -31,7 +31,6 @@ module Distribution.Client.BuildTarget (
-- * Resolving build targets
resolveBuildTargets,
- getUserTargetFileStatus,
BuildTargetProblem(..),
reportBuildTargetProblems,
) where
@@ -214,6 +213,8 @@ data BuildTarget pkg =
deriving (Eq, Ord, Functor, Show, Generic)
+-- | Get the package that the 'BuildTarget' is referring to.
+--
buildTargetPackage :: BuildTarget pkg -> pkg
buildTargetPackage (BuildTargetPackage p) = p
buildTargetPackage (BuildTargetComponent p _cn) = p
@@ -221,6 +222,10 @@ buildTargetPackage (BuildTargetModule p _cn _mn) = p
buildTargetPackage (BuildTargetFile p _cn _fn) = p
+-- | Get the 'ComponentName' that the 'BuildTarget' is referring to, if any.
+-- The 'BuildTargetPackage' target kind doesn't refer to any individual
+-- component, while the component, module and file kinds do.
+--
buildTargetComponentName :: BuildTarget pkg -> Maybe ComponentName
buildTargetComponentName (BuildTargetPackage _p) = Nothing
buildTargetComponentName (BuildTargetComponent _p cn) = Just cn
@@ -232,6 +237,10 @@ buildTargetComponentName (BuildTargetFile _p cn _fn) = Just cn
-- * Top level, do everything
-- ------------------------------------------------------------
+
+-- | Parse a bunch of command line args as user build targets, failing with an
+-- error if any targets are unrecognised.
+--
readUserBuildTargets :: [String] -> IO [UserBuildTarget]
readUserBuildTargets targetStrs = do
let (uproblems, utargets) = parseUserBuildTargets targetStrs
@@ -239,6 +248,14 @@ readUserBuildTargets targetStrs = do
return utargets
+-- | A 'UserBuildTarget's is just a semi-structured string. We sill have quite
+-- a bit of work to do to figure out which targets they refer to (ie packages,
+-- components, file locations etc).
+--
+-- The possible targets are based on the available packages (and their
+-- locations). It fails with an error if any user string cannot be matched to
+-- a valid target.
+--
resolveUserBuildTargets :: [(PackageDescription, PackageLocation a)]
-> [UserBuildTarget] -> IO [BuildTarget PackageName]
resolveUserBuildTargets pkgs utargets = do
@@ -319,12 +336,15 @@ forgetFileStatus t = case t of
-- * Parsing user targets
-- ------------------------------------------------------------
+
+-- | Parse a bunch of 'UserBuildTarget's (purely without throwing exceptions).
+--
parseUserBuildTargets :: [String] -> ([UserBuildTargetProblem]
- ,[UserBuildTarget])
+ ,[UserBuildTarget])
parseUserBuildTargets = partitionEithers . map parseUserBuildTarget
parseUserBuildTarget :: String -> Either UserBuildTargetProblem
- UserBuildTarget
+ UserBuildTarget
parseUserBuildTarget targetstr =
case readPToMaybe parseTargetApprox targetstr of
Nothing -> Left (UserBuildTargetUnrecognised targetstr)
@@ -363,10 +383,13 @@ parseUserBuildTarget targetstr =
readPToMaybe p str = listToMaybe [ r | (r,s) <- Parse.readP_to_S p str
, all isSpace s ]
+-- | Syntax error when trying to parse a 'UserBuildTarget'.
data UserBuildTargetProblem
= UserBuildTargetUnrecognised String
deriving Show
+-- | Throw an exception with a formatted message if there are any problems.
+--
reportUserBuildTargetProblems :: [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems problems = do
case [ target | UserBuildTargetUnrecognised target <- problems ] of
@@ -394,6 +417,10 @@ reportUserBuildTargetProblems problems = do
++ " - build tests:Data.Foo -- module qualified by component\n"
++ " - build lib:foo -- component qualified by kind"
+
+-- | Render a 'UserBuildTarget' back as the external syntax. This is mainly for
+-- error messages.
+--
showUserBuildTarget :: UserBuildTarget -> String
showUserBuildTarget = intercalate ":" . components
where
@@ -465,6 +492,9 @@ resolveBuildTarget ppinfo opinfo userTarget =
innerErr c m = (c,m)
+-- | The various ways that trying to resolve a 'UserBuildTarget' to a
+-- 'BuildTarget' can fail.
+--
data BuildTargetProblem
= BuildTargetExpected UserBuildTarget [String] String
-- ^ [expected thing] (actually got)
@@ -616,6 +646,8 @@ renderBuildTarget ql t =
| PackageInfo { pinfoPackageFile = Just (fabs,frel) } <- [p] ]
+-- | Throw an exception with a formatted message if there are any problems.
+--
reportBuildTargetProblems :: [BuildTargetProblem] -> IO ()
reportBuildTargetProblems problems = do
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 530698e24e609f4d83ffa918c3fd1fe810ea5bdd..6864adb9bab870518ebebc479b109fa3e91f1aa9 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -164,7 +164,7 @@ import Distribution.Version
import qualified Paths_cabal_install (version)
import System.Environment (getArgs, getProgName)
-import System.Exit (exitFailure)
+import System.Exit (exitFailure, exitSuccess)
import System.FilePath ( dropExtension, splitExtension
, takeExtension, (</>), (<.>))
import System.IO ( BufferMode(LineBuffering), hSetBuffering
@@ -803,7 +803,7 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do
testFlags' = testFlags { testDistPref = toFlag distPref }
-- The package was just configured, so the LBI must be available.
- names <- componentNamesFromLBI distPref "test suites"
+ names <- componentNamesFromLBI verbosity distPref "test suites"
(\c -> case c of { LBI.CTest{} -> True; _ -> False })
let extraArgs'
| null extraArgs = case names of
@@ -822,9 +822,10 @@ data ComponentNames = ComponentNamesUnknown
| ComponentNames [LBI.ComponentName]
-- | Return the names of all buildable components matching a given predicate.
-componentNamesFromLBI :: FilePath -> String -> (LBI.Component -> Bool)
+componentNamesFromLBI :: Verbosity -> FilePath -> String
+ -> (LBI.Component -> Bool)
-> IO ComponentNames
-componentNamesFromLBI distPref targetsDescr compPred = do
+componentNamesFromLBI verbosity distPref targetsDescr compPred = do
eLBI <- tryGetPersistBuildConfig distPref
case eLBI of
Left err -> case err of
@@ -840,7 +841,10 @@ componentNamesFromLBI distPref targetsDescr compPred = do
. filter compPred $
LBI.pkgComponents pkgDescr
if null names
- then die $ "Package has no buildable " ++ targetsDescr ++ "."
+ then do notice verbosity $ "Package has no buildable "
+ ++ targetsDescr ++ "."
+ exitSuccess -- See #3215.
+
else return $! (ComponentNames names)
benchmarkAction :: (BenchmarkFlags, BuildFlags, BuildExFlags)
@@ -869,7 +873,7 @@ benchmarkAction (benchmarkFlags, buildFlags, buildExFlags)
benchmarkFlags'= benchmarkFlags { benchmarkDistPref = toFlag distPref }
-- The package was just configured, so the LBI must be available.
- names <- componentNamesFromLBI distPref "benchmarks"
+ names <- componentNamesFromLBI verbosity distPref "benchmarks"
(\c -> case c of { LBI.CBench{} -> True; _ -> False; })
let extraArgs'
| null extraArgs = case names of
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 41b508d797dee7313043e823d6577f12d1fc8a81..b5f87e522e21f0f8982d47c6bb8429f4e38ad993 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -103,7 +103,7 @@ source-repository head
subdir: cabal-install
Flag old-bytestring
- description: Use bytestring == 0.9.* and bytestring-builder
+ description: Use bytestring < 0.10.2 and bytestring-builder
default: False
Flag old-directory
@@ -253,7 +253,7 @@ executable cabal
hackage-security >= 0.5 && < 0.6
if flag(old-bytestring)
- build-depends: bytestring < 0.10.2, bytestring-builder
+ build-depends: bytestring < 0.10.2, bytestring-builder >= 0.10 && < 1
else
build-depends: bytestring >= 0.10.2
diff --git a/cabal-install/changelog b/cabal-install/changelog
index 31b461806ab7cdf450d7bff5a65694856b2146af..f7ab189c3ab2ad8fb3ef390fd05f6f719718ff85 100644
--- a/cabal-install/changelog
+++ b/cabal-install/changelog
@@ -56,6 +56,8 @@
* Fixed space leaks in modular solver (#2916, #2914).
* Added a new command: 'gen-bounds' (#3223). See
http://softwaresimply.blogspot.se/2015/08/cabal-gen-bounds-easy-generation-of.html.
+ * Tech preview of new nix-style isolated project-based builds.
+ Currently provides the commands (new-)build/repl/configure.
1.22.0.0 Johan Tibell <johan.tibell@gmail.com> January 2015
* New command: user-config (#2159).