[commit: packages/Cabal] ghc-head: Refuse to create a sandbox if there's already a cabal-dev sandbox. (2240554)

[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=2240554536c376b6584c49e0f5152696c09012d1

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

commit 2240554536c376b6584c49e0f5152696c09012d1
Author: Mikhail Glushenkov <the.dead.shall.rise at gmail.com>
Date:   Tue Apr 30 18:33:28 2013 +0200

    Refuse to create a sandbox if there's already a cabal-dev sandbox.
    
    Also improve a message that gets printed when we find a cabal.config created by
    cabal-dev.


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

2240554536c376b6584c49e0f5152696c09012d1
 cabal-install/Distribution/Client/Sandbox.hs               |   12 +++++++++++-
 .../Distribution/Client/Sandbox/PackageEnvironment.hs      |    8 +++++---
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index 64c514c..57add3f 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -87,12 +87,13 @@ import Distribution.Compat.FilePerms          ( setFileHidden )
 import qualified Distribution.Client.Sandbox.Index as Index
 import qualified Distribution.Simple.Register      as Register
 import Control.Exception                      ( assert, bracket_ )
-import Control.Monad                          ( forM, unless, when )
+import Control.Monad                          ( forM, liftM2, unless, when )
 import Data.IORef                             ( newIORef, writeIORef, readIORef )
 import Data.List                              ( (\\), delete )
 import Data.Monoid                            ( mempty, mappend )
 import System.Directory                       ( createDirectory
                                               , doesDirectoryExist
+                                              , doesFileExist
                                               , getCurrentDirectory
                                               , removeDirectoryRecursive
                                               , removeFile
@@ -193,6 +194,15 @@ dumpPackageEnvironment verbosity _sandboxFlags globalFlags = do
 -- | Entry point for the 'cabal sandbox-init' command.
 sandboxInit :: Verbosity -> SandboxFlags  -> GlobalFlags -> IO ()
 sandboxInit verbosity sandboxFlags globalFlags = do
+  -- Check that there is no 'cabal-dev' directory.
+  isCabalDevSandbox <- liftM2 (&&) (doesDirectoryExist "cabal-dev")
+                       (doesFileExist $ "cabal-dev" </> "cabal.config")
+  when isCabalDevSandbox $
+    die $
+    "You are apparently using a legacy (cabal-dev) sandbox. "
+    ++ "To use native cabal sandboxing, please delete the 'cabal-dev' directory "
+    ++  "and run 'cabal sandbox init'."
+
   -- Create the sandbox directory.
   let sandboxDir' = fromFlagOrDefault defaultSandboxLocation
                     (sandboxLocation sandboxFlags)
diff --git a/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs b/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
index 25fec7a..bd101b2 100644
--- a/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
+++ b/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
@@ -452,9 +452,11 @@ parsePackageEnvironment initial str = do
     parseSection accum (ParseUtils.Section line "install-dirs" name fs)
       | name' == "" = do accum' <- parseFields installDirsFields accum fs
                          return accum'
-      | otherwise   = syntaxError line $
-                      "The install-dirs section should be unnamed. "
-                      ++ "This file was probably generated by cabal-dev."
+      | otherwise   =
+        syntaxError line $
+        "This file was probably generated by cabal-dev. "
+        ++ "To use native cabal sandboxing, please delete '"
+        ++ userPackageEnvironmentFile ++ "' and run 'cabal sandbox init'."
       where name' = lowercase name
     parseSection _accum f =
       syntaxError (lineNo f)  "Unrecognized stanza."