Skip to content
This repository

Implement the preliminary sandbox UI #1011

Merged
merged 8 commits into from over 1 year ago

2 participants

Mikhail Glushenkov Johan Tibell
Mikhail Glushenkov
Owner

Adds five new hidden commands:

  • cabal sandbox-configure
  • cabal sandbox-add-source
  • cabal sandbox-build
  • cabal sandbox-install
  • cabal dump-pkgenv

Example usage:

$ git clone git://github.com/haskell/cabal.git
$ cd cabal/cabal-install
$ cabal sandbox-configure -w /path/to/ghc-7.4.1
$ cabal sandbox-add-source ../Cabal
$ cabal sandbox-install --only-dependencies
# Since the previous configure only initialised the sandbox
$ cabal sandbox-configure -w /path/to/ghc-7.4.1
$ cabal sandbox-build

I kept the UI close to the current one, so dependency installation & configuration is still done manually. If a dependency added with sandbox-add-source is updated, it must be manually reinstalled with cabal sandbox-install LibName.

Ideally, one would want to just run cabal sandbox-build --package-root .. and have all dependencies installed and/or updated automatically. In the meantime, we can make a repeated cabal sandbox-install --only-dependencies/cabal sandbox-install unconditionally reinstall all dependencies added with add-source.

Changing the default compiler with -w works as intended (tested with ghc-7.4.2 and ghc-7.4.1).

added some commits August 17, 2012
Mikhail Glushenkov Make 'D.C.PackageEnvironment' compile again.
The compiler didn't complain when I tested on 'package-environment-file' branch
because Main.hs didn't depend on this module.
2ac0244
Mikhail Glushenkov Typos. 30d6773
Mikhail Glushenkov Allow invoking 'hc-pkg init' via D.S.Program.HcPkg. 1cc6878
Mikhail Glushenkov Add an 'initPackageDB' function to D.S.Register.
Creates an empty package DB at the specified location.
3de1049
Mikhail Glushenkov
Owner

One major annoyance of the current UI is that you often have to run cabal sandbox-configure twice (first to initialise the sandbox, and after that to configure the package once the dependencies have been installed). I propose that we make sandbox-configure run sandbox-install --only-dependencies automatically after creating a sandbox.

Johan Tibell
Owner

LGTM

Johan Tibell
Owner

LGTM

Johan Tibell
Owner

LGTM

Johan Tibell
Owner

LGTM

Johan Tibell
Owner

I only took an initial pass over 53ce8ec as it quite large and there are so many configs created all over the place that my eyes glace over. I think I will have to trust that you tested it enough to make sure that it works.

Mikhail Glushenkov
Owner

I only took an initial pass over 53ce8ec as it quite large and there are so many configs created all over the place that my eyes glace over.

Most of it is quite straightforward. The most important changes are concentrated in D.C.Sandbox, and the most interesting function there is sandboxConfigure, which determines the compiler and creates the sandbox.

I can try splitting that commit in several parts, e.g. modifications to Distribution/Client/Setup.hs are relatively independent.

Mikhail Glushenkov
Owner

@tibbe I've split that commit into four parts. Let me know if you want me to split it further.

Johan Tibell
Owner

LGTM

added some commits August 25, 2012
Mikhail Glushenkov Declarative descriptions of the preliminary sandbox UI commands. 11e2cf6
Mikhail Glushenkov Replace a 'notice' with a debug message. c3cb22b
Mikhail Glushenkov Implement the preliminary sandbox UI.
Adds five new hidden commands:

    cabal sandbox-configure
    cabal sandbox-add-source
    cabal sandbox-build
    cabal sandbox-install
    cabal dump-pkgenv
d8fcb94
Johan Tibell tibbe merged commit d8fcb94 into from August 24, 2012
Johan Tibell tibbe closed this August 24, 2012
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 8 unique commits by 1 author.

Aug 17, 2012
Mikhail Glushenkov Make 'D.C.PackageEnvironment' compile again.
The compiler didn't complain when I tested on 'package-environment-file' branch
because Main.hs didn't depend on this module.
2ac0244
Mikhail Glushenkov Typos. 30d6773
Mikhail Glushenkov Allow invoking 'hc-pkg init' via D.S.Program.HcPkg. 1cc6878
Aug 22, 2012
Mikhail Glushenkov Add an 'initPackageDB' function to D.S.Register.
Creates an empty package DB at the specified location.
3de1049
Aug 25, 2012
Mikhail Glushenkov Make 'buildOptions' a top-level function.
Allows it to be reused.
bbee0d3
Mikhail Glushenkov Declarative descriptions of the preliminary sandbox UI commands. 11e2cf6
Mikhail Glushenkov Replace a 'notice' with a debug message. c3cb22b
Mikhail Glushenkov Implement the preliminary sandbox UI.
Adds five new hidden commands:

    cabal sandbox-configure
    cabal sandbox-add-source
    cabal sandbox-build
    cabal sandbox-install
    cabal dump-pkgenv
