Commit 53e08e45 authored by Alexander Biehl's avatar Alexander Biehl Committed by alexbiehl

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

parent dd1b0d7c
......@@ -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
......
{-# 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"
\ No newline at end of file
......@@ -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
......
......@@ -399,7 +399,8 @@ convertLegacyBuildOnlyFlags globalFlags configFlags
globalLogsDir = projectConfigLogsDir,
globalWorldFile = _,
globalHttpTransport = projectConfigHttpTransport,
globalIgnoreExpiry = projectConfigIgnoreExpiry
globalIgnoreExpiry = projectConfigIgnoreExpiry,
globalStoreDir = projectConfigStoreDir
} = globalFlags
ConfigFlags {
......@@ -479,7 +480,8 @@ convertToLegacySharedConfig
globalIgnoreSandbox = mempty,
globalIgnoreExpiry = projectConfigIgnoreExpiry,
globalHttpTransport = projectConfigHttpTransport,
globalNix = mempty
globalNix = mempty,
globalStoreDir = projectConfigStoreDir
}
configFlags = mempty {
......@@ -805,7 +807,7 @@ legacySharedConfigFieldDescrs =
]
. filterFields
[ "remote-repo-cache"
, "logs-dir", "ignore-expiry", "http-transport"
, "logs-dir", "store-dir", "ignore-expiry", "http-transport"
]
. commandOptionsToFields
) (commandOptions (globalCommand []) ParseArgs)
......
......@@ -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)
......
......@@ -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.
......
......@@ -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")
]
-- ------------------------------------------------------------
......
......@@ -338,6 +338,7 @@ instance Arbitrary ProjectConfigBuildOnly where
<*> arbitrary
<*> (fmap getShortToken <$> arbitrary)
<*> (fmap getShortToken <$> arbitrary)
<*> arbitrary
where
arbitraryNumJobs = fmap (fmap getPositive) <$> arbitrary
......@@ -357,7 +358,8 @@ instance Arbitrary ProjectConfigBuildOnly where
, projectConfigHttpTransport = x13
, projectConfigIgnoreExpiry = x14
, projectConfigCacheDir = x15
, projectConfigLogsDir = x16 } =
, projectConfigLogsDir = x16
, projectConfigStoreDir = x17 } =
[ ProjectConfigBuildOnly { projectConfigVerbosity = x00'
, projectConfigDryRun = x01'
, projectConfigOnlyDeps = x02'
......@@ -374,7 +376,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'))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment