Add 'store-dir' global flag for custom store location

haskell · Jul 24, 2017 · 5448f1e · 5448f1e
1 parent c92b4ea
commit 5448f1e
Show file tree

Hide file tree

Showing 8 changed files with 48 additions and 21 deletions.
diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
@@ -227,7 +227,8 @@ instance Semigroup SavedConfig where
         globalIgnoreSandbox     = combine globalIgnoreSandbox,
         globalIgnoreExpiry      = combine globalIgnoreExpiry,
         globalHttpTransport     = combine globalHttpTransport,
-        globalNix               = combine globalNix
+        globalNix               = combine globalNix,
+        globalStoreDir          = combine globalStoreDir
         }
         where
           combine        = combine'        savedGlobalFlags

diff --git a/cabal-install/Distribution/Client/DistDirLayout.hs b/cabal-install/Distribution/Client/DistDirLayout.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 
--- | 
+-- |
 --
 -- The layout of the .\/dist\/ directory where cabal keeps all of it's state
 -- and build artifacts.
@@ -18,7 +18,8 @@ module Distribution.Client.DistDirLayout (
 
     -- * 'CabalDirLayout'
     CabalDirLayout(..),
-    defaultCabalDirLayout,
+    mkCabalDirLayout,
+    defaultCabalDirLayout
 ) where
 
 import Data.Maybe (fromMaybe)
@@ -243,12 +244,16 @@ defaultStoreDirLayout storeRoot =
 
 defaultCabalDirLayout :: FilePath -> CabalDirLayout
 defaultCabalDirLayout cabalDir =
+    mkCabalDirLayout cabalDir Nothing Nothing
+
+mkCabalDirLayout :: FilePath -- ^ Cabal directory
+                 -> Maybe FilePath -- ^ Store directory
+                 -> Maybe FilePath -- ^ Log directory
+                 -> CabalDirLayout
+mkCabalDirLayout cabalDir mstoreDir mlogDir =
     CabalDirLayout {..}
   where
-
-    cabalStoreDirLayout = defaultStoreDirLayout (cabalDir </> "store")
-
-    cabalLogsDirectory = cabalDir </> "logs"
-
-    cabalWorldFile = cabalDir </> "world"
-
+    cabalStoreDirLayout =
+        defaultStoreDirLayout (fromMaybe (cabalDir </> "store") mstoreDir)
+    cabalLogsDirectory = fromMaybe (cabalDir </> "logs") mlogDir
+    cabalWorldFile = cabalDir </> "world"
diff --git a/cabal-install/Distribution/Client/GlobalFlags.hs b/cabal-install/Distribution/Client/GlobalFlags.hs
@@ -68,7 +68,8 @@ data GlobalFlags = GlobalFlags {
     globalIgnoreSandbox     :: Flag Bool,
     globalIgnoreExpiry      :: Flag Bool,    -- ^ Ignore security expiry dates
     globalHttpTransport     :: Flag String,
-    globalNix               :: Flag Bool  -- ^ Integrate with Nix
+    globalNix               :: Flag Bool,  -- ^ Integrate with Nix
+    globalStoreDir          :: Flag FilePath
   } deriving Generic
 
 defaultGlobalFlags :: GlobalFlags
@@ -87,7 +88,8 @@ defaultGlobalFlags  = GlobalFlags {
     globalIgnoreSandbox     = Flag False,
     globalIgnoreExpiry      = Flag False,
     globalHttpTransport     = mempty,
-    globalNix               = Flag False
+    globalNix               = Flag False,
+    globalStoreDir          = mempty
   }
 
 instance Monoid GlobalFlags where

diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
@@ -398,7 +398,8 @@ convertLegacyBuildOnlyFlags globalFlags configFlags
       globalLogsDir           = projectConfigLogsDir,
       globalWorldFile         = _,
       globalHttpTransport     = projectConfigHttpTransport,
-      globalIgnoreExpiry      = projectConfigIgnoreExpiry
+      globalIgnoreExpiry      = projectConfigIgnoreExpiry,
+      globalStoreDir          = projectConfigStoreDir
     } = globalFlags
 
     ConfigFlags {
@@ -478,7 +479,8 @@ convertToLegacySharedConfig
       globalIgnoreSandbox     = mempty,
       globalIgnoreExpiry      = projectConfigIgnoreExpiry,
       globalHttpTransport     = projectConfigHttpTransport,
-      globalNix               = mempty
+      globalNix               = mempty,
+      globalStoreDir          = projectConfigStoreDir
     }
 
     configFlags = mempty {
@@ -800,7 +802,7 @@ legacySharedConfigFieldDescrs =
       ]
   . filterFields
       [ "remote-repo-cache"
-      , "logs-dir", "ignore-expiry", "http-transport"
+      , "logs-dir", "store-dir", "ignore-expiry", "http-transport"
       ]
   . commandOptionsToFields
   ) (commandOptions (globalCommand []) ParseArgs)