d8fcb94
This page is out of date. Refresh to see the latest.
8  Cabal/Distribution/Simple/GHC.hs
@@ -65,6 +65,7 @@ module Distribution.Simple.GHC (
65 65
         buildLib, buildExe,
66 66
         installLib, installExe,
67 67
         libAbiHash,
  68
+        initPackageDB,
68 69
         registerPackage,
69 70
         componentGhcOptions,
70 71
         ghcLibDir,
@@ -1105,10 +1106,15 @@ updateLibArchive verbosity lbi path
1105 1106
     rawSystemProgram verbosity ranlib [path]
1106 1107
   | otherwise = return ()
1107 1108
 
1108  
-
1109 1109
 -- -----------------------------------------------------------------------------
1110 1110
 -- Registering
1111 1111
 
  1112
+-- | Create an empty package DB at the specified location.
  1113
+initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO ()
  1114
+initPackageDB verbosity conf dbPath = HcPkg.init verbosity ghcPkgProg dbPath
  1115
+  where
  1116
+    Just ghcPkgProg = lookupProgram ghcPkgProgram conf
  1117
+
1112 1118
 registerPackage
1113 1119
   :: Verbosity
1114 1120
   -> InstalledPackageInfo
20  Cabal/Distribution/Simple/Program/HcPkg.hs
@@ -10,6 +10,7 @@
10 10
 -- Currently only GHC and LHC have hc-pkg programs.
11 11
 
12 12
 module Distribution.Simple.Program.HcPkg (
  13
+    init,
13 14
     register,
14 15
     reregister,
15 16
     unregister,
@@ -18,6 +19,7 @@ module Distribution.Simple.Program.HcPkg (
18 19
     dump,
19 20
 
20 21
     -- * Program invocations
  22
+    initInvocation,
21 23
     registerInvocation,
22 24
     reregisterInvocation,
23 25
     unregisterInvocation,
@@ -26,6 +28,7 @@ module Distribution.Simple.Program.HcPkg (
26 28
     dumpInvocation,
27 29
   ) where
28 30
 
  31
+import Prelude hiding (init)
29 32
 import Distribution.Package
30 33
          ( PackageId, InstalledPackageId(..) )
31 34
 import Distribution.InstalledPackageInfo
@@ -62,6 +65,15 @@ import System.FilePath as FilePath
62 65
 import qualified System.FilePath.Posix as FilePath.Posix
63 66
 
64 67
 
  68
+-- | Call @hc-pkg@ to initialise a package database at the location {path}.
  69
+--
  70
+-- > hc-pkg init {path}
  71
+--
  72
+init :: Verbosity -> ConfiguredProgram -> FilePath -> IO ()
  73
+init verbosity hcPkg path =
  74
+  runProgramInvocation verbosity
  75
+    (initInvocation hcPkg verbosity path)
  76
+
65 77
 -- | Call @hc-pkg@ to register a package.
66 78
 --
67 79
 -- > hc-pkg register {filename | -} [--user | --global | --package-db]
@@ -228,6 +240,14 @@ setInstalledPackageId pkginfo = pkginfo
228 240
 -- The program invocations
229 241
 --
230 242
 
  243
+initInvocation :: ConfiguredProgram
  244
+               -> Verbosity -> FilePath -> ProgramInvocation
  245
+initInvocation hcPkg verbosity path =
  246
+    programInvocation hcPkg args
  247
+  where
  248
+    args = ["init", path]
  249
+        ++ verbosityOpts hcPkg verbosity
  250
+
231 251
 registerInvocation, reregisterInvocation
232 252
   :: ConfiguredProgram -> Verbosity -> PackageDBStack
233 253
   -> Either FilePath InstalledPackageInfo
16  Cabal/Distribution/Simple/Register.hs
@@ -57,6 +57,7 @@ module Distribution.Simple.Register (
57 57
     register,
58 58
     unregister,
59 59
 
  60
+    initPackageDB,
60 61
     registerPackage,
61 62
     generateRegistrationInfo,
62 63
     inplaceInstalledPackageInfo,
@@ -73,11 +74,12 @@ import qualified Distribution.Simple.LHC  as LHC
73 74
 import qualified Distribution.Simple.Hugs as Hugs
74 75
 import qualified Distribution.Simple.UHC  as UHC
75 76
 import Distribution.Simple.Compiler
76  
-         ( compilerVersion, CompilerFlavor(..), compilerFlavor
  77
+         ( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor
77 78
          , PackageDBStack, registrationPackageDB )
78 79
 import Distribution.Simple.Program
79  
-         ( ConfiguredProgram, runProgramInvocation
80  
-         , requireProgram, lookupProgram, ghcPkgProgram, lhcPkgProgram )
  80
+         ( ProgramConfiguration, ConfiguredProgram
  81
+         , runProgramInvocation, requireProgram, lookupProgram
  82
+         , ghcPkgProgram, lhcPkgProgram )
81 83
 import Distribution.Simple.Program.Script
82 84
          ( invocationAsSystemScript )
83 85
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
@@ -204,6 +206,14 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do
204 206
   return installedPkgInfo{ IPI.installedPackageId = ipid }
205 207
 
206 208
 
  209
+-- | Create an empty package DB at the specified location.
  210
+initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath
  211
+                 -> IO ()
  212
+initPackageDB verbosity comp conf dbPath =
  213
+  case (compilerFlavor comp) of
  214
+    GHC -> GHC.initPackageDB verbosity conf dbPath
  215
+    _   -> die "initPackageDB is not implemented for this compiler"
  216
+
207 217
 registerPackage :: Verbosity
208 218
                 -> InstalledPackageInfo
209 219
                 -> PackageDescription
26  Cabal/Distribution/Simple/Setup.hs
@@ -75,7 +75,7 @@ module Distribution.Simple.Setup (
75 75
   BenchmarkFlags(..), emptyBenchmarkFlags, defaultBenchmarkFlags, benchmarkCommand,
76 76
   CopyDest(..),
77 77
   configureArgs, configureOptions, configureCCompiler, configureLinker,
78  
-  installDirsOptions,
  78
+  buildOptions, installDirsOptions,
79 79
 
80 80
   defaultDistPref,
81 81
 
@@ -1225,22 +1225,26 @@ defaultBuildFlags  = BuildFlags {
1225 1225
   }
1226 1226
 
1227 1227
 buildCommand :: ProgramConfiguration -> CommandUI BuildFlags
1228  
-buildCommand progConf = makeCommand name shortDesc longDesc defaultBuildFlags options
  1228
+buildCommand progConf = makeCommand name shortDesc longDesc
  1229
+                        defaultBuildFlags (buildOptions progConf)
1229 1230
   where
1230 1231
     name       = "build"
1231 1232
     shortDesc  = "Make this package ready for installation."
1232 1233
     longDesc   = Nothing
1233  
-    options showOrParseArgs =
1234  
-      optionVerbosity buildVerbosity (\v flags -> flags { buildVerbosity = v })
1235  
-      : optionDistPref
1236  
-          buildDistPref (\d flags -> flags { buildDistPref = d })
1237  
-          showOrParseArgs
1238 1234
 
1239  
-      : programConfigurationPaths   progConf showOrParseArgs
1240  
-          buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
  1235
+buildOptions :: ProgramConfiguration -> ShowOrParseArgs
  1236
+                -> [OptionField BuildFlags]
  1237
+buildOptions progConf showOrParseArgs =
  1238
+  optionVerbosity buildVerbosity (\v flags -> flags { buildVerbosity = v })
  1239
+  : optionDistPref
  1240
+  buildDistPref (\d flags -> flags { buildDistPref = d })
  1241
+  showOrParseArgs
  1242
+
  1243
+  : programConfigurationPaths   progConf showOrParseArgs
  1244
+  buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
1241 1245
 
1242  
-     ++ programConfigurationOptions progConf showOrParseArgs
1243  
-          buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
  1246
+  ++ programConfigurationOptions progConf showOrParseArgs
  1247
+  buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
1244 1248
 
1245 1249
 emptyBuildFlags :: BuildFlags
1246 1250
 emptyBuildFlags = mempty
2  cabal-install/Distribution/Client/Dependency/Modular/PSQ.hs
@@ -5,7 +5,7 @@ module Distribution.Client.Dependency.Modular.PSQ where
5 5
 -- I am not yet sure what exactly is needed. But we need a datastructure with
6 6
 -- key-based lookup that can be sorted. We're using a sequence right now with
7 7
 -- (inefficiently implemented) lookup, because I think that queue-based
8  
--- opertions and sorting turn out to be more efficiency-critical in practice.
  8
+-- operations and sorting turn out to be more efficiency-critical in practice.
9 9
 
10 10
 import Control.Applicative
11 11
 import Data.Foldable
4  cabal-install/Distribution/Client/Index.hs
@@ -29,7 +29,7 @@ import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
29 29
                                  , makeAbsoluteToCwd )
30 30
 
31 31
 import Distribution.Simple.Setup ( fromFlagOrDefault )
32  
-import Distribution.Simple.Utils ( die, debug, notice, warn, findPackageDesc )
  32
+import Distribution.Simple.Utils ( die, debug, notice, findPackageDesc )
33 33
 import Distribution.Verbosity    ( Verbosity )
34 34
 
35 35
 import qualified Data.ByteString.Lazy as BS
@@ -144,7 +144,7 @@ createEmpty :: Verbosity -> FilePath -> IO ()
144 144
 createEmpty verbosity path = do
145 145
   indexExists <- doesFileExist path
146 146
   if indexExists
147  
-    then warn verbosity $ "package index already exists: '" ++ path ++ "'"
  147
+    then debug verbosity $ "Package index already exists: " ++ path
148 148
     else do
149 149
     debug verbosity $ "Creating the index file '" ++ path ++ "'"
150 150
     createDirectoryIfMissing True (takeDirectory path)
165  cabal-install/Distribution/Client/PackageEnvironment.hs
@@ -9,14 +9,17 @@
9 9
 -----------------------------------------------------------------------------
10 10
 
11 11
 module Distribution.Client.PackageEnvironment (
12  
-    PackageEnvironment(..),
13  
-    loadPackageEnvironment,
14  
-    showPackageEnvironment,
15  
-    showPackageEnvironmentWithComments,
16  
-
17  
-    basePackageEnvironment,
18  
-    initialPackageEnvironment,
19  
-    commentPackageEnvironment
  12
+    PackageEnvironment(..)
  13
+  , loadOrCreatePackageEnvironment
  14
+  , tryLoadPackageEnvironment
  15
+  , readPackageEnvironmentFile
  16
+  , showPackageEnvironment
  17
+  , showPackageEnvironmentWithComments
  18
+
  19
+  , basePackageEnvironment
  20
+  , initialPackageEnvironment
  21
+  , commentPackageEnvironment
  22
+  , defaultPackageEnvironmentFileName
20 23
   ) where
21 24
 
22 25
 import Distribution.Client.Config      ( SavedConfig(..), commentSavedConfig,
@@ -26,12 +29,13 @@ import Distribution.Client.Config      ( SavedConfig(..), commentSavedConfig,
26 29
 import Distribution.Client.ParseUtils  ( parseFields, ppFields, ppSection )
27 30
 import Distribution.Client.Setup       ( GlobalFlags(..), ConfigExFlags(..)
28 31
                                        , InstallFlags(..) )
29  
-import Distribution.Simple.Compiler    ( PackageDB(..) )
  32
+import Distribution.Simple.Compiler    ( Compiler, PackageDB(..)
  33
+                                         , showCompilerId )
30 34
 import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate,
31 35
                                          toPathTemplate )
32 36
 import Distribution.Simple.Setup       ( Flag(..), ConfigFlags(..),
33 37
                                          fromFlagOrDefault, toFlag )
34  
-import Distribution.Simple.Utils       ( notice, warn, lowercase )
  38
+import Distribution.Simple.Utils       ( die, notice, warn, lowercase )
35 39
 import Distribution.ParseUtils         ( FieldDescr(..), ParseResult(..),
36 40
                                          commaListField,
37 41
                                          liftField, lineNo, locatedErrorMsg,
@@ -117,8 +121,8 @@ basePackageEnvironment pkgEnvDir = do
117 121
 -- | Initial configuration that we write out to the package environment file if
118 122
 -- it does not exist. When the package environment gets loaded it gets layered
119 123
 -- on top of 'basePackageEnvironment'.
120  
-initialPackageEnvironment :: FilePath -> IO PackageEnvironment
121  
-initialPackageEnvironment pkgEnvDir = do
  124
+initialPackageEnvironment :: FilePath -> Compiler -> IO PackageEnvironment
  125
+initialPackageEnvironment pkgEnvDir compiler = do
122 126
   initialConf' <- initialSavedConfig
123 127
   let baseConf =  commonPackageEnvironmentConfig pkgEnvDir
124 128
   let initialConf = initialConf' `mappend` baseConf
@@ -127,11 +131,8 @@ initialPackageEnvironment pkgEnvDir = do
127 131
        savedGlobalFlags = (savedGlobalFlags initialConf) {
128 132
           globalLocalRepos = [pkgEnvDir </> "packages"]
129 133
           },
130  
-       savedConfigureFlags = (savedConfigureFlags initialConf) {
131  
-         -- TODO: This should include comp. flavor and version
132  
-         configPackageDBs = [Just (SpecificPackageDB $ pkgEnvDir
133  
-                                   </> "packages.conf.d")]
134  
-         },
  134
+       savedConfigureFlags = setPackageDB pkgEnvDir compiler
  135
+                             (savedConfigureFlags initialConf),
135 136
        savedInstallFlags = (savedInstallFlags initialConf) {
136 137
          installSummaryFile = [toPathTemplate (pkgEnvDir </>
137 138
                                                "logs" </> "build.log")]
@@ -139,6 +140,15 @@ initialPackageEnvironment pkgEnvDir = do
139 140
        }
140 141
     }
141 142
 
  143
+-- | Use the package DB location specific for this compiler.
  144
+setPackageDB :: FilePath -> Compiler -> ConfigFlags -> ConfigFlags
  145
+setPackageDB pkgEnvDir compiler configFlags =
  146
+  configFlags {
  147
+    configPackageDBs = [Just (SpecificPackageDB $ pkgEnvDir
  148
+                              </> (showCompilerId compiler ++
  149
+                                   "-packages.conf.d"))]
  150
+    }
  151
+
142 152
 -- | Default values that get used if no value is given. Used here to include in
143 153
 -- comments when we write out the initial package environment.
144 154
 commentPackageEnvironment :: FilePath -> IO PackageEnvironment
@@ -149,43 +159,94 @@ commentPackageEnvironment pkgEnvDir = do
149 159
     pkgEnvSavedConfig = commentConf `mappend` baseConf
150 160
     }
151 161
 
152  
--- | Load the package environment file, creating it if doesn't exist. Note that
153  
--- the path parameter should be a name of an existing directory.
154  
-loadPackageEnvironment :: Verbosity -> FilePath -> IO PackageEnvironment
155  
-loadPackageEnvironment verbosity pkgEnvDir = do
  162
+-- | Given a package environment loaded from a file, layer it on top of the base
  163
+-- package environment.
  164
+addBasePkgEnv :: Verbosity -> FilePath -> PackageEnvironment
  165
+                 -> IO PackageEnvironment
  166
+addBasePkgEnv verbosity pkgEnvDir extra = do
  167
+  let base     = basePackageEnvironment pkgEnvDir
  168
+      baseConf = pkgEnvSavedConfig base
  169
+  -- Does this package environment inherit from some config file?
  170
+  case pkgEnvInherit extra of
  171
+    NoFlag          ->
  172
+      return $ base `mappend` extra
  173
+    (Flag confPath) -> do
  174
+      conf <- loadConfig verbosity (Flag confPath) NoFlag
  175
+      let conf' = baseConf `mappend` conf `mappend` (pkgEnvSavedConfig extra)
  176
+      return $ extra { pkgEnvSavedConfig = conf' }
  177
+
  178
+-- | Try to load a package environment file, exiting with error if it doesn't
  179
+-- exist.
  180
+tryLoadPackageEnvironment :: Verbosity -> FilePath -> IO PackageEnvironment
  181
+tryLoadPackageEnvironment verbosity pkgEnvDir = do
156 182
   let path = pkgEnvDir </> defaultPackageEnvironmentFileName
157  
-  addBasePkgEnv $ do
158  
-    minp <- readPackageEnvironmentFile mempty path
159  
-    case minp of
160  
-      Nothing -> do
161  
-        notice verbosity $ "Writing default package environment to " ++ path
162  
-        commentPkgEnv <- commentPackageEnvironment pkgEnvDir
163  
-        initialPkgEnv <- initialPackageEnvironment pkgEnvDir
164  
-        writePackageEnvironmentFile path commentPkgEnv initialPkgEnv
165  
-        return initialPkgEnv
166  
-      Just (ParseOk warns pkgEnv) -> do
167  
-        when (not $ null warns) $ warn verbosity $
168  
-          unlines (map (showPWarning path) warns)
169  
-        return pkgEnv
170  
-      Just (ParseFailed err) -> do
171  
-        let (line, msg) = locatedErrorMsg err
172  
-        warn verbosity $
173  
-          "Error parsing package environment file " ++ path
174  
-          ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
175  
-        warn verbosity $ "Using default package environment."
176  
-        initialPackageEnvironment pkgEnvDir
  183
+  minp <- readPackageEnvironmentFile mempty path
  184
+  pkgEnv <- case minp of
  185
+    Nothing -> die $
  186
+      "The package environment file '" ++ path ++ "' doesn't exist"
  187
+    Just (ParseOk warns parseResult) -> do
  188
+      when (not $ null warns) $ warn verbosity $
  189
+        unlines (map (showPWarning path) warns)
  190
+      return parseResult
  191
+    Just (ParseFailed err) -> do
  192
+      let (line, msg) = locatedErrorMsg err
  193
+      die $ "Error parsing package environment file " ++ path
  194
+        ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
  195
+  addBasePkgEnv verbosity pkgEnvDir pkgEnv
  196
+
  197
+-- | Load a package environment file, creating one if it doesn't exist. Note
  198
+-- that the path parameter should be a name of an existing directory.
  199
+loadOrCreatePackageEnvironment :: Verbosity -> FilePath
  200
+                                  -> ConfigFlags -> Compiler
  201
+                                  -> IO PackageEnvironment
  202
+loadOrCreatePackageEnvironment verbosity pkgEnvDir configFlags compiler = do
  203
+  let path = pkgEnvDir </> defaultPackageEnvironmentFileName
  204
+  minp <- readPackageEnvironmentFile mempty path
  205
+  pkgEnv <- case minp of
  206
+    Nothing -> do
  207
+      notice verbosity $ "Writing default package environment to " ++ path
  208
+      commentPkgEnv <- commentPackageEnvironment pkgEnvDir
  209
+      initialPkgEnv <- initialPackageEnvironment pkgEnvDir compiler
  210
+      let pkgEnv = updateConfigFlags initialPkgEnv
  211
+                   (\flags -> flags `mappend` configFlags)
  212
+      writePackageEnvironmentFile path commentPkgEnv pkgEnv
  213
+      return initialPkgEnv
  214
+    Just (ParseOk warns parseResult) -> do
  215
+      when (not $ null warns) $ warn verbosity $
  216
+        unlines (map (showPWarning path) warns)
  217
+
  218
+      -- Update the package environment file in case the user has changed some
  219
+      -- settings via the command-line (otherwise 'configure -w compiler-B' will
  220
+      -- fail for a sandbox already configured to use compiler-A).
  221
+      notice verbosity $ "Writing the updated package environment to " ++ path
  222
+      commentPkgEnv <- commentPackageEnvironment pkgEnvDir
  223
+      let pkgEnv = updateConfigFlags parseResult
  224
+                   (\flags ->
  225
+                     setPackageDB pkgEnvDir compiler flags
  226
+                     `mappend` configFlags)
  227
+      writePackageEnvironmentFile path commentPkgEnv pkgEnv
  228
+
  229
+      return pkgEnv
  230
+    Just (ParseFailed err) -> do
  231
+      let (line, msg) = locatedErrorMsg err
  232
+      warn verbosity $
  233
+        "Error parsing package environment file " ++ path
  234
+        ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
  235
+      warn verbosity $ "Using default package environment."
  236
+      initialPackageEnvironment pkgEnvDir compiler
  237
+  addBasePkgEnv verbosity pkgEnvDir pkgEnv
  238
+
177 239
   where
178  
-    addBasePkgEnv :: IO PackageEnvironment -> IO PackageEnvironment
179  
-    addBasePkgEnv body = do
180  
-      let base  = basePackageEnvironment pkgEnvDir
181  
-      extra    <- body
182  
-      case pkgEnvInherit extra of
183  
-        NoFlag          ->
184  
-          return $ base `mappend` extra
185  
-        (Flag confPath) -> do
186  
-          conf <- loadConfig verbosity (Flag confPath) (Flag False)
187  
-          let conf' = base `mappend` conf `mappend` (pkgEnvSavedConfig extra)
188  
-          return $ extra { pkgEnvSavedConfig = conf' }
  240
+    updateConfigFlags :: PackageEnvironment -> (ConfigFlags -> ConfigFlags)
  241
+                         -> PackageEnvironment
  242
+    updateConfigFlags pkgEnv f =
  243
+      let pkgEnvConfig      = pkgEnvSavedConfig pkgEnv
  244
+          pkgEnvConfigFlags = savedConfigureFlags pkgEnvConfig
  245
+      in pkgEnv {
  246
+        pkgEnvSavedConfig = pkgEnvConfig {
  247
+           savedConfigureFlags = f pkgEnvConfigFlags
  248
+           }
  249
+        }
189 250
 
190 251
 -- | Descriptions of all fields in the package environment file.
191 252
 pkgEnvFieldDescrs :: [FieldDescr PackageEnvironment]
215  cabal-install/Distribution/Client/Sandbox.hs
... ...
@@ -0,0 +1,215 @@
  1
+-----------------------------------------------------------------------------
  2
+-- |
  3
+-- Module      :  Distribution.Client.Sandbox
  4
+-- Maintainer  :  cabal-devel@haskell.org
  5
+-- Portability :  portable
  6
+--
  7
+-- UI for the sandboxing functionality.
  8
+-----------------------------------------------------------------------------
  9
+
  10
+module Distribution.Client.Sandbox (
  11
+    dumpPackageEnvironment,
  12
+
  13
+    sandboxAddSource,
  14
+    sandboxConfigure,
  15
+    sandboxBuild,
  16
+    sandboxInstall
  17
+  ) where
  18
+
  19
+import Distribution.Client.Setup
  20
+  ( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), GlobalFlags(..)
  21
+  , InstallFlags(..), globalRepos
  22
+  , defaultInstallFlags, defaultConfigExFlags, defaultSandboxLocation
  23
+  , installCommand )
  24
+import Distribution.Client.Config             ( SavedConfig(..), loadConfig )
  25
+import Distribution.Client.Configure          ( configure )
  26
+import Distribution.Client.Install            ( install )
  27
+import Distribution.Client.PackageEnvironment
  28
+  ( PackageEnvironment(..)
  29
+  , loadOrCreatePackageEnvironment, tryLoadPackageEnvironment
  30
+  , commentPackageEnvironment
  31
+  , showPackageEnvironmentWithComments, readPackageEnvironmentFile
  32
+  , basePackageEnvironment, defaultPackageEnvironmentFileName )
  33
+import Distribution.Client.SetupWrapper
  34
+  ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
  35
+import Distribution.Client.Targets            ( readUserTargets )
  36
+import Distribution.Simple.Compiler           ( Compiler
  37
+                                              , PackageDB(..), PackageDBStack )
  38
+import Distribution.Simple.Configure          ( configCompilerAux
  39
+                                              , interpretPackageDbFlags )
  40
+import Distribution.Simple.Program            ( ProgramConfiguration
  41
+                                              , defaultProgramConfiguration )
  42
+import Distribution.Simple.Setup              ( Flag(..), toFlag
  43
+                                              , BuildFlags(..), HaddockFlags(..)
  44
+                                              , buildCommand, fromFlagOrDefault )
  45
+import Distribution.Simple.Utils              ( die, notice
  46
+                                              , createDirectoryIfMissingVerbose )
  47
+import Distribution.ParseUtils                ( ParseResult(..) )
  48
+import Distribution.Verbosity                 ( Verbosity, lessVerbose )
  49
+import qualified Distribution.Client.Index as Index
  50
+import qualified Distribution.Simple.Register as Register
  51
+import Control.Monad                          ( unless, when )
  52
+import Data.Monoid                            ( mappend, mempty )
  53
+import System.Directory                       ( canonicalizePath
  54
+                                              , doesDirectoryExist
  55
+                                              , doesFileExist )
  56
+import System.FilePath                        ( (</>) )
  57
+
  58
+
  59
+-- | Given a 'SandboxFlags' record, return a canonical path to the
  60
+-- sandbox. Exits with error if the sandbox directory does not exist or is not
  61
+-- properly initialised.
  62
+getSandboxLocation :: Verbosity -> SandboxFlags -> IO FilePath
  63
+getSandboxLocation verbosity sandboxFlags = do
  64
+  let sandboxDir' = fromFlagOrDefault defaultSandboxLocation
  65
+                    (sandboxLocation sandboxFlags)
  66
+  sandboxDir <- canonicalizePath sandboxDir'
  67
+  dirExists  <- doesDirectoryExist sandboxDir
  68
+  pkgEnvExists <- doesFileExist $
  69
+                  sandboxDir </> defaultPackageEnvironmentFileName
  70
+  unless (dirExists && pkgEnvExists) $
  71
+    die ("No sandbox exists at " ++ sandboxDir)
  72
+  notice verbosity $ "Using a sandbox located at " ++ sandboxDir
  73
+  return sandboxDir
  74
+
  75
+-- | Return the name of the package index file for this package environment.
  76
+getIndexFilePath :: PackageEnvironment -> IO FilePath
  77
+getIndexFilePath pkgEnv = do
  78
+  let paths = globalLocalRepos . savedGlobalFlags . pkgEnvSavedConfig $ pkgEnv
  79
+  case paths of
  80
+    []  -> die $ "Distribution.Client.Sandbox.getIndexFilePath: " ++
  81
+           "no local repos found"
  82
+    [p] -> return $ p </> Index.defaultIndexFileName
  83
+    _   -> die $ "Distribution.Client.Sandbox.getIndexFilePath: " ++
  84
+           "too many local repos found"
  85
+
  86
+-- | Entry point for the 'cabal dump-pkgenv' command.
  87
+dumpPackageEnvironment :: Verbosity -> SandboxFlags -> IO ()
  88
+dumpPackageEnvironment verbosity sandboxFlags = do
  89
+  pkgEnvDir <- getSandboxLocation verbosity sandboxFlags
  90
+
  91
+  pkgEnv        <- tryLoadPackageEnvironment verbosity pkgEnvDir
  92
+  commentPkgEnv <- commentPackageEnvironment pkgEnvDir
  93
+  putStrLn . showPackageEnvironmentWithComments commentPkgEnv $ pkgEnv
  94
+
  95
+-- | Entry point for the 'cabal sandbox-configure' command.
  96
+sandboxConfigure :: Verbosity -> SandboxFlags -> ConfigFlags -> ConfigExFlags
  97
+                    -> [String] -> GlobalFlags -> IO ()
  98
+sandboxConfigure verbosity
  99
+  sandboxFlags configFlags configExFlags extraArgs globalFlags = do
  100
+  let sandboxDir' = fromFlagOrDefault defaultSandboxLocation
  101
+                    (sandboxLocation sandboxFlags)
  102
+  createDirectoryIfMissingVerbose verbosity True sandboxDir'
  103
+  sandboxDir   <- canonicalizePath sandboxDir'
  104
+  (comp, conf) <- configCompilerSandbox sandboxDir
  105
+  notice verbosity $ "Using a sandbox located at " ++ sandboxDir
  106
+
  107
+  pkgEnv <- loadOrCreatePackageEnvironment verbosity sandboxDir configFlags comp
  108
+
  109
+  let config         = pkgEnvSavedConfig pkgEnv
  110
+      configFlags'   = savedConfigureFlags   config `mappend` configFlags
  111
+      configExFlags' = savedConfigureExFlags config `mappend` configExFlags
  112
+      globalFlags'   = savedGlobalFlags      config `mappend` globalFlags
  113
+      [Just (SpecificPackageDB dbPath)]
  114
+                     = configPackageDBs configFlags'
  115
+
  116
+  indexFile <- getIndexFilePath pkgEnv
  117
+  Index.createEmpty verbosity indexFile
  118
+  packageDBExists <- doesDirectoryExist dbPath
  119
+  unless packageDBExists $
  120
+    Register.initPackageDB verbosity comp conf dbPath
  121
+  when packageDBExists $
  122
+    notice verbosity $ "The package database already exists: " ++ dbPath
  123
+  configure verbosity
  124
+            (configPackageDB' configFlags') (globalRepos globalFlags')
  125
+            comp conf configFlags' configExFlags' extraArgs
  126
+  where
  127
+    -- We need to know the compiler version so that the correct package DB is
  128
+    -- used. We try to read it from the package environment file, which might
  129
+    -- not exist.
  130
+    configCompilerSandbox :: FilePath -> IO (Compiler, ProgramConfiguration)
  131
+    configCompilerSandbox sandboxDir = do
  132
+      -- Build a ConfigFlags record...
  133
+      let basePkgEnv = basePackageEnvironment sandboxDir
  134
+      userConfig    <- loadConfig verbosity NoFlag NoFlag
  135
+      mPkgEnv       <- readPackageEnvironmentFile mempty
  136
+                       (sandboxDir </> defaultPackageEnvironmentFileName)
  137
+      let pkgEnv     = case mPkgEnv of
  138
+            Just (ParseOk _warns parseResult) -> parseResult
  139
+            _                                 -> mempty
  140
+      let basePkgEnvConfig = pkgEnvSavedConfig basePkgEnv
  141
+          pkgEnvConfig     = pkgEnvSavedConfig pkgEnv
  142
+          configFlags'     = savedConfigureFlags basePkgEnvConfig
  143
+                             `mappend` savedConfigureFlags userConfig
  144
+                             `mappend` savedConfigureFlags pkgEnvConfig
  145
+                             `mappend` configFlags
  146
+      -- ...and pass it to configCompilerAux.
  147
+      configCompilerAux configFlags'
  148
+
  149
+-- | Entry point for the 'cabal sandbox-add-source' command.
  150
+sandboxAddSource :: Verbosity -> SandboxFlags -> [FilePath] -> IO ()
  151
+sandboxAddSource verbosity sandboxFlags buildTreeRefs = do
  152
+  sandboxDir <- getSandboxLocation verbosity sandboxFlags
  153
+  pkgEnv     <- tryLoadPackageEnvironment verbosity sandboxDir
  154
+  indexFile  <- getIndexFilePath pkgEnv
  155
+  Index.addBuildTreeRefs verbosity indexFile buildTreeRefs
  156
+
  157
+-- | Entry point for the 'cabal sandbox-build' command.
  158
+sandboxBuild :: Verbosity -> SandboxFlags -> BuildFlags -> [String] -> IO ()
  159
+sandboxBuild verbosity sandboxFlags buildFlags' extraArgs = do
  160
+  -- Check that the sandbox exists.
  161
+  _ <- getSandboxLocation verbosity sandboxFlags
  162
+
  163
+  let setupScriptOptions = defaultSetupScriptOptions {
  164
+        useDistPref = fromFlagOrDefault
  165
+                      (useDistPref defaultSetupScriptOptions)
  166
+                      (buildDistPref buildFlags)
  167
+        }
  168
+      buildFlags = buildFlags' {
  169
+        buildVerbosity = toFlag verbosity
  170
+        }
  171
+  setupWrapper verbosity setupScriptOptions Nothing
  172
+    (buildCommand defaultProgramConfiguration) (const buildFlags) extraArgs
  173
+
  174
+-- | Entry point for the 'cabal sandbox-install' command.
  175
+sandboxInstall :: Verbosity -> SandboxFlags -> ConfigFlags -> ConfigExFlags
  176
+                  -> InstallFlags -> HaddockFlags -> [String] -> GlobalFlags
  177
+                  -> IO ()
  178
+sandboxInstall verbosity _sandboxFlags _configFlags _configExFlags
  179
+  installFlags _haddockFlags _extraArgs _globalFlags
  180
+  | fromFlagOrDefault False (installOnly installFlags)
  181
+  = setupWrapper verbosity defaultSetupScriptOptions Nothing
  182
+    installCommand (const mempty) []
  183
+
  184
+sandboxInstall verbosity sandboxFlags configFlags configExFlags
  185
+  installFlags haddockFlags extraArgs globalFlags = do
  186
+  sandboxDir <- getSandboxLocation verbosity sandboxFlags
  187
+
  188
+  pkgEnv <- tryLoadPackageEnvironment verbosity sandboxDir
  189
+  targets    <- readUserTargets verbosity extraArgs
  190
+  let config        = pkgEnvSavedConfig pkgEnv
  191
+      configFlags'   = savedConfigureFlags   config `mappend` configFlags
  192
+      configExFlags' = defaultConfigExFlags         `mappend`
  193
+                       savedConfigureExFlags config `mappend` configExFlags
  194
+      installFlags'  = defaultInstallFlags          `mappend`
  195
+                       savedInstallFlags     config `mappend` installFlags
  196
+      globalFlags'   = savedGlobalFlags      config `mappend` globalFlags
  197
+  (comp, conf) <- configCompilerAux' configFlags'
  198
+  install verbosity
  199
+          (configPackageDB' configFlags') (globalRepos globalFlags')
  200
+          comp conf
  201
+          globalFlags' configFlags' configExFlags' installFlags' haddockFlags
  202
+          targets
  203
+
  204
+configPackageDB' :: ConfigFlags -> PackageDBStack
  205
+configPackageDB' cfg =
  206
+  interpretPackageDbFlags userInstall (configPackageDBs cfg)
  207
+  where
  208
+    userInstall = fromFlagOrDefault True (configUserInstall cfg)
  209
+
  210
+configCompilerAux' :: ConfigFlags
  211
+                      -> IO (Compiler, ProgramConfiguration)
  212
+configCompilerAux' configFlags =
  213
+  configCompilerAux configFlags
  214
+    --FIXME: make configCompilerAux use a sensible verbosity
  215
+    { configVerbosity = fmap lessVerbose (configVerbosity configFlags) }
158  cabal-install/Distribution/Client/Setup.hs
@@ -30,6 +30,9 @@ module Distribution.Client.Setup
30 30
     , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
31 31
     , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
32 32
     , indexCommand, IndexFlags(..)
  33
+    , dumpPkgEnvCommand, sandboxConfigureCommand, sandboxAddSourceCommand
  34
+    , sandboxBuildCommand, sandboxInstallCommand, defaultSandboxLocation
  35
+    , SandboxFlags(..)
33 36
 
34 37
     , parsePackageArgs
35 38
     --TODO: stop exporting these:
@@ -52,7 +55,8 @@ import Distribution.Simple.Program
52 55
          ( defaultProgramConfiguration )
53 56
 import Distribution.Simple.Command hiding (boolOpt)
54 57
 import qualified Distribution.Simple.Setup as Cabal
55  
-         ( configureCommand, buildCommand, sdistCommand, haddockCommand )
  58
+         ( configureCommand, buildCommand, sdistCommand, haddockCommand
  59
+         , buildOptions, defaultBuildFlags )
56 60
 import Distribution.Simple.Setup
57 61
          ( ConfigFlags(..), BuildFlags(..), SDistFlags(..), HaddockFlags(..) )
58 62
 import Distribution.Simple.Setup
@@ -699,18 +703,19 @@ installCommand = CommandUI {
699 703
     get3 (_,_,c,_) = c; set3 c (a,b,_,d) = (a,b,c,d)
700 704
     get4 (_,_,_,d) = d; set4 d (a,b,c,_) = (a,b,c,d)
701 705
 
702  
-    haddockOptions showOrParseArgs
703  
-      = [ opt { optionName = "haddock-" ++ name,
704  
-                optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map ("haddock-" ++) lflags)) descr
705  
-                              | descr <- optionDescr opt] }
706  
-        | opt <- commandOptions Cabal.haddockCommand showOrParseArgs
707  
-        , let name = optionName opt
708  
-        , name `elem` ["hoogle", "html", "html-location",
709  
-                       "executables", "internal", "css",
710  
-                       "hyperlink-source", "hscolour-css",
711  
-                       "contents-location"]
712  
-        ]
713  
-
  706
+haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
  707
+haddockOptions showOrParseArgs
  708
+  = [ opt { optionName = "haddock-" ++ name,
  709
+            optionDescr = [ fmapOptFlags (\(_, lflags) -> ([], map ("haddock-" ++) lflags)) descr
  710
+                          | descr <- optionDescr opt] }
  711
+    | opt <- commandOptions Cabal.haddockCommand showOrParseArgs
  712
+    , let name = optionName opt
  713
+    , name `elem` ["hoogle", "html", "html-location",
  714
+                   "executables", "internal", "css",
  715
+                   "hyperlink-source", "hscolour-css",
  716
+                   "contents-location"]
  717
+    ]
  718
+  where
714 719
     fmapOptFlags :: (OptFlags -> OptFlags) -> OptDescr a -> OptDescr a
715 720
     fmapOptFlags modify (ReqArg d f p r w)    = ReqArg d (modify f) p r w
716 721
     fmapOptFlags modify (OptArg d f p r i w)  = OptArg d (modify f) p r i w
@@ -1254,6 +1259,128 @@ instance Monoid IndexFlags where
1254 1259
     where combine field = field a `mappend` field b
1255 1260
 
1256 1261
 -- ------------------------------------------------------------
  1262
+-- * Sandbox-related flags
  1263
+-- ------------------------------------------------------------
  1264
+
  1265
+data SandboxFlags = SandboxFlags {
  1266
+  sandboxVerbosity :: Flag Verbosity,
  1267
+  sandboxLocation  :: Flag FilePath
  1268
+}
  1269
+
  1270
+defaultSandboxLocation :: FilePath
  1271
+defaultSandboxLocation = ".cabal-sandbox"
  1272
+
  1273
+defaultSandboxFlags :: SandboxFlags
  1274
+defaultSandboxFlags = SandboxFlags {
  1275
+  sandboxVerbosity = toFlag normal,
  1276
+  sandboxLocation  = toFlag defaultSandboxLocation
  1277
+  }
  1278
+
  1279
+commonSandboxOptions :: ShowOrParseArgs -> [OptionField SandboxFlags]
  1280
+commonSandboxOptions _showOrParseArgs =
  1281
+  [ optionVerbosity sandboxVerbosity (\v flags -> flags { sandboxVerbosity = v })
  1282
+
  1283
+    , option [] ["sandbox"]
  1284
+      "Sandbox location (default: './.cabal-sandbox')."
  1285
+      sandboxLocation (\v flags -> flags { sandboxLocation = v })
  1286
+      (reqArgFlag "DIR")
  1287
+  ]
  1288
+
  1289
+sandboxConfigureCommand :: CommandUI (SandboxFlags, ConfigFlags, ConfigExFlags)
  1290
+sandboxConfigureCommand = CommandUI {
  1291
+  commandName         = "sandbox-configure",
  1292
+  commandSynopsis     = "Configure a package inside a sandbox",
  1293
+  commandDescription  = Nothing,
  1294
+  commandUsage        = \pname -> usageFlags pname "sandbox-configure",
  1295
+  commandDefaultFlags = (defaultSandboxFlags, mempty, defaultConfigExFlags),
  1296
+  commandOptions      = \showOrParseArgs ->
  1297
+    liftOptions get1 set1 (commonSandboxOptions showOrParseArgs)
  1298
+    ++ liftOptions get2 set2
  1299
+             (filter ((\n -> n /= "constraint" && n /= "verbose") . optionName) $
  1300
+              configureOptions showOrParseArgs)
  1301
+    ++ liftOptions get3 set3 (configureExOptions showOrParseArgs)
  1302
+
  1303
+  }
  1304
+  where
  1305
+    get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c)
  1306
+    get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c)
  1307
+    get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c)
  1308
+
  1309
+sandboxAddSourceCommand :: CommandUI SandboxFlags
  1310
+sandboxAddSourceCommand = CommandUI {
  1311
+  commandName         = "sandbox-add-source",
  1312
+  commandSynopsis     = "Make a source package available in a sandbox",
  1313
+  commandDescription  = Nothing,
  1314
+  commandUsage        = \pname -> usageFlags pname "sandbox-add-source",
  1315
+  commandDefaultFlags = defaultSandboxFlags,
  1316
+  commandOptions      = commonSandboxOptions
  1317
+  }
  1318
+
  1319
+sandboxBuildCommand :: CommandUI (SandboxFlags, BuildFlags)
  1320
+sandboxBuildCommand = CommandUI {
  1321
+  commandName         = "sandbox-build",
  1322
+  commandSynopsis     = "Build a package inside a sandbox",
  1323
+  commandDescription  = Nothing,
  1324
+  commandUsage        = \pname -> usageFlags pname "sandbox-build",
  1325
+  commandDefaultFlags = (defaultSandboxFlags, Cabal.defaultBuildFlags),
  1326
+  commandOptions      = \showOrParseArgs ->
  1327
+    liftOptions fst setFst (commonSandboxOptions showOrParseArgs)
  1328
+    ++ liftOptions snd setSnd (filter ((/= "verbose") . optionName) $
  1329
+                               Cabal.buildOptions progConf showOrParseArgs)
  1330
+  }
  1331
+  where
  1332
+    progConf = defaultProgramConfiguration
  1333
+
  1334
+    setFst a (_,b) = (a,b)
  1335
+    setSnd b (a,_) = (a,b)
  1336
+
  1337
+sandboxInstallCommand :: CommandUI (SandboxFlags, ConfigFlags, ConfigExFlags,
  1338
+                                    InstallFlags, HaddockFlags)
  1339
+sandboxInstallCommand = CommandUI {
  1340
+  commandName         = "sandbox-install",
  1341
+  commandSynopsis     = "Install a list of packages into a sandbox",
  1342
+  commandDescription  = commandDescription installCommand,
  1343
+  commandUsage        = \pname -> usagePackages pname "sandbox-install",
  1344
+  commandDefaultFlags = (defaultSandboxFlags, mempty, mempty, mempty, mempty),
  1345
+  commandOptions      = \showOrParseArgs ->
  1346
+       liftOptions get1 set1 (commonSandboxOptions showOrParseArgs)
  1347
+    ++ liftOptions get2 set2
  1348
+       (filter ((\n -> n /= "constraint" && n /= "verbose") . optionName) $
  1349
+        configureOptions showOrParseArgs)
  1350
+    ++ liftOptions get3 set3 (configureExOptions showOrParseArgs)
  1351
+    ++ liftOptions get4 set4 (installOptions showOrParseArgs)
  1352
+    ++ liftOptions get5 set5 (haddockOptions showOrParseArgs)
  1353
+  }
  1354
+  where
  1355
+    get1 (a,_,_,_,_) = a; set1 a (_,b,c,d,e) = (a,b,c,d,e)
  1356
+    get2 (_,b,_,_,_) = b; set2 b (a,_,c,d,e) = (a,b,c,d,e)
  1357
+    get3 (_,_,c,_,_) = c; set3 c (a,b,_,d,e) = (a,b,c,d,e)
  1358
+    get4 (_,_,_,d,_) = d; set4 d (a,b,c,_,e) = (a,b,c,d,e)
  1359
+    get5 (_,_,_,_,e) = e; set5 e (a,b,c,d,_) = (a,b,c,d,e)
  1360
+
  1361
+dumpPkgEnvCommand :: CommandUI SandboxFlags
  1362
+dumpPkgEnvCommand = CommandUI {
  1363
+  commandName         = "dump-pkgenv",
  1364
+  commandSynopsis     = "Dump a parsed package environment file",
  1365
+  commandDescription  = Nothing,
  1366
+  commandUsage        = \pname -> usageFlags pname "dump-pkgenv",
  1367
+  commandDefaultFlags = defaultSandboxFlags,
  1368
+  commandOptions      = commonSandboxOptions
  1369
+  }
  1370
+
  1371
+instance Monoid SandboxFlags where
  1372
+  mempty = SandboxFlags {
  1373
+    sandboxVerbosity = mempty,
  1374
+    sandboxLocation  = mempty
  1375
+    }
  1376
+  mappend a b = SandboxFlags {
  1377
+    sandboxVerbosity = combine sandboxVerbosity,
  1378
+    sandboxLocation  = combine sandboxLocation
  1379
+    }
  1380
+    where combine field = field a `mappend` field b
  1381
+
  1382
+
  1383
+-- ------------------------------------------------------------
1257 1384
 -- * GetOpt Utils
1258 1385
 -- ------------------------------------------------------------
1259 1386
 
@@ -1317,6 +1444,11 @@ usagePackages name pname =
1317 1444
   ++ "   or: " ++ pname ++ " " ++ name ++ " [PACKAGES]\n\n"
1318 1445
   ++ "Flags for " ++ name ++ ":"
1319 1446
 
  1447
+usageFlags :: String -> String -> String
  1448
+usageFlags name pname =
  1449
+  "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n\n"
  1450
+  ++ "Flags for " ++ name ++ ":"
  1451
+
1320 1452
 --TODO: do we want to allow per-package flags?
1321 1453
 parsePackageArgs :: [String] -> Either String [Dependency]
1322 1454
 parsePackageArgs = parsePkgArgs []
2  cabal-install/Distribution/Client/Tar.hs
@@ -388,7 +388,7 @@ splitLongPath path =
388 388
                                      where n' = n + length c
389 389
     packName' _      _ ok    cs  = (FilePath.Posix.joinPath ok, cs)
390 390
 
391  
--- | The tar format allows just 100 ASCII charcters for the 'SymbolicLink' and
  391
+-- | The tar format allows just 100 ASCII characters for the 'SymbolicLink' and
392 392
 -- 'HardLink' entry types.
393 393
 --
394 394
 newtype LinkTarget = LinkTarget FilePath
78  cabal-install/Main.hs
@@ -31,6 +31,9 @@ import Distribution.Client.Setup
31 31
          , SDistFlags(..), SDistExFlags(..), sdistCommand
32 32
          , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
33 33
          , IndexFlags(..), indexCommand
  34
+         , SandboxFlags(..), sandboxAddSourceCommand
  35
+         , sandboxConfigureCommand, sandboxBuildCommand, sandboxInstallCommand
  36
+         , dumpPkgEnvCommand
34 37
          , reportCommand
35 38
          , unpackCommand, UnpackFlags(..) )
36 39
 import Distribution.Simple.Setup
@@ -50,18 +53,22 @@ import Distribution.Client.Config
50 53
 import Distribution.Client.Targets
51 54
          ( readUserTargets )
52 55
 
53  
-import Distribution.Client.List             (list, info)
54  
-import Distribution.Client.Install          (install, upgrade)
55  
-import Distribution.Client.Configure        (configure)
56  
-import Distribution.Client.Update           (update)
57  
-import Distribution.Client.Fetch            (fetch)
58  
-import Distribution.Client.Check as Check   (check)
  56
+import Distribution.Client.List               (list, info)
  57
+import Distribution.Client.Install            (install, upgrade)
  58
+import Distribution.Client.Configure          (configure)
  59
+import Distribution.Client.Update             (update)
  60
+import Distribution.Client.Fetch              (fetch)
  61
+import Distribution.Client.Check as Check     (check)
59 62
 --import Distribution.Client.Clean            (clean)
60  
-import Distribution.Client.Upload as Upload (upload, check, report)
61  
-import Distribution.Client.SrcDist          (sdist)
62  
-import Distribution.Client.Unpack           (unpack)
63  
-import Distribution.Client.Index            (index)
64  
-import Distribution.Client.Init             (initCabal)
  63
+import Distribution.Client.Upload as Upload   (upload, check, report)
  64
+import Distribution.Client.SrcDist            (sdist)
  65
+import Distribution.Client.Unpack             (unpack)
  66
+import Distribution.Client.Index              (index)
  67
+import Distribution.Client.Sandbox            (sandboxConfigure
  68
+                                              , sandboxAddSource, sandboxBuild
  69
+                                              , sandboxInstall
  70
+                                              , dumpPackageEnvironment)
  71
+import Distribution.Client.Init               (initCabal)
65 72
 import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
66 73
 
67 74
 import Distribution.Simple.Compiler
@@ -159,6 +166,16 @@ mainWorker args = topHandler $
159 166
        win32SelfUpgradeCommand`commandAddAction` win32SelfUpgradeAction
160 167
       ,hiddenCommand $
161 168
        indexCommand `commandAddAction` indexAction
  169
+      ,hiddenCommand $
  170
+       sandboxConfigureCommand `commandAddAction` sandboxConfigureAction
  171
+      ,hiddenCommand $
  172
+       sandboxAddSourceCommand `commandAddAction` sandboxAddSourceAction
  173
+      ,hiddenCommand $
  174
+       sandboxBuildCommand `commandAddAction` sandboxBuildAction
  175
+      ,hiddenCommand $
  176
+       sandboxInstallCommand `commandAddAction` sandboxInstallAction
  177
+      ,hiddenCommand $
  178
+       dumpPkgEnvCommand `commandAddAction` dumpPkgEnvAction
162 179
       ]
