Add `reconfigure` command

Fixes #2214 by adding a `reconfigure` command and invoking it whenever
necessary. The last configure flags used are saved in a
version-independent format so it should never be necessary for the user
to reconfigure manually.

Cabal/Distribution/Simple/Setup.hs

@@ -94,6 +94,8 @@ import Distribution.Utils.NubList
 
 import Distribution.Compat.Semigroup (Last' (..))
 
+import Data.Function (on)
+
 -- FIXME Not sure where this should live
 defaultDistPref :: FilePath
 defaultDistPref = "dist"
@@ -347,6 +349,7 @@ relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . display) $ pkgs
 --
 -- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags'
 -- should be updated.
+-- IMPORTANT: every time a new flag is added, it should be added to the Eq instance
 data ConfigFlags = ConfigFlags {
     -- This is the same hack as in 'buildArgs' and 'copyArgs'.
     -- TODO: Stop using this eventually when 'UserHooks' gets changed
@@ -433,6 +436,54 @@ instance Binary ConfigFlags
 configPrograms :: ConfigFlags -> ProgramDb
 configPrograms = maybe (error "FIXME: remove configPrograms") id . getLast' . configPrograms_
 
+instance Eq ConfigFlags where
+  (==) a b =
+    -- configPrograms skipped: not user specified, has no Eq instance
+    equal configProgramPaths
+    && equal configProgramArgs
+    && equal configProgramPathExtra
+    && equal configHcFlavor
+    && equal configHcPath
+    && equal configHcPkg
+    && equal configVanillaLib
+    && equal configProfLib
+    && equal configSharedLib
+    && equal configDynExe
+    && equal configProfExe
+    && equal configProf
+    && equal configProfDetail
+    && equal configProfLibDetail
+    && equal configConfigureArgs
+    && equal configOptimization
+    && equal configProgPrefix
+    && equal configProgSuffix
+    && equal configInstallDirs
+    && equal configScratchDir
+    && equal configExtraLibDirs
+    && equal configExtraIncludeDirs
+    && equal configIPID
+    && equal configDistPref
+    && equal configVerbosity
+    && equal configUserInstall
+    && equal configPackageDBs
+    && equal configGHCiLib
+    && equal configSplitObjs
+    && equal configStripExes
+    && equal configStripLibs
+    && equal configConstraints
+    && equal configDependencies
+    && equal configConfigurationsFlags
+    && equal configTests
+    && equal configBenchmarks
+    && equal configCoverage
+    && equal configLibCoverage
+    && equal configExactConfiguration
+    && equal configFlagError
+    && equal configRelocatable
+    && equal configDebugInfo
+    where
+      equal f = on (==) f a b
+
 configAbsolutePaths :: ConfigFlags -> NoCallStackIO ConfigFlags
 configAbsolutePaths f =
   (\v -> f { configPackageDBs = v })

cabal-install/Distribution/Client/Configure.hs

@@ -15,7 +15,11 @@ module Distribution.Client.Configure (
     configure,
     configureSetupScript,
     chooseCabalVersion,
-    checkConfigExFlags
+    checkConfigExFlags,
+    -- * Saved configure flags
+    readConfigFlagsFrom, readConfigFlags,
+    cabalConfigFlagsFile,
+    writeConfigFlagsTo, writeConfigFlags,
   ) where
 
 import Distribution.Client.Dependency
@@ -24,8 +28,8 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
 import Distribution.Client.Setup
-         ( ConfigExFlags(..), configureCommand, filterConfigureFlags
-         , RepoContext(..) )
+         ( ConfigExFlags(..), RepoContext(..)
+         , configureCommand, configureExCommand, filterConfigureFlags )
 import Distribution.Client.Types as Source
 import Distribution.Client.SetupWrapper
          ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
@@ -46,7 +50,8 @@ import           Distribution.Solver.Types.SourcePackage
 
 import Distribution.Simple.Compiler
          ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
-import Distribution.Simple.Program (ProgramDb )
+import Distribution.Simple.Program (ProgramDb)
+import Distribution.Client.SavedFlags ( readCommandFlags, writeCommandFlags )
 import Distribution.Simple.Setup
          ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..)
          , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
@@ -82,6 +87,7 @@ import Control.Monad (unless)
 import Data.Monoid (Monoid(..))
 #endif
 import Data.Maybe (isJust, fromMaybe)
