{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Client.Main (main) where
import Distribution.Client.Setup
( ActAsSetupFlags (..)
, BuildFlags (..)
, CheckFlags (..)
, ConfigExFlags (..)
, ConfigFlags (..)
, FetchFlags (..)
, FreezeFlags (..)
, GetFlags (..)
, GlobalFlags (..)
, InfoFlags (..)
, InitFlags (initHcPath, initVerbosity)
, InstallFlags (..)
, ListFlags (..)
, ReportFlags (..)
, UploadFlags (..)
, UserConfigFlags (..)
, actAsSetupCommand
, benchmarkCommand
, buildCommand
, checkCommand
, cleanCommand
, configCompilerAux'
, configPackageDB'
, configureExCommand
, copyCommand
, defaultConfigExFlags
, defaultInstallFlags
, fetchCommand
, formatCommand
, freezeCommand
, genBoundsCommand
, getCommand
, globalCommand
, haddockCommand
, infoCommand
, initCommand
, installCommand
, listCommand
, listNeedsCompiler
, manpageCommand
, reconfigureCommand
, registerCommand
, replCommand
, reportCommand
, runCommand
, testCommand
, unpackCommand
, uploadCommand
, userConfigCommand
, withRepoContext
)
import Distribution.Simple.Setup
( BenchmarkFlags (..)
, CleanFlags (..)
, CopyFlags (..)
, Flag (..)
, HaddockFlags (..)
, HaddockTarget (..)
, HscolourFlags (..)
, RegisterFlags (..)
, ReplFlags (..)
, TestFlags (..)
, configAbsolutePaths
, defaultHaddockFlags
, flagToMaybe
, fromFlag
, fromFlagOrDefault
, hscolourCommand
, toFlag
)
import Distribution.Client.Compat.Prelude hiding (get)
import Prelude ()
import Distribution.Client.Config
( SavedConfig (..)
, createDefaultConfigFile
, defaultConfigFile
, getConfigFilePath
, loadConfig
, userConfigDiff
, userConfigUpdate
)
import qualified Distribution.Client.List as List
( info
, list
)
import Distribution.Client.SetupWrapper
( SetupScriptOptions (..)
, defaultSetupScriptOptions
, setupWrapper
)
import Distribution.Client.Targets
( readUserTargets
)
import qualified Distribution.Client.CmdBench as CmdBench
import qualified Distribution.Client.CmdBuild as CmdBuild
import qualified Distribution.Client.CmdClean as CmdClean
import qualified Distribution.Client.CmdConfigure as CmdConfigure
import qualified Distribution.Client.CmdExec as CmdExec
import qualified Distribution.Client.CmdFreeze as CmdFreeze
import qualified Distribution.Client.CmdHaddock as CmdHaddock
import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
import qualified Distribution.Client.CmdInstall as CmdInstall
import Distribution.Client.CmdLegacy
import qualified Distribution.Client.CmdListBin as CmdListBin
import qualified Distribution.Client.CmdOutdated as CmdOutdated
import qualified Distribution.Client.CmdPath as CmdPath
import qualified Distribution.Client.CmdRepl as CmdRepl
import qualified Distribution.Client.CmdRun as CmdRun
import qualified Distribution.Client.CmdSdist as CmdSdist
import qualified Distribution.Client.CmdTest as CmdTest
import qualified Distribution.Client.CmdUpdate as CmdUpdate
import Distribution.Client.Check as Check (check)
import Distribution.Client.Configure (configure, writeConfigFlags)
import Distribution.Client.Fetch (fetch)
import Distribution.Client.Freeze (freeze)
import Distribution.Client.GenBounds (genBounds)
import Distribution.Client.Install (install)
import Distribution.Client.Get (get)
import Distribution.Client.Init (initCmd)
import Distribution.Client.Manpage (manpageCmd)
import Distribution.Client.ManpageFlags (ManpageFlags (..))
import Distribution.Client.Nix
( nixInstantiate
, nixShell
)
import Distribution.Client.Reconfigure (Check (..), reconfigure)
import Distribution.Client.Run (run, splitRunArgs)
import Distribution.Client.Sandbox
( findSavedDistPref
, loadConfigOrSandboxConfig
, updateInstallDirs
)
import Distribution.Client.Signal
( installTerminationHandler
)
import Distribution.Client.Tar (createTarGzFile)
import Distribution.Client.Types.Credentials (Password (..))
import qualified Distribution.Client.Upload as Upload
import Distribution.Client.Utils
( determineNumJobs
, relaxEncodingErrors
)
import Distribution.Client.Version
( cabalInstallVersion
)
import Distribution.Package (packageId)
import Distribution.PackageDescription
( BuildType (..)
, Executable (..)
, buildable
)
import qualified Distribution.Make as Make
import Distribution.PackageDescription.PrettyPrint
( writeGenericPackageDescription
)
import qualified Distribution.Simple as Simple
import Distribution.Simple.Build
( startInterpreter
)
import Distribution.Simple.Command
( Command
, CommandParse (..)
, CommandSpec (..)
, CommandType (..)
, CommandUI (..)
, commandAddAction
, commandFromSpec
, commandShowOptions
, commandsRunWithFallback
, defaultCommandFallback
, hiddenCommand
)
import Distribution.Simple.Compiler (PackageDBStack)
import Distribution.Simple.Configure
( ConfigStateFileError (..)
, configCompilerAuxEx
, getPersistBuildConfig
, interpretPackageDbFlags
, tryGetPersistBuildConfig
)
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.PackageDescription (readGenericPackageDescription)
import Distribution.Simple.Program
( configureAllKnownPrograms
, defaultProgramDb
, defaultProgramSearchPath
, findProgramOnSearchPath
, getProgramInvocationOutput
, simpleProgramInvocation
)
import Distribution.Simple.Program.Db (reconfigurePrograms)
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Utils
( cabalVersion
, createDirectoryIfMissingVerbose
, dieNoVerbosity
, dieWithException
, findPackageDesc
, info
, notice
, topHandler
, tryFindPackageDesc
)
import Distribution.Text
( display
)
import qualified Distribution.Types.UnqualComponentName as Make
import Distribution.Verbosity as Verbosity
( normal
)
import Distribution.Version
( Version
, mkVersion
, orLaterVersion
)
import Control.Exception (AssertionFailed, assert, try)
import Data.Monoid (Any (..))
import Distribution.Client.Errors
import Distribution.Compat.ResponseFile
import System.Directory
( doesFileExist
, getCurrentDirectory
, withCurrentDirectory
)
import System.Environment (getEnvironment, getExecutablePath, getProgName)
import System.FilePath
( dropExtension
, splitExtension
, takeExtension
, (<.>)
, (</>)
)
import System.IO
( BufferMode (LineBuffering)
, hPutStrLn
, hSetBuffering
, stderr
, stdout
)
import System.Process (createProcess, env, proc, waitForProcess)
main :: [String] -> IO ()
main :: [FilePath] -> IO ()
main [FilePath]
args = do
IO ()
installTerminationHandler
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Handle -> IO ()
relaxEncodingErrors Handle
stdout
Handle -> IO ()
relaxEncodingErrors Handle
stderr
let ([FilePath]
args0, [FilePath]
args1) = (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"--") [FilePath]
args
[FilePath] -> IO ()
mainWorker ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args1) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [FilePath]
expandResponse [FilePath]
args0
warnIfAssertionsAreEnabled :: IO ()
warnIfAssertionsAreEnabled :: IO ()
warnIfAssertionsAreEnabled =
Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert Bool
False (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
IO () -> (AssertionFailed -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(AssertionFailed
_e :: AssertionFailed) -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
assertionsEnabledMsg)
where
assertionsEnabledMsg :: FilePath
assertionsEnabledMsg =
FilePath
"Warning: this is a debug build of cabal-install with assertions enabled."
mainWorker :: [String] -> IO ()
mainWorker :: [FilePath] -> IO ()
mainWorker [FilePath]
args = do
IO () -> IO ()
forall a. IO a -> IO a
topHandler (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
command <- CommandUI GlobalFlags
-> [Command Action]
-> ([Command Action]
-> FilePath -> [FilePath] -> IO (CommandParse Action))
-> [FilePath]
-> IO (CommandParse (GlobalFlags, CommandParse Action))
forall a action.
CommandUI a
-> [Command action]
-> ([Command action]
-> FilePath -> [FilePath] -> IO (CommandParse action))
-> [FilePath]
-> IO (CommandParse (a, CommandParse action))
commandsRunWithFallback ([Command Action] -> CommandUI GlobalFlags
forall action. [Command action] -> CommandUI GlobalFlags
globalCommand [Command Action]
commands) [Command Action]
commands [Command Action]
-> FilePath -> [FilePath] -> IO (CommandParse Action)
delegateToExternal [FilePath]
args
case command of
CommandHelp FilePath -> FilePath
help -> (FilePath -> FilePath) -> IO ()
printGlobalHelp FilePath -> FilePath
help
CommandList [FilePath]
opts -> [FilePath] -> IO ()
printOptionsList [FilePath]
opts
CommandErrors [FilePath]
errs -> [FilePath] -> IO ()
forall {a}. [FilePath] -> IO a
printErrors [FilePath]
errs
CommandReadyToGo (GlobalFlags
globalFlags, CommandParse Action
commandParse) ->
case CommandParse Action
commandParse of
CommandParse Action
_
| Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (GlobalFlags -> Flag Bool
globalVersion GlobalFlags
globalFlags) ->
IO ()
printVersion
| Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (GlobalFlags -> Flag Bool
globalNumericVersion GlobalFlags
globalFlags) ->
IO ()
printNumericVersion
CommandHelp FilePath -> FilePath
help -> (FilePath -> FilePath) -> IO ()
printCommandHelp FilePath -> FilePath
help
CommandList [FilePath]
opts -> [FilePath] -> IO ()
printOptionsList [FilePath]
opts
CommandErrors [FilePath]
errs -> do
case [FilePath]
args of
[] -> [FilePath] -> IO ()
forall {a}. [FilePath] -> IO a
printErrors [FilePath]
errs
FilePath
script : [FilePath]
scriptArgs ->
FilePath -> IO Bool
CmdRun.validScript FilePath
script IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> [FilePath] -> IO ()
forall {a}. [FilePath] -> IO a
printErrors [FilePath]
errs
Bool
True -> do
IO ()
warnIfAssertionsAreEnabled
FilePath -> [FilePath] -> IO ()
CmdRun.handleShebang FilePath
script [FilePath]
scriptArgs
CommandReadyToGo Action
action -> do
IO ()
warnIfAssertionsAreEnabled
Action
action GlobalFlags
globalFlags
where
delegateToExternal
:: [Command Action]
-> String
-> [String]
-> IO (CommandParse Action)
delegateToExternal :: [Command Action]
-> FilePath -> [FilePath] -> IO (CommandParse Action)
delegateToExternal [Command Action]
commands' FilePath
name [FilePath]
cmdArgs = do
mCommand <- Verbosity
-> ProgramSearchPath
-> FilePath
-> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath Verbosity
normal ProgramSearchPath
defaultProgramSearchPath (FilePath
"cabal-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name)
case mCommand of
Just (FilePath
exec, [FilePath]
_) -> CommandParse Action -> IO (CommandParse Action)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Action -> CommandParse Action
forall flags. flags -> CommandParse flags
CommandReadyToGo (Action -> CommandParse Action) -> Action -> CommandParse Action
forall a b. (a -> b) -> a -> b
$ \GlobalFlags
_ -> FilePath -> FilePath -> [FilePath] -> IO ()
callExternal FilePath
exec FilePath
name [FilePath]
cmdArgs)
Maybe (FilePath, [FilePath])
Nothing -> [Command Action]
-> FilePath -> [FilePath] -> IO (CommandParse Action)
forall action.
[Command action]
-> FilePath -> [FilePath] -> IO (CommandParse action)
defaultCommandFallback [Command Action]
commands' FilePath
name [FilePath]
cmdArgs
callExternal :: String -> String -> [String] -> IO ()
callExternal :: FilePath -> FilePath -> [FilePath] -> IO ()
callExternal FilePath
exec FilePath
name [FilePath]
cmdArgs = do
cur_env <- IO [(FilePath, FilePath)]
getEnvironment
cabal_exe <- getExecutablePath
let new_env = (FilePath
"CABAL", FilePath
cabal_exe) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
cur_env
result <- try $ createProcess ((proc exec (name : cmdArgs)){env = Just new_env})
case result of
Left SomeException
ex -> [FilePath] -> IO ()
forall {a}. [FilePath] -> IO a
printErrors [FilePath
"Error executing external command: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show (SomeException
ex :: SomeException)]
Right (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) -> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith
printCommandHelp :: (FilePath -> FilePath) -> IO ()
printCommandHelp FilePath -> FilePath
help = do
pname <- IO FilePath
getProgName
putStr (help pname)
printGlobalHelp :: (FilePath -> FilePath) -> IO ()
printGlobalHelp FilePath -> FilePath
help = do
pname <- IO FilePath
getProgName
configFile <- defaultConfigFile
putStr (help pname)
putStr $
"\nYou can edit the cabal configuration file to set defaults:\n"
++ " "
++ configFile
++ "\n"
exists <- doesFileExist configFile
unless exists $
putStrLn $
"This file will be generated with sensible "
++ "defaults if you run 'cabal update'."
printOptionsList :: [FilePath] -> IO ()
printOptionsList = FilePath -> IO ()
putStr (FilePath -> IO ())
-> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines
printErrors :: [FilePath] -> IO a
printErrors [FilePath]
errs = FilePath -> IO a
forall a. FilePath -> IO a
dieNoVerbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" [FilePath]
errs
printNumericVersion :: IO ()
printNumericVersion = FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
forall a. Pretty a => a -> FilePath
display Version
cabalInstallVersion
printVersion :: IO ()
printVersion =
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"cabal-install version "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display Version
cabalInstallVersion
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\ncompiled using version "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
display Version
cabalVersion
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" of the Cabal library "
commands :: [Command Action]
commands = (CommandSpec Action -> Command Action)
-> [CommandSpec Action] -> [Command Action]
forall a b. (a -> b) -> [a] -> [b]
map CommandSpec Action -> Command Action
forall a. CommandSpec a -> Command a
commandFromSpec [CommandSpec Action]
commandSpecs
commandSpecs :: [CommandSpec Action]
commandSpecs =
[ CommandUI ListFlags
-> (ListFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI ListFlags
listCommand ListFlags -> [FilePath] -> Action
listAction
, CommandUI InfoFlags
-> (InfoFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI InfoFlags
infoCommand InfoFlags -> [FilePath] -> Action
infoAction
, CommandUI FetchFlags
-> (FetchFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI FetchFlags
fetchCommand FetchFlags -> [FilePath] -> Action
fetchAction
, CommandUI GetFlags
-> (GetFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI GetFlags
getCommand GetFlags -> [FilePath] -> Action
getAction
, CommandUI GetFlags
-> (GetFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI GetFlags
unpackCommand GetFlags -> [FilePath] -> Action
unpackAction
, CommandUI CheckFlags
-> (CheckFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI CheckFlags
checkCommand CheckFlags -> [FilePath] -> Action
checkAction
, CommandUI UploadFlags
-> (UploadFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI UploadFlags
uploadCommand UploadFlags -> [FilePath] -> Action
uploadAction
, CommandUI ReportFlags
-> (ReportFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI ReportFlags
reportCommand ReportFlags -> [FilePath] -> Action
reportAction
, CommandUI InitFlags
-> (InitFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI InitFlags
initCommand InitFlags -> [FilePath] -> Action
initAction
, CommandUI UserConfigFlags
-> (UserConfigFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI UserConfigFlags
userConfigCommand UserConfigFlags -> [FilePath] -> Action
userConfigAction
, CommandUI (NixStyleFlags PathFlags)
-> (NixStyleFlags PathFlags -> [FilePath] -> Action)
-> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI (NixStyleFlags PathFlags)
CmdPath.pathCommand NixStyleFlags PathFlags -> [FilePath] -> Action
CmdPath.pathAction
, CommandUI FreezeFlags
-> (FreezeFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI FreezeFlags
genBoundsCommand FreezeFlags -> [FilePath] -> Action
genBoundsAction
, CommandUI (ProjectFlags, OutdatedFlags)
-> ((ProjectFlags, OutdatedFlags) -> [FilePath] -> Action)
-> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI (ProjectFlags, OutdatedFlags)
CmdOutdated.outdatedCommand (ProjectFlags, OutdatedFlags) -> [FilePath] -> Action
CmdOutdated.outdatedAction
, CommandUI HscolourFlags
-> (HscolourFlags -> Flag Verbosity)
-> (HscolourFlags -> Flag FilePath)
-> CommandSpec Action
forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> CommandSpec Action
wrapperCmd CommandUI HscolourFlags
hscolourCommand HscolourFlags -> Flag Verbosity
hscolourVerbosity HscolourFlags -> Flag FilePath
hscolourDistPref
, CommandUI (Flag Verbosity)
-> (Flag Verbosity -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
hiddenCmd CommandUI (Flag Verbosity)
formatCommand Flag Verbosity -> [FilePath] -> Action
formatAction
, CommandUI ActAsSetupFlags
-> (ActAsSetupFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
hiddenCmd CommandUI ActAsSetupFlags
actAsSetupCommand ActAsSetupFlags -> [FilePath] -> Action
actAsSetupAction
, CommandUI ManpageFlags
-> (ManpageFlags -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
hiddenCmd CommandUI ManpageFlags
manpageCommand ([CommandSpec Action] -> ManpageFlags -> [FilePath] -> Action
forall action.
[CommandSpec action] -> ManpageFlags -> [FilePath] -> Action
manpageAction [CommandSpec Action]
commandSpecs)
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action) -> CommandSpec Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI (NixStyleFlags ())
CmdListBin.listbinCommand NixStyleFlags () -> [FilePath] -> Action
CmdListBin.listbinAction
]
[CommandSpec Action]
-> [CommandSpec Action] -> [CommandSpec Action]
forall a. [a] -> [a] -> [a]
++ [[CommandSpec Action]] -> [CommandSpec Action]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdConfigure.configureCommand NixStyleFlags () -> [FilePath] -> Action
CmdConfigure.configureAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdUpdate.updateCommand NixStyleFlags () -> [FilePath] -> Action
CmdUpdate.updateAction
, CommandUI (NixStyleFlags BuildFlags)
-> (NixStyleFlags BuildFlags -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags BuildFlags)
CmdBuild.buildCommand NixStyleFlags BuildFlags -> [FilePath] -> Action
CmdBuild.buildAction
, CommandUI (NixStyleFlags ReplFlags)
-> (NixStyleFlags ReplFlags -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ReplFlags)
CmdRepl.replCommand NixStyleFlags ReplFlags -> [FilePath] -> Action
CmdRepl.replAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdFreeze.freezeCommand NixStyleFlags () -> [FilePath] -> Action
CmdFreeze.freezeAction
, CommandUI (NixStyleFlags ClientHaddockFlags)
-> (NixStyleFlags ClientHaddockFlags -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ClientHaddockFlags)
CmdHaddock.haddockCommand NixStyleFlags ClientHaddockFlags -> [FilePath] -> Action
CmdHaddock.haddockAction
, CommandUI HaddockProjectFlags
-> (HaddockProjectFlags -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd
CommandUI HaddockProjectFlags
CmdHaddockProject.haddockProjectCommand
HaddockProjectFlags -> [FilePath] -> Action
CmdHaddockProject.haddockProjectAction
, CommandUI (NixStyleFlags ClientInstallFlags)
-> (NixStyleFlags ClientInstallFlags -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ClientInstallFlags)
CmdInstall.installCommand NixStyleFlags ClientInstallFlags -> [FilePath] -> Action
CmdInstall.installAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdRun.runCommand NixStyleFlags () -> [FilePath] -> Action
CmdRun.runAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdTest.testCommand NixStyleFlags () -> [FilePath] -> Action
CmdTest.testAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdBench.benchCommand NixStyleFlags () -> [FilePath] -> Action
CmdBench.benchAction
, CommandUI (NixStyleFlags ())
-> (NixStyleFlags () -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (NixStyleFlags ())
CmdExec.execCommand NixStyleFlags () -> [FilePath] -> Action
CmdExec.execAction
, CommandUI (ProjectFlags, CleanFlags)
-> ((ProjectFlags, CleanFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (ProjectFlags, CleanFlags)
CmdClean.cleanCommand (ProjectFlags, CleanFlags) -> [FilePath] -> Action
CmdClean.cleanAction
, CommandUI (ProjectFlags, SdistFlags)
-> ((ProjectFlags, SdistFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
newCmd CommandUI (ProjectFlags, SdistFlags)
CmdSdist.sdistCommand (ProjectFlags, SdistFlags) -> [FilePath] -> Action
CmdSdist.sdistAction
, CommandUI (ConfigFlags, ConfigExFlags)
-> ((ConfigFlags, ConfigExFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand (ConfigFlags, ConfigExFlags) -> [FilePath] -> Action
configureAction
, CommandUI BuildFlags
-> (BuildFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI BuildFlags
buildCommand BuildFlags -> [FilePath] -> Action
buildAction
, CommandUI ReplFlags
-> (ReplFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI ReplFlags
replCommand ReplFlags -> [FilePath] -> Action
replAction
, CommandUI FreezeFlags
-> (FreezeFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI FreezeFlags
freezeCommand FreezeFlags -> [FilePath] -> Action
freezeAction
, CommandUI HaddockFlags
-> (HaddockFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI HaddockFlags
haddockCommand HaddockFlags -> [FilePath] -> Action
haddockAction
, CommandUI
(ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
BenchmarkFlags)
-> ((ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags,
TestFlags, BenchmarkFlags)
-> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI
(ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
BenchmarkFlags)
installCommand (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
BenchmarkFlags)
-> [FilePath] -> Action
installAction
, CommandUI BuildFlags
-> (BuildFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI BuildFlags
runCommand BuildFlags -> [FilePath] -> Action
runAction
, CommandUI (BuildFlags, TestFlags)
-> ((BuildFlags, TestFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI (BuildFlags, TestFlags)
testCommand (BuildFlags, TestFlags) -> [FilePath] -> Action
testAction
, CommandUI (BuildFlags, BenchmarkFlags)
-> ((BuildFlags, BenchmarkFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI (BuildFlags, BenchmarkFlags)
benchmarkCommand (BuildFlags, BenchmarkFlags) -> [FilePath] -> Action
benchmarkAction
, CommandUI CleanFlags
-> (CleanFlags -> [FilePath] -> Action) -> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI CleanFlags
cleanCommand CleanFlags -> [FilePath] -> Action
cleanAction
, CommandUI CopyFlags
-> (CopyFlags -> Flag Verbosity)
-> (CopyFlags -> Flag FilePath)
-> [CommandSpec Action]
forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> [CommandSpec Action]
legacyWrapperCmd CommandUI CopyFlags
copyCommand CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags -> Flag FilePath
copyDistPref
, CommandUI RegisterFlags
-> (RegisterFlags -> Flag Verbosity)
-> (RegisterFlags -> Flag FilePath)
-> [CommandSpec Action]
forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> [CommandSpec Action]
legacyWrapperCmd CommandUI RegisterFlags
registerCommand RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags -> Flag FilePath
regDistPref
, CommandUI (ConfigFlags, ConfigExFlags)
-> ((ConfigFlags, ConfigExFlags) -> [FilePath] -> Action)
-> [CommandSpec Action]
forall flags globals action.
HasVerbosity flags =>
CommandUI flags
-> (flags -> [FilePath] -> globals -> IO action)
-> [CommandSpec (globals -> IO action)]
legacyCmd CommandUI (ConfigFlags, ConfigExFlags)
reconfigureCommand (ConfigFlags, ConfigExFlags) -> [FilePath] -> Action
reconfigureAction
]
type Action = GlobalFlags -> IO ()
regularCmd
:: CommandUI flags
-> (flags -> [String] -> action)
-> CommandSpec action
regularCmd :: forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
regularCmd CommandUI flags
ui flags -> [FilePath] -> action
action =
CommandUI flags
-> (CommandUI flags -> Command action)
-> CommandType
-> CommandSpec action
forall action flags.
CommandUI flags
-> (CommandUI flags -> Command action)
-> CommandType
-> CommandSpec action
CommandSpec CommandUI flags
ui (((CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action)
-> (flags -> [FilePath] -> action)
-> CommandUI flags
-> Command action
forall a b c. (a -> b -> c) -> b -> a -> c
flip CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action
commandAddAction) flags -> [FilePath] -> action
action) CommandType
NormalCommand
hiddenCmd
:: CommandUI flags
-> (flags -> [String] -> action)
-> CommandSpec action
hiddenCmd :: forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> CommandSpec action
hiddenCmd CommandUI flags
ui flags -> [FilePath] -> action
action =
CommandUI flags
-> (CommandUI flags -> Command action)
-> CommandType
-> CommandSpec action
forall action flags.
CommandUI flags
-> (CommandUI flags -> Command action)
-> CommandType
-> CommandSpec action
CommandSpec
CommandUI flags
ui
(\CommandUI flags
ui' -> Command action -> Command action
forall action. Command action -> Command action
hiddenCommand (CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action
commandAddAction CommandUI flags
ui' flags -> [FilePath] -> action
action))
CommandType
HiddenCommand
wrapperCmd
:: Monoid flags
=> CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag String)
-> CommandSpec Action
wrapperCmd :: forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> CommandSpec Action
wrapperCmd CommandUI flags
ui flags -> Flag Verbosity
verbosity flags -> Flag FilePath
distPref =
CommandUI flags
-> (CommandUI flags -> Command Action)
-> CommandType
-> CommandSpec Action
forall action flags.
CommandUI flags
-> (CommandUI flags -> Command action)
-> CommandType
-> CommandSpec action
CommandSpec CommandUI flags
ui (\CommandUI flags
ui' -> CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> Command Action
forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> Command Action
wrapperAction CommandUI flags
ui' flags -> Flag Verbosity
verbosity flags -> Flag FilePath
distPref) CommandType
NormalCommand
wrapperAction
:: Monoid flags
=> CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag String)
-> Command Action
wrapperAction :: forall flags.
Monoid flags =>
CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag FilePath)
-> Command Action
wrapperAction CommandUI flags
command flags -> Flag Verbosity
verbosityFlag flags -> Flag FilePath
distPrefFlag =
CommandUI flags
-> (flags -> [FilePath] -> Action) -> Command Action
forall flags action.
CommandUI flags
-> (flags -> [FilePath] -> action) -> Command action
commandAddAction
CommandUI flags
command
{ commandDefaultFlags = mempty
}
((flags -> [FilePath] -> Action) -> Command Action)
-> (flags -> [FilePath] -> Action) -> Command Action
forall a b. (a -> b) -> a -> b
$ \flags
flags [FilePath]
extraArgs GlobalFlags
globalFlags -> do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (flags -> Flag Verbosity
verbosityFlag flags
flags)
load <- IO SavedConfig -> IO (Either SomeException SavedConfig)
forall e a. Exception e => IO a -> IO (Either e a)
try (Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags)
let config = (SomeException -> SavedConfig)
-> (SavedConfig -> SavedConfig)
-> Either SomeException SavedConfig
-> SavedConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(SomeException e
_) -> SavedConfig
forall a. Monoid a => a
mempty) SavedConfig -> SavedConfig
forall a. a -> a
id Either SomeException SavedConfig
load
distPref <- findSavedDistPref config (distPrefFlag flags)
let setupScriptOptions = SetupScriptOptions
defaultSetupScriptOptions{useDistPref = distPref}
setupWrapper
verbosity
setupScriptOptions
Nothing
command
(const flags)
(const extraArgs)
configureAction
:: (ConfigFlags, ConfigExFlags)
-> [String]
-> Action
configureAction :: (ConfigFlags, ConfigExFlags) -> [FilePath] -> Action
configureAction (ConfigFlags
configFlags, ConfigExFlags
configExFlags) [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
config <-
Flag Bool -> SavedConfig -> SavedConfig
updateInstallDirs (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
configFlags)
(SavedConfig -> SavedConfig) -> IO SavedConfig -> IO SavedConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (configDistPref configFlags)
nixInstantiate verbosity distPref True globalFlags config
nixShell verbosity distPref globalFlags config $ do
let configFlags' = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config ConfigFlags -> ConfigFlags -> ConfigFlags
forall a. Monoid a => a -> a -> a
`mappend` ConfigFlags
configFlags
configExFlags' = SavedConfig -> ConfigExFlags
savedConfigureExFlags SavedConfig
config ConfigExFlags -> ConfigExFlags -> ConfigExFlags
forall a. Monoid a => a -> a -> a
`mappend` ConfigExFlags
configExFlags
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, platform, progdb) <- configCompilerAuxEx configFlags'
writeConfigFlags verbosity distPref (configFlags', configExFlags')
let packageDBs :: PackageDBStack
packageDBs =
Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags
(Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
configFlags'))
(ConfigFlags -> [Maybe PackageDB]
configPackageDBs ConfigFlags
configFlags')
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> ConfigFlags
-> ConfigExFlags
-> [FilePath]
-> IO ()
configure
Verbosity
verbosity
PackageDBStack
packageDBs
RepoContext
repoContext
Compiler
comp
Platform
platform
ProgramDb
progdb
ConfigFlags
configFlags'
ConfigExFlags
configExFlags'
[FilePath]
extraArgs
reconfigureAction
:: (ConfigFlags, ConfigExFlags)
-> [String]
-> Action
reconfigureAction :: (ConfigFlags, ConfigExFlags) -> [FilePath] -> Action
reconfigureAction flags :: (ConfigFlags, ConfigExFlags)
flags@(ConfigFlags
configFlags, ConfigExFlags
_) [FilePath]
_ GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
config <-
Flag Bool -> SavedConfig -> SavedConfig
updateInstallDirs (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
configFlags)
(SavedConfig -> SavedConfig) -> IO SavedConfig -> IO SavedConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (configDistPref configFlags)
let checkFlags = (Any
-> (ConfigFlags, ConfigExFlags)
-> IO (Any, (ConfigFlags, ConfigExFlags)))
-> Check (ConfigFlags, ConfigExFlags)
forall a. (Any -> a -> IO (Any, a)) -> Check a
Check ((Any
-> (ConfigFlags, ConfigExFlags)
-> IO (Any, (ConfigFlags, ConfigExFlags)))
-> Check (ConfigFlags, ConfigExFlags))
-> (Any
-> (ConfigFlags, ConfigExFlags)
-> IO (Any, (ConfigFlags, ConfigExFlags)))
-> Check (ConfigFlags, ConfigExFlags)
forall a b. (a -> b) -> a -> b
$ \Any
_ (ConfigFlags, ConfigExFlags)
saved -> do
let flags' :: (ConfigFlags, ConfigExFlags)
flags' = (ConfigFlags, ConfigExFlags)
saved (ConfigFlags, ConfigExFlags)
-> (ConfigFlags, ConfigExFlags) -> (ConfigFlags, ConfigExFlags)
forall a. Semigroup a => a -> a -> a
<> (ConfigFlags, ConfigExFlags)
flags
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ConfigFlags, ConfigExFlags)
saved (ConfigFlags, ConfigExFlags)
-> (ConfigFlags, ConfigExFlags) -> Bool
forall a. Eq a => a -> a -> Bool
== (ConfigFlags, ConfigExFlags)
flags') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
message
(Any, (ConfigFlags, ConfigExFlags))
-> IO (Any, (ConfigFlags, ConfigExFlags))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, (ConfigFlags, ConfigExFlags)
flags')
where
message :: FilePath
message =
FilePath
"flags changed: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (CommandUI (ConfigFlags, ConfigExFlags)
-> (ConfigFlags, ConfigExFlags) -> [FilePath]
forall flags. CommandUI flags -> flags -> [FilePath]
commandShowOptions CommandUI (ConfigFlags, ConfigExFlags)
configureExCommand (ConfigFlags, ConfigExFlags)
flags)
nixInstantiate verbosity distPref True globalFlags config
_ <-
reconfigure
configureAction
verbosity
distPref
NoFlag
checkFlags
[]
globalFlags
config
pure ()
buildAction :: BuildFlags -> [String] -> Action
buildAction :: BuildFlags -> [FilePath] -> Action
buildAction BuildFlags
buildFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
buildFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (buildDistPref buildFlags)
config' <-
reconfigure
configureAction
verbosity
distPref
(buildNumJobs buildFlags)
mempty
[]
globalFlags
config
nixShell verbosity distPref globalFlags config $ do
build verbosity config' distPref buildFlags extraArgs
build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO ()
build :: Verbosity
-> SavedConfig -> FilePath -> BuildFlags -> [FilePath] -> IO ()
build Verbosity
verbosity SavedConfig
config FilePath
distPref BuildFlags
buildFlags [FilePath]
extraArgs =
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI BuildFlags
-> (Version -> BuildFlags)
-> (Version -> [FilePath])
-> IO ()
forall flags.
Verbosity
-> SetupScriptOptions
-> Maybe PackageDescription
-> CommandUI flags
-> (Version -> flags)
-> (Version -> [FilePath])
-> IO ()
setupWrapper
Verbosity
verbosity
SetupScriptOptions
setupOptions
Maybe PackageDescription
forall a. Maybe a
Nothing
(ProgramDb -> CommandUI BuildFlags
Cabal.buildCommand ProgramDb
progDb)
Version -> BuildFlags
mkBuildFlags
([FilePath] -> Version -> [FilePath]
forall a b. a -> b -> a
const [FilePath]
extraArgs)
where
progDb :: ProgramDb
progDb = ProgramDb
defaultProgramDb
setupOptions :: SetupScriptOptions
setupOptions = SetupScriptOptions
defaultSetupScriptOptions{useDistPref = distPref}
mkBuildFlags :: Version -> BuildFlags
mkBuildFlags Version
version = Version -> SavedConfig -> BuildFlags -> BuildFlags
filterBuildFlags Version
version SavedConfig
config BuildFlags
buildFlags'
buildFlags' :: BuildFlags
buildFlags' =
BuildFlags
buildFlags
{ buildVerbosity = toFlag verbosity
, buildDistPref = toFlag distPref
}
filterBuildFlags :: Version -> SavedConfig -> BuildFlags -> BuildFlags
filterBuildFlags :: Version -> SavedConfig -> BuildFlags -> BuildFlags
filterBuildFlags Version
version SavedConfig
config BuildFlags
buildFlags
| Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
1, Int
19, Int
1] = BuildFlags
buildFlags_latest
| Bool
otherwise = BuildFlags
buildFlags_pre_1_19_1
where
buildFlags_pre_1_19_1 :: BuildFlags
buildFlags_pre_1_19_1 =
BuildFlags
buildFlags
{ buildNumJobs = NoFlag
}
buildFlags_latest :: BuildFlags
buildFlags_latest =
BuildFlags
buildFlags
{
buildNumJobs =
Flag . Just . determineNumJobs $
(numJobsConfigFlag `mappend` numJobsCmdLineFlag)
}
numJobsConfigFlag :: Flag (Maybe Int)
numJobsConfigFlag = InstallFlags -> Flag (Maybe Int)
installNumJobs (InstallFlags -> Flag (Maybe Int))
-> (SavedConfig -> InstallFlags) -> SavedConfig -> Flag (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SavedConfig -> InstallFlags
savedInstallFlags (SavedConfig -> Flag (Maybe Int))
-> SavedConfig -> Flag (Maybe Int)
forall a b. (a -> b) -> a -> b
$ SavedConfig
config
numJobsCmdLineFlag :: Flag (Maybe Int)
numJobsCmdLineFlag = BuildFlags -> Flag (Maybe Int)
buildNumJobs BuildFlags
buildFlags
replAction :: ReplFlags -> [String] -> Action
replAction :: ReplFlags -> [FilePath] -> Action
replAction ReplFlags
replFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
replFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (replDistPref replFlags)
cwd <- getCurrentDirectory
pkgDesc <- findPackageDesc cwd
let
onPkgDesc = do
_ <-
((ConfigFlags, ConfigExFlags) -> [FilePath] -> Action)
-> Verbosity
-> FilePath
-> Flag (Maybe Int)
-> Check (ConfigFlags, ConfigExFlags)
-> [FilePath]
-> GlobalFlags
-> SavedConfig
-> IO SavedConfig
reconfigure
(ConfigFlags, ConfigExFlags) -> [FilePath] -> Action
configureAction
Verbosity
verbosity
FilePath
distPref
Flag (Maybe Int)
forall a. Flag a
NoFlag
Check (ConfigFlags, ConfigExFlags)
forall a. Monoid a => a
mempty
[]
GlobalFlags
globalFlags
SavedConfig
config
let progDb = ProgramDb
defaultProgramDb
setupOptions =
SetupScriptOptions
defaultSetupScriptOptions
{ useCabalVersion = orLaterVersion $ mkVersion [1, 18, 0]
, useDistPref = distPref
}
replFlags' =
ReplFlags
replFlags
{ replVerbosity = toFlag verbosity
, replDistPref = toFlag distPref
}
nixShell verbosity distPref globalFlags config $
setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs)
onNoPkgDesc = do
let configFlags :: ConfigFlags
configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
(comp, platform, programDb) <- ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAux' ConfigFlags
configFlags
programDb' <-
reconfigurePrograms
verbosity
(replProgramPaths replFlags)
(replProgramArgs replFlags)
programDb
nixShell verbosity distPref globalFlags config $ do
startInterpreter
verbosity
programDb'
comp
platform
(configPackageDB' configFlags)
either (const onNoPkgDesc) (const onPkgDesc) pkgDesc
installAction
:: ( ConfigFlags
, ConfigExFlags
, InstallFlags
, HaddockFlags
, TestFlags
, BenchmarkFlags
)
-> [String]
-> Action
installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags,
BenchmarkFlags)
-> [FilePath] -> Action
installAction (ConfigFlags
configFlags, ConfigExFlags
_, InstallFlags
installFlags, HaddockFlags
_, TestFlags
_, BenchmarkFlags
_) [FilePath]
_ GlobalFlags
globalFlags
| Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (InstallFlags -> Flag Bool
installOnly InstallFlags
installFlags) = do
let verb :: Verbosity
verb = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verb GlobalFlags
globalFlags
dist <- findSavedDistPref config (configDistPref configFlags)
let setupOpts = SetupScriptOptions
defaultSetupScriptOptions{useDistPref = dist}
setupWrapper
verb
setupOpts
Nothing
installCommand
(const (mempty, mempty, mempty, mempty, mempty, mempty))
(const [])
installAction
( ConfigFlags
configFlags
, ConfigExFlags
configExFlags
, InstallFlags
installFlags
, HaddockFlags
haddockFlags
, TestFlags
testFlags
, BenchmarkFlags
benchmarkFlags
)
[FilePath]
extraArgs
GlobalFlags
globalFlags = do
let verb :: Verbosity
verb = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
config <-
Flag Bool -> SavedConfig -> SavedConfig
updateInstallDirs (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
configFlags)
(SavedConfig -> SavedConfig) -> IO SavedConfig -> IO SavedConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verb GlobalFlags
globalFlags
dist <- findSavedDistPref config (configDistPref configFlags)
do
targets <- readUserTargets verb extraArgs
let configFlags' =
InstallFlags -> ConfigFlags -> ConfigFlags
maybeForceTests InstallFlags
installFlags' (ConfigFlags -> ConfigFlags) -> ConfigFlags -> ConfigFlags
forall a b. (a -> b) -> a -> b
$
SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
ConfigFlags -> ConfigFlags -> ConfigFlags
forall a. Monoid a => a -> a -> a
`mappend` ConfigFlags
configFlags{configDistPref = toFlag dist}
configExFlags' =
ConfigExFlags
defaultConfigExFlags
ConfigExFlags -> ConfigExFlags -> ConfigExFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> ConfigExFlags
savedConfigureExFlags SavedConfig
config
ConfigExFlags -> ConfigExFlags -> ConfigExFlags
forall a. Monoid a => a -> a -> a
`mappend` ConfigExFlags
configExFlags
installFlags' =
InstallFlags
defaultInstallFlags
InstallFlags -> InstallFlags -> InstallFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> InstallFlags
savedInstallFlags SavedConfig
config
InstallFlags -> InstallFlags -> InstallFlags
forall a. Monoid a => a -> a -> a
`mappend` InstallFlags
installFlags
haddockFlags' =
HaddockFlags
defaultHaddockFlags
HaddockFlags -> HaddockFlags -> HaddockFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config
HaddockFlags -> HaddockFlags -> HaddockFlags
forall a. Monoid a => a -> a -> a
`mappend` HaddockFlags
haddockFlags{haddockDistPref = toFlag dist}
testFlags' =
TestFlags
Cabal.defaultTestFlags
TestFlags -> TestFlags -> TestFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> TestFlags
savedTestFlags SavedConfig
config
TestFlags -> TestFlags -> TestFlags
forall a. Monoid a => a -> a -> a
`mappend` TestFlags
testFlags{testDistPref = toFlag dist}
benchmarkFlags' =
BenchmarkFlags
Cabal.defaultBenchmarkFlags
BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> BenchmarkFlags
savedBenchmarkFlags SavedConfig
config
BenchmarkFlags -> BenchmarkFlags -> BenchmarkFlags
forall a. Monoid a => a -> a -> a
`mappend` BenchmarkFlags
benchmarkFlags{benchmarkDistPref = toFlag dist}
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags'
progdb' <- configureAllKnownPrograms verb progdb
configFlags'' <- configAbsolutePaths configFlags'
withRepoContext verb globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> ConfigFlags
-> ConfigExFlags
-> InstallFlags
-> HaddockFlags
-> TestFlags
-> BenchmarkFlags
-> [UserTarget]
-> IO ()
install
Verbosity
verb
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags'')
RepoContext
repoContext
Compiler
comp
Platform
platform
ProgramDb
progdb'
GlobalFlags
globalFlags'
ConfigFlags
configFlags''
ConfigExFlags
configExFlags'
InstallFlags
installFlags'
HaddockFlags
haddockFlags'
TestFlags
testFlags'
BenchmarkFlags
benchmarkFlags'
[UserTarget]
targets
where
maybeForceTests :: InstallFlags -> ConfigFlags -> ConfigFlags
maybeForceTests InstallFlags
installFlags' ConfigFlags
configFlags' =
if Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (InstallFlags -> Flag Bool
installRunTests InstallFlags
installFlags')
then ConfigFlags
configFlags'{configTests = toFlag True}
else ConfigFlags
configFlags'
testAction
:: (BuildFlags, TestFlags)
-> [String]
-> GlobalFlags
-> IO ()
testAction :: (BuildFlags, TestFlags) -> [FilePath] -> Action
testAction (BuildFlags
buildFlags, TestFlags
testFlags) [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
buildFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (testDistPref testFlags)
let buildFlags' =
BuildFlags
buildFlags
{ buildVerbosity = testVerbosity testFlags
}
checkFlags = (Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b)
forall a. (Any -> a -> IO (Any, a)) -> Check a
Check ((Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b))
-> (Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b)
forall a b. (a -> b) -> a -> b
$ \Any
_ flags :: (ConfigFlags, b)
flags@(ConfigFlags
configFlags, b
configExFlags) ->
if Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configTests ConfigFlags
configFlags)
then (Any, (ConfigFlags, b)) -> IO (Any, (ConfigFlags, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any
forall a. Monoid a => a
mempty, (ConfigFlags, b)
flags)
else do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"reconfiguring to enable tests"
let flags' :: (ConfigFlags, b)
flags' =
( ConfigFlags
configFlags{configTests = toFlag True}
, b
configExFlags
)
(Any, (ConfigFlags, b)) -> IO (Any, (ConfigFlags, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, (ConfigFlags, b)
flags')
_ <-
reconfigure
configureAction
verbosity
distPref
(buildNumJobs buildFlags')
checkFlags
[]
globalFlags
config
nixShell verbosity distPref globalFlags config $ do
let setupOptions = SetupScriptOptions
defaultSetupScriptOptions{useDistPref = distPref}
testFlags' = TestFlags
testFlags{testDistPref = toFlag distPref}
names <-
componentNamesFromLBI
verbosity
distPref
"test suites"
(\Component
c -> case Component
c of LBI.CTest{} -> Bool
True; Component
_ -> Bool
False)
let extraArgs'
| [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraArgs = case ComponentNames
names of
ComponentNames
ComponentNamesUnknown -> []
ComponentNames [ComponentName]
names' ->
[ UnqualComponentName -> FilePath
Make.unUnqualComponentName UnqualComponentName
name
| LBI.CTestName UnqualComponentName
name <- [ComponentName]
names'
]
| Bool
otherwise = [FilePath]
extraArgs
build verbosity config distPref buildFlags' extraArgs'
setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs')
data ComponentNames
= ComponentNamesUnknown
| ComponentNames [LBI.ComponentName]
componentNamesFromLBI
:: Verbosity
-> FilePath
-> String
-> (LBI.Component -> Bool)
-> IO ComponentNames
componentNamesFromLBI :: Verbosity
-> FilePath -> FilePath -> (Component -> Bool) -> IO ComponentNames
componentNamesFromLBI Verbosity
verbosity FilePath
distPref FilePath
targetsDescr Component -> Bool
compPred = do
eLBI <- FilePath -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig FilePath
distPref
case eLBI of
Left ConfigStateFileError
err -> case ConfigStateFileError
err of
ConfigStateFileBadVersion PackageIdentifier
_ PackageIdentifier
_ Either ConfigStateFileError LocalBuildInfo
_ -> ComponentNames -> IO ComponentNames
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ComponentNames
ComponentNamesUnknown
ConfigStateFileError
_ -> Verbosity -> CabalInstallException -> IO ComponentNames
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ComponentNames)
-> CabalInstallException -> IO ComponentNames
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalInstallException
ConfigStateFileException (ConfigStateFileError -> FilePath
forall a. Show a => a -> FilePath
show ConfigStateFileError
err)
Right LocalBuildInfo
lbi -> do
let pkgDescr :: PackageDescription
pkgDescr = LocalBuildInfo -> PackageDescription
LBI.localPkgDescr LocalBuildInfo
lbi
names :: [ComponentName]
names =
(Component -> ComponentName) -> [Component] -> [ComponentName]
forall a b. (a -> b) -> [a] -> [b]
map Component -> ComponentName
LBI.componentName
([Component] -> [ComponentName])
-> ([Component] -> [Component]) -> [Component] -> [ComponentName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Component -> Bool) -> [Component] -> [Component]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (Component -> BuildInfo) -> Component -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> BuildInfo
LBI.componentBuildInfo)
([Component] -> [Component])
-> ([Component] -> [Component]) -> [Component] -> [Component]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Component -> Bool) -> [Component] -> [Component]
forall a. (a -> Bool) -> [a] -> [a]
filter Component -> Bool
compPred
([Component] -> [ComponentName]) -> [Component] -> [ComponentName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Component]
LBI.pkgComponents PackageDescription
pkgDescr
if [ComponentName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ComponentName]
names
then do
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Package has no buildable "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetsDescr
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."
IO ComponentNames
forall a. IO a
exitSuccess
else ComponentNames -> IO ComponentNames
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentNames -> IO ComponentNames)
-> ComponentNames -> IO ComponentNames
forall a b. (a -> b) -> a -> b
$! ([ComponentName] -> ComponentNames
ComponentNames [ComponentName]
names)
benchmarkAction
:: (BuildFlags, BenchmarkFlags)
-> [String]
-> GlobalFlags
-> IO ()
benchmarkAction :: (BuildFlags, BenchmarkFlags) -> [FilePath] -> Action
benchmarkAction
(BuildFlags
buildFlags, BenchmarkFlags
benchmarkFlags)
[FilePath]
extraArgs
GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity =
Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault
Verbosity
normal
(BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
buildFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags)
let buildFlags' =
BuildFlags
buildFlags
{ buildVerbosity = benchmarkVerbosity benchmarkFlags
}
let checkFlags = (Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b)
forall a. (Any -> a -> IO (Any, a)) -> Check a
Check ((Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b))
-> (Any -> (ConfigFlags, b) -> IO (Any, (ConfigFlags, b)))
-> Check (ConfigFlags, b)
forall a b. (a -> b) -> a -> b
$ \Any
_ flags :: (ConfigFlags, b)
flags@(ConfigFlags
configFlags, b
configExFlags) ->
if Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
configFlags)
then (Any, (ConfigFlags, b)) -> IO (Any, (ConfigFlags, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any
forall a. Monoid a => a
mempty, (ConfigFlags, b)
flags)
else do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"reconfiguring to enable benchmarks"
let flags' :: (ConfigFlags, b)
flags' =
( ConfigFlags
configFlags{configBenchmarks = toFlag True}
, b
configExFlags
)
(Any, (ConfigFlags, b)) -> IO (Any, (ConfigFlags, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, (ConfigFlags, b)
flags')
config' <-
reconfigure
configureAction
verbosity
distPref
(buildNumJobs buildFlags')
checkFlags
[]
globalFlags
config
nixShell verbosity distPref globalFlags config $ do
let setupOptions = SetupScriptOptions
defaultSetupScriptOptions{useDistPref = distPref}
benchmarkFlags' = BenchmarkFlags
benchmarkFlags{benchmarkDistPref = toFlag distPref}
names <-
componentNamesFromLBI
verbosity
distPref
"benchmarks"
(\Component
c -> case Component
c of LBI.CBench{} -> Bool
True; Component
_ -> Bool
False)
let extraArgs'
| [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraArgs = case ComponentNames
names of
ComponentNames
ComponentNamesUnknown -> []
ComponentNames [ComponentName]
names' ->
[ UnqualComponentName -> FilePath
Make.unUnqualComponentName UnqualComponentName
name
| LBI.CBenchName UnqualComponentName
name <- [ComponentName]
names'
]
| Bool
otherwise = [FilePath]
extraArgs
build verbosity config' distPref buildFlags' extraArgs'
setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs')
haddockAction :: HaddockFlags -> [String] -> Action
haddockAction :: HaddockFlags -> [FilePath] -> Action
haddockAction HaddockFlags
haddockFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
haddockFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (haddockDistPref haddockFlags)
config' <-
reconfigure
configureAction
verbosity
distPref
NoFlag
mempty
[]
globalFlags
config
nixShell verbosity distPref globalFlags config $ do
let haddockFlags' =
HaddockFlags
defaultHaddockFlags
HaddockFlags -> HaddockFlags -> HaddockFlags
forall a. Monoid a => a -> a -> a
`mappend` SavedConfig -> HaddockFlags
savedHaddockFlags SavedConfig
config'
HaddockFlags -> HaddockFlags -> HaddockFlags
forall a. Monoid a => a -> a -> a
`mappend` HaddockFlags
haddockFlags{haddockDistPref = toFlag distPref}
setupScriptOptions =
SetupScriptOptions
defaultSetupScriptOptions
{ useDistPref = distPref
}
setupWrapper
verbosity
setupScriptOptions
Nothing
haddockCommand
(const haddockFlags')
(const extraArgs)
when (haddockForHackage haddockFlags == Flag ForHackage) $ do
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
let dest = FilePath
distPref FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
name = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
display (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-docs"
docDir = FilePath
distPref FilePath -> FilePath -> FilePath
</> FilePath
"doc" FilePath -> FilePath -> FilePath
</> FilePath
"html"
createTarGzFile dest docDir name
notice verbosity $ "Documentation tarball created: " ++ dest
cleanAction :: CleanFlags -> [String] -> Action
cleanAction :: CleanFlags -> [FilePath] -> Action
cleanAction CleanFlags
cleanFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
load <- IO SavedConfig -> IO (Either SomeException SavedConfig)
forall e a. Exception e => IO a -> IO (Either e a)
try (Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags)
let config = (SomeException -> SavedConfig)
-> (SavedConfig -> SavedConfig)
-> Either SomeException SavedConfig
-> SavedConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(SomeException e
_) -> SavedConfig
forall a. Monoid a => a
mempty) SavedConfig -> SavedConfig
forall a. a -> a
id Either SomeException SavedConfig
load
distPref <- findSavedDistPref config (cleanDistPref cleanFlags)
let setupScriptOptions =
SetupScriptOptions
defaultSetupScriptOptions
{ useDistPref = distPref
, useWin32CleanHack = True
}
cleanFlags' = CleanFlags
cleanFlags{cleanDistPref = toFlag distPref}
setupWrapper
verbosity
setupScriptOptions
Nothing
cleanCommand
(const cleanFlags')
(const extraArgs)
where
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (CleanFlags -> Flag Verbosity
cleanVerbosity CleanFlags
cleanFlags)
listAction :: ListFlags -> [String] -> Action
listAction :: ListFlags -> [FilePath] -> Action
listAction ListFlags
listFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ListFlags -> Flag Verbosity
listVerbosity ListFlags
listFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
let configFlags' = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
configFlags =
ConfigFlags
configFlags'
{ configPackageDBs =
configPackageDBs configFlags'
`mappend` listPackageDBs listFlags
, configHcPath = listHcPath listFlags
}
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
compProgdb <-
if listNeedsCompiler listFlags
then do
(comp, _, progdb) <- configCompilerAux' configFlags
return (Just (comp, progdb))
else return Nothing
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Maybe (Compiler, ProgramDb)
-> ListFlags
-> [FilePath]
-> IO ()
List.list
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags)
RepoContext
repoContext
Maybe (Compiler, ProgramDb)
compProgdb
ListFlags
listFlags
[FilePath]
extraArgs
infoAction :: InfoFlags -> [String] -> Action
infoAction :: InfoFlags -> [FilePath] -> Action
infoAction InfoFlags
infoFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (InfoFlags -> Flag Verbosity
infoVerbosity InfoFlags
infoFlags)
targets <- Verbosity -> [FilePath] -> IO [UserTarget]
readUserTargets Verbosity
verbosity [FilePath]
extraArgs
config <- loadConfigOrSandboxConfig verbosity globalFlags
let configFlags' = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
configFlags =
ConfigFlags
configFlags'
{ configPackageDBs =
configPackageDBs configFlags'
`mappend` infoPackageDBs infoFlags
}
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, _, progdb) <- configCompilerAuxEx configFlags
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> ProgramDb
-> GlobalFlags
-> InfoFlags
-> [UserTarget]
-> IO ()
List.info
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags)
RepoContext
repoContext
Compiler
comp
ProgramDb
progdb
GlobalFlags
globalFlags'
InfoFlags
infoFlags
[UserTarget]
targets
fetchAction :: FetchFlags -> [String] -> Action
fetchAction :: FetchFlags -> [FilePath] -> Action
fetchAction FetchFlags
fetchFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (FetchFlags -> Flag Verbosity
fetchVerbosity FetchFlags
fetchFlags)
targets <- Verbosity -> [FilePath] -> IO [UserTarget]
readUserTargets Verbosity
verbosity [FilePath]
extraArgs
config <- loadConfig verbosity (globalConfigFile globalFlags)
let configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FetchFlags
-> [UserTarget]
-> IO ()
fetch
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags)
RepoContext
repoContext
Compiler
comp
Platform
platform
ProgramDb
progdb
GlobalFlags
globalFlags'
FetchFlags
fetchFlags
[UserTarget]
targets
freezeAction :: FreezeFlags -> [String] -> Action
freezeAction :: FreezeFlags -> [FilePath] -> Action
freezeAction FreezeFlags
freezeFlags [FilePath]
_extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (FreezeFlags -> Flag Verbosity
freezeVerbosity FreezeFlags
freezeFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config NoFlag
nixShell verbosity distPref globalFlags config $ do
let configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FreezeFlags
-> IO ()
freeze
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags)
RepoContext
repoContext
Compiler
comp
Platform
platform
ProgramDb
progdb
GlobalFlags
globalFlags'
FreezeFlags
freezeFlags
genBoundsAction :: FreezeFlags -> [String] -> GlobalFlags -> IO ()
genBoundsAction :: FreezeFlags -> [FilePath] -> Action
genBoundsAction FreezeFlags
freezeFlags [FilePath]
_extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (FreezeFlags -> Flag Verbosity
freezeVerbosity FreezeFlags
freezeFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config NoFlag
nixShell verbosity distPref globalFlags config $ do
let configFlags = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
config
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, platform, progdb) <- configCompilerAux' configFlags
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> GlobalFlags
-> FreezeFlags
-> IO ()
genBounds
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
configFlags)
RepoContext
repoContext
Compiler
comp
Platform
platform
ProgramDb
progdb
GlobalFlags
globalFlags'
FreezeFlags
freezeFlags
uploadAction :: UploadFlags -> [String] -> Action
uploadAction :: UploadFlags -> [FilePath] -> Action
uploadAction UploadFlags
uploadFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
config <- Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig Verbosity
verbosity (GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags)
let uploadFlags' = SavedConfig -> UploadFlags
savedUploadFlags SavedConfig
config UploadFlags -> UploadFlags -> UploadFlags
forall a. Monoid a => a -> a -> a
`mappend` UploadFlags
uploadFlags
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
tarfiles = [FilePath]
extraArgs
when (null tarfiles && not (fromFlag (uploadDoc uploadFlags'))) $
dieWithException verbosity UploadAction
checkTarFiles extraArgs
maybe_password <-
case uploadPasswordCmd uploadFlags' of
Flag (FilePath
xs : [FilePath]
xss) ->
Password -> Maybe Password
forall a. a -> Maybe a
Just (Password -> Maybe Password)
-> (FilePath -> Password) -> FilePath -> Maybe Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Password
Password
(FilePath -> Maybe Password) -> IO FilePath -> IO (Maybe Password)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput
Verbosity
verbosity
(FilePath -> [FilePath] -> ProgramInvocation
simpleProgramInvocation FilePath
xs [FilePath]
xss)
Flag [FilePath]
_ -> Maybe Password -> IO (Maybe Password)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Password -> IO (Maybe Password))
-> Maybe Password -> IO (Maybe Password)
forall a b. (a -> b) -> a -> b
$ Flag Password -> Maybe Password
forall a. Flag a -> Maybe a
flagToMaybe (Flag Password -> Maybe Password)
-> Flag Password -> Maybe Password
forall a b. (a -> b) -> a -> b
$ UploadFlags -> Flag Password
uploadPassword UploadFlags
uploadFlags'
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext -> do
if Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (UploadFlags -> Flag Bool
uploadDoc UploadFlags
uploadFlags')
then do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
tarfiles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
UploadActionDocumentation
tarfile <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SavedConfig -> IO FilePath
generateDocTarball SavedConfig
config) FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe [FilePath]
tarfiles
Upload.uploadDoc
verbosity
repoContext
(flagToMaybe $ uploadToken uploadFlags')
(flagToMaybe $ uploadUsername uploadFlags')
maybe_password
(fromFlag (uploadCandidate uploadFlags'))
tarfile
else do
Verbosity
-> RepoContext
-> Maybe Token
-> Maybe Username
-> Maybe Password
-> IsCandidate
-> [FilePath]
-> IO ()
Upload.upload
Verbosity
verbosity
RepoContext
repoContext
(Flag Token -> Maybe Token
forall a. Flag a -> Maybe a
flagToMaybe (Flag Token -> Maybe Token) -> Flag Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ UploadFlags -> Flag Token
uploadToken UploadFlags
uploadFlags')
(Flag Username -> Maybe Username
forall a. Flag a -> Maybe a
flagToMaybe (Flag Username -> Maybe Username)
-> Flag Username -> Maybe Username
forall a b. (a -> b) -> a -> b
$ UploadFlags -> Flag Username
uploadUsername UploadFlags
uploadFlags')
Maybe Password
maybe_password
(Flag IsCandidate -> IsCandidate
forall a. WithCallStack (Flag a -> a)
fromFlag (UploadFlags -> Flag IsCandidate
uploadCandidate UploadFlags
uploadFlags'))
[FilePath]
tarfiles
where
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (UploadFlags -> Flag Verbosity
uploadVerbosity UploadFlags
uploadFlags)
checkTarFiles :: [FilePath] -> IO ()
checkTarFiles [FilePath]
tarfiles
| Bool -> Bool
not ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
otherFiles) =
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> CabalInstallException
UploadActionOnlyArchives [FilePath]
otherFiles
| Bool
otherwise =
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do
exists <- FilePath -> IO Bool
doesFileExist FilePath
tarfile
unless exists $ dieWithException verbosity $ FileNotFound tarfile
| FilePath
tarfile <- [FilePath]
tarfiles
]
where
otherFiles :: [FilePath]
otherFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isTarGzFile) [FilePath]
tarfiles
isTarGzFile :: FilePath -> Bool
isTarGzFile FilePath
file = case FilePath -> (FilePath, FilePath)
splitExtension FilePath
file of
(FilePath
file', FilePath
".gz") -> FilePath -> FilePath
takeExtension FilePath
file' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".tar"
(FilePath, FilePath)
_ -> Bool
False
generateDocTarball :: SavedConfig -> IO FilePath
generateDocTarball SavedConfig
config = do
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"No documentation tarball specified. "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Building a documentation tarball with default settings...\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"If you need to customise Haddock options, "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"run 'haddock --for-hackage' first "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"to generate a documentation tarball."
HaddockFlags -> [FilePath] -> Action
haddockAction
(HaddockFlags
defaultHaddockFlags{haddockForHackage = Flag ForHackage})
[]
GlobalFlags
globalFlags
distPref <- SavedConfig -> Flag FilePath -> IO FilePath
findSavedDistPref SavedConfig
config Flag FilePath
forall a. Flag a
NoFlag
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
return $ distPref </> display (packageId pkg) ++ "-docs" <.> "tar.gz"
checkAction :: CheckFlags -> [String] -> Action
checkAction :: CheckFlags -> [FilePath] -> Action
checkAction CheckFlags
checkFlags [FilePath]
extraArgs GlobalFlags
_globalFlags = do
let verbosityFlag :: Flag Verbosity
verbosityFlag = CheckFlags -> Flag Verbosity
checkVerbosity CheckFlags
checkFlags
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag Flag Verbosity
verbosityFlag
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraArgs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> CabalInstallException
CheckAction [FilePath]
extraArgs
allOk <- Verbosity -> [FilePath] -> IO Bool
Check.check (Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag Flag Verbosity
verbosityFlag) (CheckFlags -> [FilePath]
checkIgnore CheckFlags
checkFlags)
unless allOk exitFailure
formatAction :: Flag Verbosity -> [String] -> Action
formatAction :: Flag Verbosity -> [FilePath] -> Action
formatAction Flag Verbosity
verbosityFlag [FilePath]
extraArgs GlobalFlags
_globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag Flag Verbosity
verbosityFlag
path <- case [FilePath]
extraArgs of
[] -> do
cwd <- IO FilePath
getCurrentDirectory
tryFindPackageDesc verbosity cwd
(FilePath
p : [FilePath]
_) -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p
pkgDesc <- readGenericPackageDescription verbosity path
writeGenericPackageDescription path pkgDesc
reportAction :: ReportFlags -> [String] -> Action
reportAction :: ReportFlags -> [FilePath] -> Action
reportAction ReportFlags
reportFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ReportFlags -> Flag Verbosity
reportVerbosity ReportFlags
reportFlags)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraArgs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> CabalInstallException
ReportAction [FilePath]
extraArgs
config <- Verbosity -> Flag FilePath -> IO SavedConfig
loadConfig Verbosity
verbosity (GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags)
let globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
reportFlags' = SavedConfig -> ReportFlags
savedReportFlags SavedConfig
config ReportFlags -> ReportFlags -> ReportFlags
forall a. Monoid a => a -> a -> a
`mappend` ReportFlags
reportFlags
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> RepoContext
-> Maybe Token
-> Maybe Username
-> Maybe Password
-> IO ()
Upload.report
Verbosity
verbosity
RepoContext
repoContext
(Flag Token -> Maybe Token
forall a. Flag a -> Maybe a
flagToMaybe (Flag Token -> Maybe Token) -> Flag Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ ReportFlags -> Flag Token
reportToken ReportFlags
reportFlags')
(Flag Username -> Maybe Username
forall a. Flag a -> Maybe a
flagToMaybe (Flag Username -> Maybe Username)
-> Flag Username -> Maybe Username
forall a b. (a -> b) -> a -> b
$ ReportFlags -> Flag Username
reportUsername ReportFlags
reportFlags')
(Flag Password -> Maybe Password
forall a. Flag a -> Maybe a
flagToMaybe (Flag Password -> Maybe Password)
-> Flag Password -> Maybe Password
forall a b. (a -> b) -> a -> b
$ ReportFlags -> Flag Password
reportPassword ReportFlags
reportFlags')
runAction :: BuildFlags -> [String] -> Action
runAction :: BuildFlags -> [FilePath] -> Action
runAction BuildFlags
buildFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
buildFlags)
config <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
distPref <- findSavedDistPref config (buildDistPref buildFlags)
config' <-
reconfigure
configureAction
verbosity
distPref
(buildNumJobs buildFlags)
mempty
[]
globalFlags
config
nixShell verbosity distPref globalFlags config $ do
lbi <- getPersistBuildConfig distPref
(exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs
build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)]
run verbosity lbi exe exeArgs
getAction :: GetFlags -> [String] -> Action
getAction :: GetFlags -> [FilePath] -> Action
getAction GetFlags
getFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (GetFlags -> Flag Verbosity
getVerbosity GetFlags
getFlags)
targets <- Verbosity -> [FilePath] -> IO [UserTarget]
readUserTargets Verbosity
verbosity [FilePath]
extraArgs
config <- loadConfigOrSandboxConfig verbosity globalFlags
let globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
config GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
withRepoContext verbosity (savedGlobalFlags config) $ \RepoContext
repoContext ->
Verbosity
-> RepoContext -> GlobalFlags -> GetFlags -> [UserTarget] -> IO ()
get
Verbosity
verbosity
RepoContext
repoContext
GlobalFlags
globalFlags'
GetFlags
getFlags
[UserTarget]
targets
unpackAction :: GetFlags -> [String] -> Action
unpackAction :: GetFlags -> [FilePath] -> Action
unpackAction GetFlags
getFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
GetFlags -> [FilePath] -> Action
getAction GetFlags
getFlags [FilePath]
extraArgs GlobalFlags
globalFlags
initAction :: InitFlags -> [String] -> Action
initAction :: InitFlags -> [FilePath] -> Action
initAction InitFlags
initFlags [FilePath]
extraArgs GlobalFlags
globalFlags = do
case [FilePath]
extraArgs of
[] -> IO ()
initAction'
[FilePath
projectDir] -> do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
projectDir
FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
projectDir IO ()
initAction'
[FilePath]
_ -> Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
InitAction
where
initAction' :: IO ()
initAction' = do
confFlags <- Verbosity -> GlobalFlags -> IO SavedConfig
loadConfigOrSandboxConfig Verbosity
verbosity GlobalFlags
globalFlags
let confFlags' = SavedConfig -> ConfigFlags
savedConfigureFlags SavedConfig
confFlags ConfigFlags -> ConfigFlags -> ConfigFlags
forall a. Monoid a => a -> a -> a
`mappend` ConfigFlags
compFlags
initFlags' = SavedConfig -> InitFlags
savedInitFlags SavedConfig
confFlags InitFlags -> InitFlags -> InitFlags
forall a. Monoid a => a -> a -> a
`mappend` InitFlags
initFlags
globalFlags' = SavedConfig -> GlobalFlags
savedGlobalFlags SavedConfig
confFlags GlobalFlags -> GlobalFlags -> GlobalFlags
forall a. Monoid a => a -> a -> a
`mappend` GlobalFlags
globalFlags
(comp, _, progdb) <- configCompilerAux' confFlags'
withRepoContext verbosity globalFlags' $ \RepoContext
repoContext ->
Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> ProgramDb
-> InitFlags
-> IO ()
initCmd
Verbosity
verbosity
(ConfigFlags -> PackageDBStack
configPackageDB' ConfigFlags
confFlags')
RepoContext
repoContext
Compiler
comp
ProgramDb
progdb
InitFlags
initFlags'
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (InitFlags -> Flag Verbosity
initVerbosity InitFlags
initFlags)
compFlags :: ConfigFlags
compFlags = ConfigFlags
forall a. Monoid a => a
mempty{configHcPath = initHcPath initFlags}
userConfigAction :: UserConfigFlags -> [String] -> Action
userConfigAction :: UserConfigFlags -> [FilePath] -> Action
userConfigAction UserConfigFlags
ucflags [FilePath]
extraArgs GlobalFlags
globalFlags = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (UserConfigFlags -> Flag Verbosity
userConfigVerbosity UserConfigFlags
ucflags)
frc :: Bool
frc = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (UserConfigFlags -> Flag Bool
userConfigForce UserConfigFlags
ucflags)
extraLines :: [FilePath]
extraLines = Flag [FilePath] -> [FilePath]
forall a. WithCallStack (Flag a -> a)
fromFlag (UserConfigFlags -> Flag [FilePath]
userConfigAppendLines UserConfigFlags
ucflags)
case [FilePath]
extraArgs of
(FilePath
"init" : [FilePath]
_) -> do
path <- IO FilePath
configFile
fileExists <- doesFileExist path
if (not fileExists || (fileExists && frc))
then void $ createDefaultConfigFile verbosity extraLines path
else dieWithException verbosity $ UserConfigAction path
(FilePath
"diff" : [FilePath]
_) -> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
putStrLn ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> GlobalFlags -> [FilePath] -> IO [FilePath]
userConfigDiff Verbosity
verbosity GlobalFlags
globalFlags [FilePath]
extraLines
(FilePath
"update" : [FilePath]
_) -> Verbosity -> GlobalFlags -> [FilePath] -> IO ()
userConfigUpdate Verbosity
verbosity GlobalFlags
globalFlags [FilePath]
extraLines
[] -> Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
SpecifySubcommand
[FilePath]
_ -> Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> CabalInstallException
UnknownUserConfigSubcommand [FilePath]
extraArgs
where
configFile :: IO FilePath
configFile = Flag FilePath -> IO FilePath
getConfigFilePath (GlobalFlags -> Flag FilePath
globalConfigFile GlobalFlags
globalFlags)
actAsSetupAction :: ActAsSetupFlags -> [String] -> Action
actAsSetupAction :: ActAsSetupFlags -> [FilePath] -> Action
actAsSetupAction ActAsSetupFlags
actAsSetupFlags [FilePath]
args GlobalFlags
_globalFlags =
let bt :: BuildType
bt = Flag BuildType -> BuildType
forall a. WithCallStack (Flag a -> a)
fromFlag (ActAsSetupFlags -> Flag BuildType
actAsSetupBuildType ActAsSetupFlags
actAsSetupFlags)
in case BuildType
bt of
BuildType
Simple -> [FilePath] -> IO ()
Simple.defaultMainArgs [FilePath]
args
BuildType
Configure ->
UserHooks -> [FilePath] -> IO ()
Simple.defaultMainWithHooksArgs
UserHooks
Simple.autoconfUserHooks
[FilePath]
args
BuildType
Make -> [FilePath] -> IO ()
Make.defaultMainArgs [FilePath]
args
BuildType
Custom -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"actAsSetupAction Custom"
manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action
manpageAction :: forall action.
[CommandSpec action] -> ManpageFlags -> [FilePath] -> Action
manpageAction [CommandSpec action]
commands ManpageFlags
flags [FilePath]
extraArgs GlobalFlags
_ = do
let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ManpageFlags -> Flag Verbosity
manpageVerbosity ManpageFlags
flags)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraArgs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ()) -> CabalInstallException -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> CabalInstallException
ManpageAction [FilePath]
extraArgs
pname <- IO FilePath
getProgName
let cabalCmd =
if FilePath -> FilePath
takeExtension FilePath
pname FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".exe"
then FilePath -> FilePath
dropExtension FilePath
pname
else FilePath
pname
manpageCmd cabalCmd commands flags