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