+import System.FilePath ( (</>) )
 
 -- | Choose the Cabal version such that the setup scripts compiled against this
 -- version will support the given command-line flags.
@@ -401,3 +407,40 @@ configurePackage verbosity platform comp scriptOptions configFlags
            platform comp [] gpkg of
       Left _ -> error "finalizePD ReadyPackage failed"
       Right (desc, _) -> desc
+
+-- -----------------------------------------------------------------------------
+-- * Saved configure environments and flags
+-- -----------------------------------------------------------------------------
+
+-- | Read saved configure flags and restore the saved environment from the
+-- specified files.
+readConfigFlagsFrom :: FilePath  -- ^ path to saved flags file
+                    -> IO (ConfigFlags, ConfigExFlags)
+readConfigFlagsFrom flags = do
+  readCommandFlags flags configureExCommand
+
+-- | The path (relative to @--build-dir@) where the arguments to @configure@
+-- should be saved.
+cabalConfigFlagsFile :: FilePath -> FilePath
+cabalConfigFlagsFile dist = dist </> "cabal-config-flags"
+
+-- | Read saved configure flags and restore the saved environment from the
+-- usual location.
+readConfigFlags :: FilePath  -- ^ @--build-dir@
+                -> IO (ConfigFlags, ConfigExFlags)
+readConfigFlags dist =
+  readConfigFlagsFrom (cabalConfigFlagsFile dist)
+
+-- | Save the configure flags and environment to the specified files.
+writeConfigFlagsTo :: FilePath  -- ^ path to saved flags file
+                   -> Verbosity -> (ConfigFlags, ConfigExFlags)
+                   -> IO ()
+writeConfigFlagsTo file verb flags = do
+  writeCommandFlags verb file configureExCommand flags
+
+-- | Save the build flags to the usual location.
+writeConfigFlags :: Verbosity
+                 -> FilePath  -- ^ @--build-dir@
+                 -> (ConfigFlags, ConfigExFlags) -> IO ()
+writeConfigFlags verb dist =
+  writeConfigFlagsTo (cabalConfigFlagsFile dist) verb

cabal-install/Distribution/Client/Reconfigure.hs

