Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add a dummy 'sandbox-init' command.

  • Loading branch information...
commit f2a0ab9b8969a5e1fb128bc68cf164d75047d039 1 parent 6526f94
Mikhail Glushenkov authored September 13, 2012
28  cabal-install/Distribution/Client/Sandbox.hs
@@ -8,12 +8,13 @@
8 8
 -----------------------------------------------------------------------------
9 9
 
10 10
 module Distribution.Client.Sandbox (
11  
-    dumpPackageEnvironment,
12  
-
  11
+    sandboxInit,
13 12
     sandboxAddSource,
14 13
     sandboxConfigure,
15 14
     sandboxBuild,
16  
-    sandboxInstall
  15
+    sandboxInstall,
  16
+
  17
+    dumpPackageEnvironment
17 18
   ) where
18 19
 
19 20
 import Distribution.Client.Setup
@@ -92,6 +93,19 @@ dumpPackageEnvironment verbosity sandboxFlags = do
92 93
   commentPkgEnv <- commentPackageEnvironment pkgEnvDir
93 94
   putStrLn . showPackageEnvironmentWithComments commentPkgEnv $ pkgEnv
94 95
 
  96
+-- | Entry point for the 'cabal sandbox-init' command.
  97
+sandboxInit :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
  98
+sandboxInit _verbosity _sandboxFlags _globalFlags = do
  99
+  die "Not implemented."
  100
+
  101
+-- | Entry point for the 'cabal sandbox-add-source' command.
  102
+sandboxAddSource :: Verbosity -> SandboxFlags -> [FilePath] -> IO ()
  103
+sandboxAddSource verbosity sandboxFlags buildTreeRefs = do
  104
+  sandboxDir <- getSandboxLocation verbosity sandboxFlags
  105
+  pkgEnv     <- tryLoadPackageEnvironment verbosity sandboxDir
  106
+  indexFile  <- tryGetIndexFilePath pkgEnv
  107
+  Index.addBuildTreeRefs verbosity indexFile buildTreeRefs
  108
+
95 109
 -- | Entry point for the 'cabal sandbox-configure' command.
96 110
 sandboxConfigure :: Verbosity -> SandboxFlags -> ConfigFlags -> ConfigExFlags
97 111
                     -> [String] -> GlobalFlags -> IO ()
@@ -146,14 +160,6 @@ sandboxConfigure verbosity
146 160
       -- ...and pass it to configCompilerAux.
147 161
       configCompilerAux configFlags'
148 162
 
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  <- tryGetIndexFilePath pkgEnv
155  
-  Index.addBuildTreeRefs verbosity indexFile buildTreeRefs
156  
-
157 163
 -- | Entry point for the 'cabal sandbox-build' command.
158 164
 sandboxBuild :: Verbosity -> SandboxFlags -> BuildFlags -> [String] -> IO ()
159 165
 sandboxBuild verbosity sandboxFlags buildFlags' extraArgs = do
37  cabal-install/Distribution/Client/Setup.hs
@@ -30,9 +30,10 @@ 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
+    , dumpPkgEnvCommand
  34
+    , sandboxInitCommand, sandboxConfigureCommand, sandboxAddSourceCommand
  35
+    , sandboxBuildCommand, sandboxInstallCommand
  36
+    , SandboxFlags(..), defaultSandboxLocation
36 37
 
37 38
     , parsePackageArgs
38 39
     --TODO: stop exporting these:
@@ -1295,6 +1296,26 @@ commonSandboxOptions _showOrParseArgs =
1295 1296
       (reqArgFlag "DIR")
1296 1297
   ]
1297 1298
 
  1299
+sandboxInitCommand :: CommandUI SandboxFlags
  1300
+sandboxInitCommand = CommandUI {
  1301
+  commandName         = "sandbox-init",
  1302
+  commandSynopsis     = "Initialise a fresh sandbox",
  1303
+  commandDescription  = Nothing,
  1304
+  commandUsage        = \pname -> usageFlags pname "sandbox-init",
  1305
+  commandDefaultFlags = defaultSandboxFlags,
  1306
+  commandOptions      = commonSandboxOptions
  1307
+  }
  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
+
1298 1319
 sandboxConfigureCommand :: CommandUI (SandboxFlags, ConfigFlags, ConfigExFlags)
1299 1320
 sandboxConfigureCommand = CommandUI {
1300 1321
   commandName         = "sandbox-configure",
@@ -1315,16 +1336,6 @@ sandboxConfigureCommand = CommandUI {
1315 1336
     get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c)
1316 1337
     get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c)
1317 1338
 
