cabal-install/src/Distribution/Client/CmdConfigure.hs

   1 {-# LANGUAGE RecordWildCards #-}
   2 -- | cabal-install CLI command: configure
   3 --
   4 module Distribution.Client.CmdConfigure (
   5     configureCommand,
   6     configureAction,
   7     configureAction',
   8   ) where
   9
  10 import Distribution.Client.Compat.Prelude
  11 import Prelude ()
  12
  13 import System.Directory
  14 import System.FilePath
  15
  16 import Distribution.Simple.Flag
  17 import Distribution.Client.ProjectOrchestration
  18 import Distribution.Client.ProjectConfig
  19          ( writeProjectLocalExtraConfig, readProjectLocalExtraConfig )
  20 import Distribution.Client.ProjectFlags
  21          ( removeIgnoreProjectOption )
  22
  23 import Distribution.Client.NixStyleOptions
  24          ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
  25 import Distribution.Client.Setup
  26          ( GlobalFlags, ConfigFlags(..), ConfigExFlags(..) )
  27 import Distribution.Verbosity
  28          ( normal )
  29
  30 import Distribution.Simple.Command
  31          ( CommandUI(..), usageAlternatives )
  32 import Distribution.Simple.Utils
  33          ( wrapText, notice, die' )
  34
  35 import Distribution.Client.DistDirLayout
  36          ( DistDirLayout(..) )
  37 import Distribution.Client.RebuildMonad (runRebuild)
  38 import Distribution.Client.ProjectConfig.Types
  39 import Distribution.Client.HttpUtils
  40 import Distribution.Utils.NubList
  41          ( fromNubList )
  42 import Distribution.Types.CondTree
  43          ( CondTree (..) )
  44
  45 configureCommand :: CommandUI (NixStyleFlags ())
  46 configureCommand = CommandUI {
  47   commandName         = "v2-configure",
  48   commandSynopsis     = "Add extra project configuration.",
  49   commandUsage        = usageAlternatives "v2-configure" [ "[FLAGS]" ],
  50   commandDescription  = Just $ \_ -> wrapText $
  51         "Adjust how the project is built by setting additional package flags "
  52      ++ "and other flags.\n\n"
  53
  54      ++ "The configuration options are written to the 'cabal.project.local' "
  55      ++ "file (or '$project_file.local', if '--project-file' is specified) "
  56      ++ "which extends the configuration from the 'cabal.project' file "
  57      ++ "(if any). This combination is used as the project configuration for "
  58      ++ "all other commands (such as 'v2-build', 'v2-repl' etc) though it "
  59      ++ "can be extended/overridden on a per-command basis.\n\n"
  60
  61      ++ "The v2-configure command also checks that the project configuration "
  62      ++ "will work. In particular it checks that there is a consistent set of "
  63      ++ "dependencies for the project as a whole.\n\n"
  64
  65      ++ "The 'cabal.project.local' file persists across 'v2-clean' but is "
  66      ++ "overwritten on the next use of the 'v2-configure' command. The "
  67      ++ "intention is that the 'cabal.project' file should be kept in source "
  68      ++ "control but the 'cabal.project.local' should not.\n\n"
  69
  70      ++ "It is never necessary to use the 'v2-configure' command. It is "
  71      ++ "merely a convenience in cases where you do not want to specify flags "
  72      ++ "to 'v2-build' (and other commands) every time and yet do not want "
  73      ++ "to alter the 'cabal.project' persistently.",
  74   commandNotes        = Just $ \pname ->
  75         "Examples:\n"
  76      ++ "  " ++ pname ++ " v2-configure --with-compiler ghc-7.10.3\n"
  77      ++ "    Adjust the project configuration to use the given compiler\n"
  78      ++ "    program and check the resulting configuration works.\n"
  79      ++ "  " ++ pname ++ " v2-configure\n"
  80      ++ "    Reset the local configuration to empty. To check that the\n"
  81      ++ "    project configuration works, use 'cabal build'.\n"
  82
  83   , commandDefaultFlags = defaultNixStyleFlags ()
  84   , commandOptions      = removeIgnoreProjectOption
  85                         . nixStyleOptions (const [])
  86   }
  87
  88 -- | To a first approximation, the @configure@ just runs the first phase of
  89 -- the @build@ command where we bring the install plan up to date (thus
  90 -- checking that it's possible).
  91 --
  92 -- The only difference is that @configure@ also allows the user to specify
  93 -- some extra config flags which we save in the file @cabal.project.local@.
  94 --
  95 -- For more details on how this works, see the module
  96 -- "Distribution.Client.ProjectOrchestration"
  97 --
  98 configureAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
  99 configureAction flags@NixStyleFlags {..} extraArgs globalFlags = do
 100     (baseCtx, projConfig) <- configureAction' flags extraArgs globalFlags
 101
 102     if shouldNotWriteFile baseCtx
 103       then notice v "Config file not written due to flag(s)."
 104       else writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig
 105   where
 106     v = fromFlagOrDefault normal (configVerbosity configFlags)
 107
 108 configureAction' :: NixStyleFlags () -> [String] -> GlobalFlags -> IO (ProjectBaseContext, ProjectConfig)
 109 configureAction' flags@NixStyleFlags {..} _extraArgs globalFlags = do
 110     --TODO: deal with _extraArgs, since flags with wrong syntax end up there
 111
 112     baseCtx <- establishProjectBaseContext v cliConfig OtherCommand
 113
 114     let localFile  = distProjectFile (distDirLayout baseCtx) "local"
 115     -- If cabal.project.local already exists, and the flags allow, back up to cabal.project.local~
 116     let backups = fromFlagOrDefault True  $ configBackup configExFlags
 117         appends = fromFlagOrDefault False $ configAppend configExFlags
 118         backupFile = localFile <> "~"
 119
 120     if shouldNotWriteFile baseCtx
 121       then
 122         return (baseCtx, cliConfig)
 123       else do
 124         exists <- doesFileExist localFile
 125         when (exists && backups) $ do
 126           notice v $
 127             quote (takeFileName localFile) <> " already exists, backing it up to "
 128             <> quote (takeFileName backupFile) <> "."
 129           copyFile localFile backupFile
 130
 131          -- If the flag @configAppend@ is set to true, append and do not overwrite
 132         if exists && appends
 133           then do
 134             httpTransport <- configureTransport v
 135                      (fromNubList . projectConfigProgPathExtra $ projectConfigShared cliConfig)
 136                      (flagToMaybe . projectConfigHttpTransport $ projectConfigBuildOnly cliConfig)
 137             (CondNode conf imps bs)  <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $
 138               readProjectLocalExtraConfig v httpTransport (distDirLayout baseCtx)
 139             when (not (null imps && null bs)) $ die' v "local project file has conditional and/or import logic, unable to perform and automatic in-place update"
 140             return (baseCtx, conf <> cliConfig)
 141           else
 142             return (baseCtx, cliConfig)
 143   where
 144     v = fromFlagOrDefault normal (configVerbosity configFlags)
 145     cliConfig = commandLineFlagsToProjectConfig globalFlags flags
 146                   mempty -- ClientInstallFlags, not needed here
 147     quote s = "'" <> s <> "'"
 148
 149 -- Config file should not be written when certain flags are present
 150 shouldNotWriteFile :: ProjectBaseContext -> Bool
 151 shouldNotWriteFile baseCtx =
 152      buildSettingDryRun (buildSettings baseCtx)
 153   || buildSettingOnlyDownload (buildSettings baseCtx)