Commit 45c9d150 authored by Duncan Coutts's avatar Duncan Coutts

Make the logs dir a proper config item and pass it to the install code

parent ef797628
......@@ -39,24 +39,22 @@ import Distribution.Client.Setup
import Distribution.Simple.Setup
( ConfigFlags(..), configureOptions, defaultConfigFlags
, installDirsOptions
, Flag, toFlag, flagToMaybe, fromFlagOrDefault, flagToList )
, Flag, toFlag, flagToMaybe, fromFlagOrDefault )
import Distribution.Simple.InstallDirs
( InstallDirs(..), defaultInstallDirs
, PathTemplate, toPathTemplate, fromPathTemplate )
, PathTemplate, toPathTemplate )
import Distribution.ParseUtils
( FieldDescr(..), liftField
, ParseResult(..), locatedErrorMsg, showPWarning
, readFields, warning, lineNo
, simpleField, listField, parseFilePathQ, showFilePath, parseTokenQ )
, simpleField, listField, parseFilePathQ, parseTokenQ )
import qualified Distribution.ParseUtils as ParseUtils
( Field(..) )
import qualified Distribution.Text as Text
( Text(..) )
import Distribution.ReadE
( readP_to_E )
import Distribution.Simple.Command
( CommandUI(commandOptions), commandDefaultFlags, ShowOrParseArgs(..)
, viewAsFieldDescr, OptionField, option, reqArg )
, viewAsFieldDescr )
import Distribution.Simple.Program
( defaultProgramConfiguration )
import Distribution.Simple.Utils
......@@ -157,6 +155,7 @@ updateInstallDirs userInstallFlag
baseSavedConfig :: IO SavedConfig
baseSavedConfig = do
userPrefix <- defaultCabalDir
logsDir <- defaultLogsDir
worldFile <- defaultWorldFile
return mempty {
savedConfigureFlags = mempty {
......@@ -168,6 +167,7 @@ baseSavedConfig = do
prefix = toFlag (toPathTemplate userPrefix)
},
savedGlobalFlags = mempty {
globalLogsDir = toFlag logsDir,
globalWorldFile = toFlag worldFile
}
}
......@@ -195,6 +195,8 @@ initialSavedConfig = do
}
}
--TODO: misleading, there's no way to override this default
-- either make it possible or rename to simply getCabalDir.
defaultCabalDir :: IO FilePath
defaultCabalDir = getAppUserDataDirectory "cabal"
......
......@@ -60,10 +60,11 @@ import Distribution.Client.IndexUtils as IndexUtils
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Setup
( ConfigFlags(..), configureCommand, filterConfigureFlags
( GlobalFlags(..)
, ConfigFlags(..), configureCommand, filterConfigureFlags
, ConfigExFlags(..), InstallFlags(..) )
import Distribution.Client.Config
( defaultLogsDir, defaultCabalDir )
( defaultCabalDir )
import Distribution.Client.Tar (extractTarGzFile)
import Distribution.Client.Types as Available
( UnresolvedDependency(..), AvailablePackage(..)
......@@ -140,20 +141,21 @@ install, upgrade
-> [Repo]
-> Compiler
-> ProgramConfiguration
-> GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
-> [UnresolvedDependency]
-> IO ()
install verbosity packageDB repos comp conf
configFlags configExFlags installFlags deps =
globalFlags configFlags configExFlags installFlags deps =
installWithPlanner verbosity context planner
where
context :: InstallContext
context = (packageDB, repos, comp, conf,
configFlags, configExFlags, installFlags)
globalFlags, configFlags, configExFlags, installFlags)
planner :: Planner
planner | null deps = planLocalPackage verbosity
......@@ -162,14 +164,14 @@ install verbosity packageDB repos comp conf
comp configFlags configExFlags installFlags deps
upgrade verbosity packageDB repos comp conf
configFlags configExFlags installFlags deps =
globalFlags configFlags configExFlags installFlags deps =
installWithPlanner verbosity context planner
where
context :: InstallContext
context = (packageDB, repos, comp, conf,
configFlags, configExFlags, installFlags)
globalFlags, configFlags, configExFlags, installFlags)
planner :: Planner
planner | null deps = planUpgradePackages
......@@ -185,6 +187,7 @@ type InstallContext = ( PackageDBStack
, [Repo]
, Compiler
, ProgramConfiguration
, GlobalFlags
, ConfigFlags
, ConfigExFlags
, InstallFlags )
......@@ -196,7 +199,7 @@ installWithPlanner :: Verbosity
-> Planner
-> IO ()
installWithPlanner verbosity
context@(packageDBs, repos, comp, conf, _, _, installFlags) planner = do
context@(packageDBs, repos, comp, conf, _, _, _, installFlags) planner = do
installed <- getInstalledPackages verbosity comp packageDBs conf
available <- getAvailablePackages verbosity repos
......@@ -412,9 +415,8 @@ postInstallActions :: Verbosity
-> InstallPlan
-> IO ()
postInstallActions verbosity
(packageDBs, _, comp, conf, configFlags, _, installFlags) installPlan = do
logsDir <- defaultLogsDir --FIXME: get this from global flags
(packageDBs, _, comp, conf, globalFlags, configFlags, _, installFlags)
installPlan = do
let buildReports = BuildReports.fromInstallPlan installPlan
BuildReports.storeLocal (installSummaryFile installFlags) buildReports
......@@ -432,6 +434,7 @@ postInstallActions verbosity
where
reportingLevel = fromFlag (installBuildReports installFlags)
logsDir = fromFlag (globalLogsDir globalFlags)
storeDetailedBuildReports :: Verbosity -> FilePath
-> [(BuildReports.BuildReport, Repo)] -> IO ()
......@@ -596,18 +599,17 @@ performInstallations :: Verbosity
-> InstallPlan
-> IO InstallPlan
performInstallations verbosity
(packageDBs, _, comp, conf, configFlags, configExFlags, installFlags)
(packageDBs, _, comp, conf,
globalFlags, configFlags, configExFlags, installFlags)
installed installPlan = do
logsDir <- defaultLogsDir --FIXME: get this from global flags
executeInstallPlan installPlan $ \cpkg ->
installConfiguredPackage platform compid configFlags
cpkg $ \configFlags' src pkg ->
installAvailablePackage verbosity (packageId pkg) src $ \mpath ->
installUnpackedPackage verbosity (setupScriptOptions installed)
miscOptions configFlags' installFlags
compid pkg mpath (useLogFile logsDir)
compid pkg mpath useLogFile
where
platform = InstallPlan.planPlatform installPlan
......@@ -636,8 +638,9 @@ performInstallations verbosity
useWorkingDir = Nothing
}
reportingLevel = fromFlag (installBuildReports installFlags)
useLogFile :: FilePath -> Maybe (PackageIdentifier -> FilePath)
useLogFile logsDir = fmap substLogFileName logFileTemplate
logsDir = fromFlag (globalLogsDir globalFlags)
useLogFile :: Maybe (PackageIdentifier -> FilePath)
useLogFile = fmap substLogFileName logFileTemplate
where
logFileTemplate :: Maybe PathTemplate
logFileTemplate --TODO: separate policy from mechanism
......
......@@ -93,6 +93,7 @@ data GlobalFlags = GlobalFlags {
globalRemoteRepos :: [RemoteRepo], -- ^Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: [FilePath],
globalLogsDir :: Flag FilePath,
globalWorldFile :: Flag FilePath
}
......@@ -104,6 +105,7 @@ defaultGlobalFlags = GlobalFlags {
globalRemoteRepos = [],
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
}
......@@ -155,6 +157,11 @@ globalCommand = CommandUI {
globalLocalRepos (\v flags -> flags { globalLocalRepos = v })
(reqArg' "DIR" (\x -> [x]) id)
,option [] ["logs-dir"]
"The location to put log files"
globalLogsDir (\v flags -> flags { globalLogsDir = v })
(reqArgFlag "DIR")
,option [] ["world-file"]
"The location of the world file"
globalWorldFile (\v flags -> flags { globalWorldFile = v })
......@@ -170,6 +177,7 @@ instance Monoid GlobalFlags where
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
}
mappend a b = GlobalFlags {
......@@ -179,6 +187,7 @@ instance Monoid GlobalFlags where
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = combine globalLocalRepos,
globalLogsDir = combine globalLogsDir,
globalWorldFile = combine globalWorldFile
}
where combine field = field a `mappend` field b
......
......@@ -222,7 +222,7 @@ installAction (configFlags, configExFlags, installFlags)
(comp, conf) <- configCompilerAux configFlags'
install verbosity
(configPackageDB' configFlags') (globalRepos globalFlags')
comp conf configFlags' configExFlags' installFlags'
comp conf globalFlags' configFlags' configExFlags' installFlags'
(uDepsFromWorld ++ uDepsNoWorld)
unless oneShot $ World.insert verbosity dryRun worldFile uDepsNoWorld
......@@ -282,7 +282,7 @@ upgradeAction (configFlags, configExFlags, installFlags)
(comp, conf) <- configCompilerAux configFlags'
upgrade verbosity
(configPackageDB' configFlags') (globalRepos globalFlags')
comp conf configFlags' configExFlags' installFlags'
comp conf globalFlags' configFlags' configExFlags' installFlags'
[ UnresolvedDependency pkg (configConfigurationsFlags configFlags')
| pkg <- pkgs ]
......
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