1318  
-sandboxAddSourceCommand :: CommandUI SandboxFlags
1319  
-sandboxAddSourceCommand = CommandUI {
1320  
-  commandName         = "sandbox-add-source",
1321  
-  commandSynopsis     = "Make a source package available in a sandbox",
1322  
-  commandDescription  = Nothing,
1323  
-  commandUsage        = \pname -> usageFlags pname "sandbox-add-source",
1324  
-  commandDefaultFlags = defaultSandboxFlags,
1325  
-  commandOptions      = commonSandboxOptions
1326  
-  }
1327  
-
1328 1339
 sandboxBuildCommand :: CommandUI (SandboxFlags, BuildFlags)
1329 1340
 sandboxBuildCommand = CommandUI {
1330 1341
   commandName         = "sandbox-build",
30  cabal-install/Main.hs
@@ -31,7 +31,7 @@ import Distribution.Client.Setup
31 31
          , SDistFlags(..), SDistExFlags(..), sdistCommand
32 32
          , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
33 33
          , IndexFlags(..), indexCommand
34  
-         , SandboxFlags(..), sandboxAddSourceCommand
  34
+         , SandboxFlags(..), sandboxInitCommand, sandboxAddSourceCommand
35 35
          , sandboxConfigureCommand, sandboxBuildCommand, sandboxInstallCommand
36 36
          , dumpPkgEnvCommand
37 37
          , reportCommand
@@ -64,8 +64,10 @@ import Distribution.Client.Upload as Upload   (upload, check, report)
64 64
 import Distribution.Client.SrcDist            (sdist)
65 65
 import Distribution.Client.Unpack             (unpack)
66 66
 import Distribution.Client.Index              (index)
67  
-import Distribution.Client.Sandbox            (sandboxConfigure
68  
-                                              , sandboxAddSource, sandboxBuild
  67
+import Distribution.Client.Sandbox            (sandboxInit
  68
+                                              , sandboxAddSource
  69
+                                              , sandboxBuild
  70
+                                              , sandboxConfigure
69 71
                                               , sandboxInstall
70 72
                                               , dumpPackageEnvironment)
71 73
 import Distribution.Client.Init               (initCabal)
@@ -167,10 +169,12 @@ mainWorker args = topHandler $
167 169
       ,hiddenCommand $
168 170
        indexCommand `commandAddAction` indexAction
169 171
       ,hiddenCommand $
170  
-       sandboxConfigureCommand `commandAddAction` sandboxConfigureAction
  172
+       sandboxInitCommand `commandAddAction` sandboxInitAction
171 173
       ,hiddenCommand $
172 174
        sandboxAddSourceCommand `commandAddAction` sandboxAddSourceAction
173 175
       ,hiddenCommand $
  176
+       sandboxConfigureCommand `commandAddAction` sandboxConfigureAction
  177
+      ,hiddenCommand $
174 178
        sandboxBuildCommand `commandAddAction` sandboxBuildAction
175 179
       ,hiddenCommand $
176 180
        sandboxInstallCommand `commandAddAction` sandboxInstallAction
@@ -580,6 +584,19 @@ indexAction indexFlags extraArgs _globalFlags = do
580 584
   let verbosity = fromFlag (indexVerbosity indexFlags)
581 585
   index verbosity indexFlags (head extraArgs)
582 586
 
  587
+sandboxInitAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
  588
+sandboxInitAction sandboxFlags extraArgs globalFlags = do
  589
+  when ((>0). length $ extraArgs) $ do
  590
+    die $ "the 'sandbox-init' command doesn't expect any arguments: "
  591
+      ++ unwords extraArgs
  592
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  593
+  sandboxInit verbosity sandboxFlags globalFlags
  594
+
  595
+sandboxAddSourceAction :: SandboxFlags -> [String] -> GlobalFlags -> IO ()
  596
+sandboxAddSourceAction sandboxFlags extraArgs _globalFlags = do
  597
+  let verbosity = fromFlag (sandboxVerbosity sandboxFlags)
  598
+  sandboxAddSource verbosity sandboxFlags extraArgs
  599
+
583 600
 sandboxConfigureAction :: (SandboxFlags, ConfigFlags, ConfigExFlags)
584 601
                           -> [String] -> GlobalFlags -> IO ()
585 602
 sandboxConfigureAction (sandboxFlags, configFlags, configExFlags)
@@ -588,11 +605,6 @@ sandboxConfigureAction (sandboxFlags, configFlags, configExFlags)
588 605
   sandboxConfigure verbosity sandboxFlags configFlags configExFlags
589 606
     extraArgs globalFlags
590 607
 
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 608
 sandboxBuildAction :: (SandboxFlags, BuildFlags) -> [String] -> GlobalFlags
597 609
                       -> IO ()
598 610
 sandboxBuildAction (sandboxFlags, buildFlags) extraArgs _globalFlags = do

0 notes on commit f2a0ab9

Please sign in to comment.
Something went wrong with that request. Please try again.