+module Distribution.Client.Reconfigure ( Check(..), reconfigure ) where
+
+import Control.Monad ( unless, when )
+import Data.Monoid hiding ( (<>) )
+import System.Directory ( doesFileExist )
+
+import Distribution.Compat.Semigroup
+
+import Distribution.Verbosity
+
+import Distribution.Simple.Configure ( localBuildInfoFile )
+import Distribution.Simple.Setup ( Flag, flagToMaybe, toFlag )
+import Distribution.Simple.Utils
+       ( existsAndIsMoreRecentThan, defaultPackageDesc, info )
+
+import Distribution.Client.Config ( SavedConfig(..) )
+import Distribution.Client.Configure ( readConfigFlags )
+import Distribution.Client.Sandbox
+       ( WereDepsReinstalled(..), findSavedDistPref, getSandboxConfigFilePath
+       , maybeReinstallAddSourceDeps, updateInstallDirs )
+import Distribution.Client.Sandbox.PackageEnvironment
+       ( userPackageEnvironmentFile )
+import Distribution.Client.Sandbox.Types ( UseSandbox(..) )
+import Distribution.Client.Setup
+       ( ConfigFlags(..), ConfigExFlags, GlobalFlags(..)
+       , SkipAddSourceDepsCheck(..) )
+
+
+-- | @Check@ represents a function to check some condition on type @a@. The
+-- returned 'Any' is 'True' if any part of the condition failed.
+newtype Check a = Check {
+  runCheck :: Any  -- ^ Did any previous check fail?
+           -> a  -- ^ value returned by previous checks
+           -> IO (Any, a)  -- ^ Did this check fail? What value is returned?
+}
+
+instance Semigroup (Check a) where
+  (<>) c d = Check $ \any0 a0 -> do
+    (any1, a1) <- runCheck c any0 a0
+    (any2, a2) <- runCheck d (any0 <> any1) a1
+    return (any0 <> any1 <> any2, a2)
+
+instance Monoid (Check a) where
+  mempty = Check $ \_ a -> return (mempty, a)
+  mappend = (<>)
+
+
+-- | Re-configure the package in the current directory if needed. Deciding
+-- when to reconfigure and with which options is convoluted:
+--
+-- If we are reconfiguring, we must always run @configure@ with the
+-- verbosity option we are given; however, that a previous configuration
+-- uses a different verbosity setting is not reason enough to reconfigure.
+--
+-- The package should be configured to use the same \"dist\" prefix as
+-- given to the @build@ command, otherwise the build will probably
+-- fail. Not only does this determine the \"dist\" prefix setting if we
+-- need to reconfigure anyway, but an existing configuration should be
+-- invalidated if its \"dist\" prefix differs.
+--
+-- If the package has never been configured (i.e., there is no
+-- LocalBuildInfo), we must configure first, using the default options.
+--
+-- If the package has been configured, there will be a 'LocalBuildInfo'.
+-- If there no package description file, we assume that the
+-- 'PackageDescription' is up to date, though the configuration may need
+-- to be updated for other reasons (see above). If there is a package
+-- description file, and it has been modified since the 'LocalBuildInfo'
+-- was generated, then we need to reconfigure.
+--
+-- The caller of this function may also have specific requirements
+-- regarding the flags the last configuration used. For example,
+-- 'testAction' requires that the package be configured with test suites
+-- enabled. The caller may pass the required settings to this function
+-- along with a function to check the validity of the saved 'ConfigFlags';
+-- these required settings will be checked first upon determining that
+-- a previous configuration exists.
+reconfigure
+  :: ((ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> IO ())
+     -- ^ configure action
+  -> Verbosity
+     -- ^ Verbosity setting
+  -> FilePath
+     -- ^ \"dist\" prefix
+  -> UseSandbox
+  -> SkipAddSourceDepsCheck
+     -- ^ Should we skip the timestamp check for modified
+     -- add-source dependencies?
+  -> Flag (Maybe Int)
+     -- ^ -j flag for reinstalling add-source deps.
+  -> Check (ConfigFlags, ConfigExFlags)
+     -- ^ Check that the required flags are set.
+     -- If they are not set, provide a message explaining the
+     -- reason for reconfiguration.
+  -> [String]     -- ^ Extra arguments
+  -> GlobalFlags  -- ^ Global flags
+  -> SavedConfig
+  -> IO SavedConfig
+reconfigure
+  configureAction
+  verbosity
+  dist
+  useSandbox
+  skipAddSourceDepsCheck
+  numJobsFlag
+  check
+  extraArgs
+  globalFlags
+  config
+  = do
+
+  savedFlags@(_, _) <- readConfigFlags dist
+
+  let checks =
+        checkVerb
+        <> checkDist
+        <> checkOutdated
+        <> check
+        <> checkAddSourceDeps
+  (Any force, flags@(configFlags, _)) <- runCheck checks mempty savedFlags
+
+  let (_, config') =
+        updateInstallDirs
+        (configUserInstall configFlags)
+        (useSandbox, config)
+
+  when force $ configureAction flags extraArgs globalFlags
+  return config'
+
+  where
+
+    -- Changing the verbosity does not require reconfiguration, but the new
+    -- verbosity should be used if reconfiguring.
+    checkVerb = Check $ \_ (configFlags, configExFlags) -> do
+      let configFlags' = configFlags { configVerbosity = toFlag verbosity}
+      return (mempty, (configFlags', configExFlags))
+
+    -- Reconfiguration is required if @--build-dir@ changes.
+    checkDist = Check $ \_ (configFlags, configExFlags) -> do
+      -- Always set the chosen @--build-dir@ before saving the flags,
+      -- or bad things could happen.
+      savedDist <- findSavedDistPref config (configDistPref configFlags)
+      let distChanged = dist /= savedDist
+      when distChanged $ info verbosity "build directory changed"
+      let configFlags' = configFlags { configDistPref = toFlag dist }
+      return (Any distChanged, (configFlags', configExFlags))
+
+    checkOutdated = Check $ \_ flags@(configFlags, _) -> do
+      let buildConfig = localBuildInfoFile dist
+
+      -- Has the package ever been configured? If not, reconfiguration is
+      -- required.
+      configured <- doesFileExist buildConfig
+      unless configured $ info verbosity "package has never been configured"
+
+      -- Is the configuration older than the sandbox configuration file?
+      -- If so, reconfiguration is required.
+      sandboxConfig <- getSandboxConfigFilePath globalFlags
+      sandboxConfigNewer <- existsAndIsMoreRecentThan sandboxConfig buildConfig
+      when sandboxConfigNewer $
+        info verbosity "sandbox was created after the package was configured"
+
+      -- Is the @cabal.config@ file newer than @dist/setup.config@? Then we need
+      -- to force reconfigure. Note that it's possible to use @cabal.config@
+      -- even without sandboxes.
+      userPackageEnvironmentFileModified <-
+        existsAndIsMoreRecentThan userPackageEnvironmentFile buildConfig
+      when userPackageEnvironmentFileModified $
+        info verbosity ("user package environment file ('"
+        ++ userPackageEnvironmentFile ++ "') was modified")
+
+      -- Is the configuration older than the package description?
+      descrFile <- maybe (defaultPackageDesc verbosity) return
+                   (flagToMaybe (configCabalFilePath configFlags))
+      outdated <- existsAndIsMoreRecentThan descrFile buildConfig
+      when outdated $ info verbosity (descrFile ++ " was changed")
+
+      let failed =
+            Any outdated
+            <> Any userPackageEnvironmentFileModified
+            <> Any sandboxConfigNewer
+            <> Any (not configured)
+      return (failed, flags)
+
+    checkAddSourceDeps = Check $ \(Any force') flags@(configFlags, _) -> do
+      let (_, config') =
+            updateInstallDirs
+            (configUserInstall configFlags)
+            (useSandbox, config)
+
+          skipAddSourceDepsCheck'
+            | force'    = SkipAddSourceDepsCheck
+            | otherwise = skipAddSourceDepsCheck
+
+      when (skipAddSourceDepsCheck' == SkipAddSourceDepsCheck) $
+        info verbosity "skipping add-source deps check"
+
+      -- Were any add-source dependencies reinstalled in the sandbox?
+      depsReinstalled <-
+        case skipAddSourceDepsCheck' of
+          DontSkipAddSourceDepsCheck ->
+            maybeReinstallAddSourceDeps
+            verbosity numJobsFlag configFlags globalFlags
+            (useSandbox, config')
+          SkipAddSourceDepsCheck -> do
+            return NoDepsReinstalled
+
+      case depsReinstalled of
+        NoDepsReinstalled -> return (mempty, flags)
+        ReinstalledSomeDeps -> do
+          info verbosity "some add-source dependencies were reinstalled"
+          return (Any True, flags)

cabal-install/Distribution/Client/SavedFlags.hs

+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Distribution.Client.SavedFlags
+       ( readCommandFlags, writeCommandFlags
+       , readSavedArgs, writeSavedArgs
+       ) where
+
+import Distribution.Simple.Command
+import Distribution.Simple.UserHooks ( Args )
+import Distribution.Simple.Utils
+       ( createDirectoryIfMissingVerbose, unintersperse )
+import Distribution.Verbosity
+
+import Control.Exception ( Exception, throwIO )
+import Control.Monad ( liftM )
+import Data.List ( intercalate )
+import Data.Maybe ( fromMaybe )
+import Data.Typeable
+import System.Directory ( doesFileExist )
+import System.FilePath ( takeDirectory )
+
+
+writeSavedArgs :: Verbosity -> FilePath -> [String] -> IO ()
+writeSavedArgs verbosity path args = do
+  createDirectoryIfMissingVerbose
+    (lessVerbose verbosity) True (takeDirectory path)
+  writeFile path (intercalate "\0" args)
+
+
+-- | Write command-line flags to a file, separated by null characters. This
+-- format is also suitable for the @xargs -0@ command. Using the null
+-- character also avoids the problem of escaping newlines or spaces,
+-- because unlike other whitespace characters, the null character is
+-- not valid in command-line arguments.
+writeCommandFlags :: Verbosity -> FilePath -> CommandUI flags -> flags -> IO ()
+writeCommandFlags verbosity path command flags =
+  writeSavedArgs verbosity path (commandShowOptions command flags)
+
+
+readSavedArgs :: FilePath -> IO (Maybe [String])
+readSavedArgs path = do
+  exists <- doesFileExist path
+  if exists
+     then liftM (Just . unintersperse '\0') (readFile path)
+    else return Nothing
+
+
+-- | Read command-line arguments, separated by null characters, from a file.
+-- Returns the default flags if the file does not exist.
+readCommandFlags :: FilePath -> CommandUI flags -> IO flags
+readCommandFlags path command = do
+  savedArgs <- liftM (fromMaybe []) (readSavedArgs path)
+  case (commandParseArgs command True savedArgs) of
+    CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs)
+    CommandList _ -> throwIO (SavedArgsErrorList savedArgs)
+    CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs)
+    CommandReadyToGo (mkFlags, _) ->
+      return (mkFlags (commandDefaultFlags command))
+
+-- -----------------------------------------------------------------------------
+-- * Exceptions
+-- -----------------------------------------------------------------------------
+
+data SavedArgsError
+    = SavedArgsErrorHelp Args
+    | SavedArgsErrorList Args
+    | SavedArgsErrorOther Args [String]
+  deriving (Typeable)
+
+instance Show SavedArgsError where
+  show (SavedArgsErrorHelp args) =
+    "unexpected flag '--help', saved command line was:\n"
+    ++ intercalate " " args
+  show (SavedArgsErrorList args) =
+    "unexpected flag '--list-options', saved command line was:\n"
+    ++ intercalate " " args
+  show (SavedArgsErrorOther args errs) =
+    "saved command line was:\n"
+    ++ intercalate " " args ++ "\n"
+    ++ "encountered errors:\n"
+    ++ intercalate "\n" errs
+
+instance Exception SavedArgsError

cabal-install/Distribution/Client/Setup.hs

@@ -20,9 +20,9 @@ module Distribution.Client.Setup
     , configureCommand, ConfigFlags(..), filterConfigureFlags
     , configPackageDB', configCompilerAux'
     , configureExCommand, ConfigExFlags(..), defaultConfigExFlags
-                        , configureExOptions
     , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..)
     , replCommand, testCommand, benchmarkCommand
+                        , configureExOptions, reconfigureCommand
     , installCommand, InstallFlags(..), installOptions, defaultInstallFlags
     , defaultSolver, defaultMaxBackjumps
     , listCommand, ListFlags(..)
@@ -499,6 +499,21 @@ instance Monoid ConfigExFlags where
 instance Semigroup ConfigExFlags where
   (<>) = gmappend
 
+reconfigureCommand :: CommandUI (ConfigFlags, ConfigExFlags)
+reconfigureCommand
+  = configureExCommand
+    { commandName         = "reconfigure"
+    , commandSynopsis     = "Reconfigure the package if necessary."
+    , commandDescription  = Just $ \pname -> wrapText $
+         "Run `configure` with the most recently used flags and append FLAGS. "
+         ++ "Accepts the same flags as `" ++ pname ++ " configure'. "
+         ++ "If the package has never been configured, this has the same "
+         ++ "effect as calling `configure`."
+    , commandNotes        = Nothing
+    , commandUsage        = usageAlternatives "reconfigure" [ "[FLAGS]" ]
+    , commandDefaultFlags = mempty
+    }
+
 -- ------------------------------------------------------------
 -- * Build flags
 -- ------------------------------------------------------------

cabal-install/cabal-install.cabal

@@ -278,13 +278,15 @@ executable cabal
         Distribution.Client.ProjectPlanning
         Distribution.Client.ProjectPlanning.Types
         Distribution.Client.ProjectPlanOutput
-        Distribution.Client.Run
         Distribution.Client.RebuildMonad
+        Distribution.Client.Reconfigure
+        Distribution.Client.Run
         Distribution.Client.Sandbox
         Distribution.Client.Sandbox.Index
         Distribution.Client.Sandbox.PackageEnvironment
         Distribution.Client.Sandbox.Timestamp
         Distribution.Client.Sandbox.Types
+        Distribution.Client.SavedFlags
         Distribution.Client.Security.HTTP
         Distribution.Client.Setup
         Distribution.Client.SetupWrapper

cabal-install/changelog

@@ -22,6 +22,7 @@
 	verbose GHC output (#3540, #3671).
 	* Changed the default logfile template from
 	'.../$pkgid.log' to '.../$compiler/$libname.log' (#3807).
+	* Added a new command, 'cabal reconfigure' (#2214).
 
 1.24.0.0 Ryan Thomas <ryan@ryant.org> March 2016
 	* If there are multiple remote repos, 'cabal update' now updates