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

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