163 180
 
164 181
 wrapperAction :: Monoid flags
@@ -557,12 +574,49 @@ initAction initFlags _extraArgs globalFlags = do
557 574
 indexAction :: IndexFlags -> [String] -> GlobalFlags -> IO ()
558 575
 indexAction indexFlags extraArgs _globalFlags = do
559 576
   when (null extraArgs) $ do
560  
-    die $ "the 'index' command expects a single argument. "
  577
+    die $ "the 'index' command expects a single argument."
561 578
   when ((>1). length $ extraArgs) $ do
562 579
     die $ "the 'index' command expects a single argument: " ++ unwords extraArgs
563 580
   let verbosity = fromFlag (indexVerbosity indexFlags)
564 581
   index verbosity indexFlags (head extraArgs)
565 582
 
  583
+sandboxConfigureAction :: (SandboxFlags, ConfigFlags, ConfigExFlags)
  584
+                          -> [String] -> GlobalFlags -> IO ()
  585
+sandboxConfigureAction (sandboxFlags, configFlags, configExFlags)
  586
+  extraArgs globalFlags = do
  587
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  588
+  sandboxConfigure verbosity sandboxFlags configFlags configExFlags
  589
+    extraArgs globalFlags
  590
+
  591
+sandboxAddSourceAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
  592
+sandboxAddSourceAction sandboxFlags extraArgs _globalFlags = do
  593
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  594
+  sandboxAddSource verbosity sandboxFlags extraArgs
  595
+
  596
+sandboxBuildAction :: (SandboxFlags, BuildFlags) -> [String] -> GlobalFlags
  597
+                      -> IO ()
  598
+sandboxBuildAction (sandboxFlags, buildFlags) extraArgs _globalFlags = do
  599
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  600
+  sandboxBuild verbosity sandboxFlags buildFlags extraArgs
  601
+
  602
+sandboxInstallAction :: (SandboxFlags, ConfigFlags, ConfigExFlags,
  603
+                         InstallFlags, HaddockFlags)
  604
+                        -> [String] -> GlobalFlags -> IO ()
  605
+sandboxInstallAction
  606
+  (sandboxFlags, configFlags, configExFlags, installFlags, haddockFlags)
  607
+  extraArgs globalFlags = do
  608
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  609
+  sandboxInstall verbosity sandboxFlags configFlags configExFlags
  610
+    installFlags haddockFlags extraArgs globalFlags
  611
+
  612
+dumpPkgEnvAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
  613
+dumpPkgEnvAction sandboxFlags extraArgs _globalFlags = do
  614
+  when ((>0). length $ extraArgs) $ do
  615
+    die $ "the 'dump-pkgenv' command doesn't expect any arguments: "
  616
+      ++ unwords extraArgs
  617
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)