diff --git a/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/Distribution/Client/ProjectConfig/Types.hs
@@ -143,7 +143,8 @@ data ProjectConfigBuildOnly
        projectConfigHttpTransport         :: Flag String,
        projectConfigIgnoreExpiry          :: Flag Bool,
        projectConfigCacheDir              :: Flag FilePath,
-       projectConfigLogsDir               :: Flag FilePath
+       projectConfigLogsDir               :: Flag FilePath,
+       projectConfigStoreDir              :: Flag FilePath
      }
   deriving (Eq, Show, Generic)
 

diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs
@@ -167,7 +167,7 @@ establishProjectBaseContext verbosity cliConfig = do
     projectRoot <- either throwIO return =<<
                    findProjectRoot Nothing mprojectFile
 
-    let cabalDirLayout = defaultCabalDirLayout cabalDir
+    let cabalDirLayout = mkCabalDirLayout cabalDir mstoreDirectory mlogsDirectory
         distDirLayout  = defaultDistDirLayout projectRoot
                                               mdistDirectory
 
@@ -188,12 +188,20 @@ establishProjectBaseContext verbosity cliConfig = do
       buildSettings
     }
   where
-    mdistDirectory = Setup.flagToMaybe projectConfigDistDir
-    mprojectFile   = Setup.flagToMaybe projectConfigProjectFile
+    mdistDirectory  = Setup.flagToMaybe projectConfigDistDir
+    mprojectFile    = Setup.flagToMaybe projectConfigProjectFile
+    mlogsDirectory  = Setup.flagToMaybe projectConfigLogsDir
+    mstoreDirectory = Setup.flagToMaybe projectConfigStoreDir
     ProjectConfigShared {
       projectConfigDistDir,
       projectConfigProjectFile
     } = projectConfigShared cliConfig
+    ProjectConfigBuildOnly {
+      projectConfigLogsDir,
+      projectConfigStoreDir
+    } = projectConfigBuildOnly cliConfig
+
+
 
 
 -- | This holds the context between the pre-build, build and post-build phases.

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -358,6 +358,11 @@ globalCommand commands = CommandUI {
          "The location of the world file"
          globalWorldFile (\v flags -> flags { globalWorldFile = v })
          (reqArgFlag "FILE")
+
+      ,option [] ["store-dir"]
+         "The location of the nix-local-build store"
+         globalStoreDir (\v flags -> flags { globalStoreDir = v })
+         (reqArgFlag "DIR")
       ]
 
 -- ------------------------------------------------------------

diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
@@ -337,6 +337,7 @@ instance Arbitrary ProjectConfigBuildOnly where
         <*> arbitrary
         <*> (fmap getShortToken <$> arbitrary)
         <*> (fmap getShortToken <$> arbitrary)
+        <*> arbitrary
       where
         arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary
 
@@ -356,7 +357,8 @@ instance Arbitrary ProjectConfigBuildOnly where
                                   , projectConfigHttpTransport = x13
                                   , projectConfigIgnoreExpiry = x14
                                   , projectConfigCacheDir = x15
-                                  , projectConfigLogsDir = x16 } =
+                                  , projectConfigLogsDir = x16
+                                  , projectConfigStoreDir = x17 } =
       [ ProjectConfigBuildOnly { projectConfigVerbosity = x00'
                                , projectConfigDryRun = x01'
                                , projectConfigOnlyDeps = x02'
@@ -373,7 +375,8 @@ instance Arbitrary ProjectConfigBuildOnly where
                                , projectConfigHttpTransport = x13
                                , projectConfigIgnoreExpiry = x14'
                                , projectConfigCacheDir = x15
-                               , projectConfigLogsDir = x16 }
+                               , projectConfigLogsDir = x16
+                               , projectConfigStoreDir = x17}
       | ((x00', x01', x02', x03', x04'),
          (x05', x06', x07', x08', x09'),
          (x10', x11', x12',       x14'))