diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 74ff94ca4c2..2d35baa41cb 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -326,6 +326,20 @@ library Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo Distribution.Simple.ConfigureScript + Distribution.Simple.Setup.Benchmark + Distribution.Simple.Setup.Build + Distribution.Simple.Setup.Clean + Distribution.Simple.Setup.Common + Distribution.Simple.Setup.Config + Distribution.Simple.Setup.Copy + Distribution.Simple.Setup.Global + Distribution.Simple.Setup.Haddock + Distribution.Simple.Setup.Hscolour + Distribution.Simple.Setup.Install + Distribution.Simple.Setup.Register + Distribution.Simple.Setup.Repl + Distribution.Simple.Setup.SDist + Distribution.Simple.Setup.Test Distribution.ZinzaPrelude Paths_Cabal diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs index e2a75946d37..60764fdf32d 100644 --- a/Cabal/src/Distribution/Backpack/Configure.hs +++ b/Cabal/src/Distribution/Backpack/Configure.hs @@ -36,7 +36,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.PackageDescription import Distribution.ModuleName -import Distribution.Simple.Setup as Setup +import Distribution.Simple.Flag import Distribution.Simple.LocalBuildInfo import Distribution.Types.AnnotatedId import Distribution.Types.ComponentRequestedSpec diff --git a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs index 69178e048ce..5f40fc6085a 100644 --- a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs @@ -36,7 +36,7 @@ import Distribution.Types.ComponentInclude import Distribution.Package import Distribution.PackageDescription import Distribution.Simple.BuildToolDepends -import Distribution.Simple.Setup as Setup +import Distribution.Simple.Flag ( Flag ) import Distribution.Simple.LocalBuildInfo import Distribution.Utils.LogProgress import Distribution.Utils.MapAccum diff --git a/Cabal/src/Distribution/Backpack/Id.hs b/Cabal/src/Distribution/Backpack/Id.hs index 6f78418afa1..9e1de85028f 100644 --- a/Cabal/src/Distribution/Backpack/Id.hs +++ b/Cabal/src/Distribution/Backpack/Id.hs @@ -13,7 +13,7 @@ import Distribution.Compat.Prelude import Distribution.Types.UnqualComponentName import Distribution.Simple.Compiler import Distribution.PackageDescription -import Distribution.Simple.Setup as Setup +import Distribution.Simple.Flag ( Flag(..) ) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.LocalBuildInfo import Distribution.Types.ComponentId diff --git a/Cabal/src/Distribution/Simple/Bench.hs b/Cabal/src/Distribution/Simple/Bench.hs index d2a3b51066f..6484654c0ca 100644 --- a/Cabal/src/Distribution/Simple/Bench.hs +++ b/Cabal/src/Distribution/Simple/Bench.hs @@ -27,7 +27,8 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI -import Distribution.Simple.Setup +import Distribution.Simple.Flag ( fromFlag ) +import Distribution.Simple.Setup.Benchmark import Distribution.Simple.UserHooks import Distribution.Simple.Utils import Distribution.Pretty diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 7f658c5608f..04659830f12 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -65,7 +65,10 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.ModuleName as ModuleName -import Distribution.Simple.Setup +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Build +import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Repl import Distribution.Simple.BuildTarget import Distribution.Simple.BuildToolDepends import Distribution.Simple.PreProcess diff --git a/Cabal/src/Distribution/Simple/BuildPaths.hs b/Cabal/src/Distribution/Simple/BuildPaths.hs index 189de54785f..f909078a1bf 100644 --- a/Cabal/src/Distribution/Simple/BuildPaths.hs +++ b/Cabal/src/Distribution/Simple/BuildPaths.hs @@ -49,7 +49,8 @@ import Distribution.ModuleName as ModuleName import Distribution.Compiler import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Setup +import Distribution.Simple.Setup.Haddock (HaddockTarget(..)) +import Distribution.Simple.Setup.Common (defaultDistPref) import Distribution.Pretty import Distribution.System import Distribution.Verbosity diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index ac7bd852f0d..8af7eb79212 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -73,7 +73,8 @@ import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) import Distribution.Simple.BuildToolDepends import Distribution.Simple.Program -import Distribution.Simple.Setup as Setup +import Distribution.Simple.Setup.Config as Setup +import Distribution.Simple.Setup.Common as Setup import Distribution.Simple.BuildTarget import Distribution.Simple.LocalBuildInfo import Distribution.Types.PackageVersionConstraint diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs index 9c3e5c8874b..23ad94f0d75 100644 --- a/Cabal/src/Distribution/Simple/ConfigureScript.hs +++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs @@ -25,7 +25,8 @@ import Distribution.Compat.Prelude import Distribution.PackageDescription import Distribution.Simple.Program import Distribution.Simple.Program.Db -import Distribution.Simple.Setup +import Distribution.Simple.Setup.Common +import Distribution.Simple.Setup.Config import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Utils diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index d8e48adb425..d988864c282 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -98,8 +98,9 @@ import qualified Distribution.Simple.Program.Ar as Ar import qualified Distribution.Simple.Program.Ld as Ld import qualified Distribution.Simple.Program.Strip as Strip import Distribution.Simple.Program.GHC -import Distribution.Simple.Setup -import qualified Distribution.Simple.Setup as Cabal +import Distribution.Simple.Flag ( Flag(Flag), fromFlag, fromFlagOrDefault, toFlag ) +import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Repl import Distribution.Simple.Compiler import Distribution.Version import Distribution.System @@ -491,19 +492,19 @@ getInstalledPackagesMonitorFiles verbosity platform progdb = -- ----------------------------------------------------------------------------- -- Building a library -buildLib :: Verbosity -> Cabal.Flag (Maybe Int) +buildLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildLib = buildOrReplLib Nothing replLib :: ReplOptions -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () replLib = buildOrReplLib . Just buildOrReplLib :: Maybe ReplOptions -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do @@ -658,7 +659,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do then do runGhcProg vanillaSharedOpts case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of - (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> + (Flag dynDir, Flag vanillaDir) -> -- When the vanilla and shared library builds are done -- in one pass, only one set of HPC module interfaces -- are generated. This set should suffice for both @@ -1001,14 +1002,14 @@ startInterpreter verbosity progdb comp platform packageDBs = do -- | Build a foreign library buildFLib - :: Verbosity -> Cabal.Flag (Maybe Int) + :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib replFLib :: ReplOptions -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () replFLib replFlags v njobs pkg lbi = @@ -1017,14 +1018,14 @@ replFLib replFlags v njobs pkg lbi = -- | Build an executable with GHC. -- buildExe - :: Verbosity -> Cabal.Flag (Maybe Int) + :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe replExe :: ReplOptions -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () replExe replFlags v njobs pkg lbi = @@ -1312,7 +1313,7 @@ replNoLoad replFlags l | otherwise = l -- | Generic build function. See comment for 'GBuildMode'. -gbuild :: Verbosity -> Cabal.Flag (Maybe Int) +gbuild :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> GBuildMode -> ComponentLocalBuildInfo -> IO () gbuild verbosity numJobs pkg_descr lbi bm clbi = do diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 221a695b6df..332fe9cce17 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -57,7 +57,7 @@ import Distribution.PackageDescription import Distribution.Lex import Distribution.Simple.Compiler import Distribution.Simple.Program.GHC -import Distribution.Simple.Setup +import Distribution.Simple.Flag ( Flag, maybeToFlag, toFlag ) import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program import Distribution.Simple.LocalBuildInfo diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index c8721746a6a..775948c74ac 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -61,8 +61,8 @@ import Distribution.Simple.Program import qualified Distribution.Simple.Program.HcPkg as HcPkg import qualified Distribution.Simple.Program.Strip as Strip import Distribution.Simple.Program.GHC -import Distribution.Simple.Setup -import qualified Distribution.Simple.Setup as Cabal +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Config import Distribution.Simple.Compiler import Distribution.CabalSpecVersion import Distribution.Version @@ -372,19 +372,19 @@ toJSLibName lib -- ----------------------------------------------------------------------------- -- Building a library -buildLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription +buildLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildLib = buildOrReplLib Nothing replLib :: [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () replLib = buildOrReplLib . Just buildOrReplLib :: Maybe [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do @@ -493,7 +493,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do then do runGhcjsProg vanillaSharedOpts case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of - (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> + (Flag dynDir, Flag vanillaDir) -> -- When the vanilla and shared library builds are done -- in one pass, only one set of HPC module interfaces -- are generated. This set should suffice for both @@ -740,14 +740,14 @@ startInterpreter verbosity progdb comp platform packageDBs = do -- | Build a foreign library buildFLib - :: Verbosity -> Cabal.Flag (Maybe Int) + :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib replFLib :: [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () replFLib replFlags v njobs pkg lbi = @@ -756,14 +756,14 @@ replFLib replFlags v njobs pkg lbi = -- | Build an executable with GHC. -- buildExe - :: Verbosity -> Cabal.Flag (Maybe Int) + :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe replExe :: [String] -> Verbosity - -> Cabal.Flag (Maybe Int) -> PackageDescription + -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () replExe replFlags v njobs pkg lbi = @@ -1044,7 +1044,7 @@ isHaskell :: FilePath -> Bool isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"] -- | Generic build function. See comment for 'GBuildMode'. -gbuild :: Verbosity -> Cabal.Flag (Maybe Int) +gbuild :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> GBuildMode -> ComponentLocalBuildInfo -> IO () gbuild verbosity numJobs pkg_descr lbi bm clbi = do diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs index aa616ec0249..950a6761df5 100644 --- a/Cabal/src/Distribution/Simple/Haddock.hs +++ b/Cabal/src/Distribution/Simple/Haddock.hs @@ -51,7 +51,9 @@ import Distribution.Simple.Program.GHC import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Program import Distribution.Simple.PreProcess -import Distribution.Simple.Setup +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Haddock +import Distribution.Simple.Setup.Hscolour import Distribution.Simple.Build import Distribution.Simple.BuildTarget import Distribution.Simple.InstallDirs diff --git a/Cabal/src/Distribution/Simple/Install.hs b/Cabal/src/Distribution/Simple/Install.hs index de8a380ab55..432a94c7f22 100644 --- a/Cabal/src/Distribution/Simple/Install.hs +++ b/Cabal/src/Distribution/Simple/Install.hs @@ -40,8 +40,12 @@ import Distribution.Simple.Utils , die', info, noticeNoWrap, warn ) import Distribution.Simple.Compiler ( CompilerFlavor(..), compilerFlavor ) -import Distribution.Simple.Setup - ( CopyFlags(..), fromFlag, HaddockTarget(ForDevelopment) ) +import Distribution.Simple.Flag + ( fromFlag ) +import Distribution.Simple.Setup.Copy + ( CopyFlags(..) ) +import Distribution.Simple.Setup.Haddock + ( HaddockTarget(ForDevelopment) ) import Distribution.Simple.BuildTarget import Distribution.Utils.Path (getSymbolicPath) diff --git a/Cabal/src/Distribution/Simple/Program/Ar.hs b/Cabal/src/Distribution/Simple/Program/Ar.hs index 7a96c3eb500..6c2ef09ecca 100644 --- a/Cabal/src/Distribution/Simple/Program/Ar.hs +++ b/Cabal/src/Distribution/Simple/Program/Ar.hs @@ -33,8 +33,10 @@ import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Program.Run ( programInvocation, multiStageProgramInvocation , runProgramInvocation ) -import Distribution.Simple.Setup - ( fromFlagOrDefault, configUseResponseFiles ) +import Distribution.Simple.Flag + ( fromFlagOrDefault ) +import Distribution.Simple.Setup.Config + ( configUseResponseFiles ) import Distribution.Simple.Utils ( defaultTempFileOptions, dieWithLocation', withTempDirectory ) import Distribution.System diff --git a/Cabal/src/Distribution/Simple/Program/Ld.hs b/Cabal/src/Distribution/Simple/Program/Ld.hs index 01d2546b1b6..9115d38d9d8 100644 --- a/Cabal/src/Distribution/Simple/Program/Ld.hs +++ b/Cabal/src/Distribution/Simple/Program/Ld.hs @@ -27,8 +27,10 @@ import Distribution.Simple.Program.Run , runProgramInvocation ) import Distribution.Simple.Program.Types ( ConfiguredProgram(..) ) -import Distribution.Simple.Setup - ( fromFlagOrDefault, configUseResponseFiles ) +import Distribution.Simple.Flag + ( fromFlagOrDefault ) +import Distribution.Simple.Setup.Config + ( configUseResponseFiles ) import Distribution.Simple.Utils ( defaultTempFileOptions ) import Distribution.Verbosity diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index c4dc22c7b7a..f71f340f44b 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/Cabal/src/Distribution/Simple/Register.hs @@ -70,7 +70,8 @@ import Distribution.Simple.Compiler import Distribution.Simple.Program import Distribution.Simple.Program.Script import qualified Distribution.Simple.Program.HcPkg as HcPkg -import Distribution.Simple.Setup +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Register import Distribution.PackageDescription import Distribution.Package import Distribution.License (licenseToSPDX, licenseFromSPDX) diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 36f6aa22f15..e03cafd7305 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -14,8 +14,7 @@ -- Maintainer : cabal-devel@haskell.org -- Portability : portable -- --- This is a big module, but not very complicated. The code is very regular --- and repetitive. It defines the command line interface for all the Cabal +-- This module defines the command line interface for all the Cabal -- commands. For each command (like @configure@, @build@ etc) it defines a type -- that holds all the flags, the default set of flags and a 'CommandUI' that -- maps command line flags to and from the corresponding flags type. @@ -81,2480 +80,25 @@ module Distribution.Simple.Setup ( optionVerbosity, optionNumJobs) where import Prelude () -import Distribution.Compat.Prelude hiding (get) -import Distribution.Compiler -import Distribution.ReadE -import Distribution.Parsec -import Distribution.Pretty -import qualified Distribution.Compat.CharParsing as P -import qualified Text.PrettyPrint as Disp -import Distribution.ModuleName -import Distribution.PackageDescription -import Distribution.Simple.Command hiding (boolOpt, boolOpt') -import qualified Distribution.Simple.Command as Command -import Distribution.Simple.Compiler import Distribution.Simple.Flag -import Distribution.Simple.Utils -import Distribution.Simple.Program import Distribution.Simple.InstallDirs -import Distribution.Verbosity -import Distribution.Utils.NubList -import Distribution.Types.ComponentId import Distribution.Types.DumpBuildInfo -import Distribution.Types.GivenComponent -import Distribution.Types.Module -import Distribution.Types.PackageVersionConstraint -import Distribution.Compat.Stack -import Distribution.Compat.Semigroup (Last' (..), Option' (..)) - --- FIXME Not sure where this should live -defaultDistPref :: FilePath -defaultDistPref = "dist" - --- ------------------------------------------------------------ --- * Global flags --- ------------------------------------------------------------ - --- In fact since individual flags types are monoids and these are just sets of --- flags then they are also monoids pointwise. This turns out to be really --- useful. The mempty is the set of empty flags and mappend allows us to --- override specific flags. For example we can start with default flags and --- override with the ones we get from a file or the command line, or both. - --- | Flags that apply at the top level, not to any sub-command. -data GlobalFlags = GlobalFlags { - globalVersion :: Flag Bool, - globalNumericVersion :: Flag Bool - } deriving (Generic, Typeable) - -defaultGlobalFlags :: GlobalFlags -defaultGlobalFlags = GlobalFlags { - globalVersion = Flag False, - globalNumericVersion = Flag False - } - -globalCommand :: [Command action] -> CommandUI GlobalFlags -globalCommand commands = CommandUI - { commandName = "" - , commandSynopsis = "" - , commandUsage = \pname -> - "This Setup program uses the Haskell Cabal Infrastructure.\n" - ++ "See http://www.haskell.org/cabal/ for more information.\n" - ++ "\n" - ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n" - , commandDescription = Just $ \pname -> - let - commands' = commands ++ [commandAddAction helpCommandUI undefined] - cmdDescs = getNormalCommandDescriptions commands' - maxlen = maximum $ [length name | (name, _) <- cmdDescs] - align str = str ++ replicate (maxlen - length str) ' ' - in - "Commands:\n" - ++ unlines [ " " ++ align name ++ " " ++ descr - | (name, descr) <- cmdDescs ] - ++ "\n" - ++ "For more information about a command use\n" - ++ " " ++ pname ++ " COMMAND --help\n\n" - ++ "Typical steps for installing Cabal packages:\n" - ++ concat [ " " ++ pname ++ " " ++ x ++ "\n" - | x <- ["configure", "build", "install"]] - , commandNotes = Nothing - , commandDefaultFlags = defaultGlobalFlags - , commandOptions = \_ -> - [option ['V'] ["version"] - "Print version information" - globalVersion (\v flags -> flags { globalVersion = v }) - trueArg - ,option [] ["numeric-version"] - "Print just the version number" - globalNumericVersion (\v flags -> flags { globalNumericVersion = v }) - trueArg - ] - } - -emptyGlobalFlags :: GlobalFlags -emptyGlobalFlags = mempty - -instance Monoid GlobalFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup GlobalFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Config flags --- ------------------------------------------------------------ - --- | Flags to @configure@ command. --- --- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags' --- should be updated. --- IMPORTANT: every time a new flag is added, it should be added to the Eq instance -data ConfigFlags = ConfigFlags { - -- This is the same hack as in 'buildArgs' and 'copyArgs'. - -- TODO: Stop using this eventually when 'UserHooks' gets changed - configArgs :: [String], - - --FIXME: the configPrograms is only here to pass info through to configure - -- because the type of configure is constrained by the UserHooks. - -- when we change UserHooks next we should pass the initial - -- ProgramDb directly and not via ConfigFlags - configPrograms_ :: Option' (Last' ProgramDb), -- ^All programs that - -- @cabal@ may run - configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths - configProgramArgs :: [(String, [String])], -- ^user specified programs args - configProgramPathExtra :: NubList FilePath, -- ^Extend the $PATH - configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the - -- compiler, e.g. GHC. - configHcPath :: Flag FilePath, -- ^given compiler location - configHcPkg :: Flag FilePath, -- ^given hc-pkg location - configVanillaLib :: Flag Bool, -- ^Enable vanilla library - configProfLib :: Flag Bool, -- ^Enable profiling in the library - configSharedLib :: Flag Bool, -- ^Build shared library - configStaticLib :: Flag Bool, -- ^Build static library - configDynExe :: Flag Bool, -- ^Enable dynamic linking of the - -- executables. - configFullyStaticExe :: Flag Bool, -- ^Enable fully static linking of the - -- executables. - configProfExe :: Flag Bool, -- ^Enable profiling in the - -- executables. - configProf :: Flag Bool, -- ^Enable profiling in the library - -- and executables. - configProfDetail :: Flag ProfDetailLevel, -- ^Profiling detail level - -- in the library and executables. - configProfLibDetail :: Flag ProfDetailLevel, -- ^Profiling detail level - -- in the library - configConfigureArgs :: [String], -- ^Extra arguments to @configure@ - configOptimization :: Flag OptimisationLevel, -- ^Enable optimization. - configProgPrefix :: Flag PathTemplate, -- ^Installed executable prefix. - configProgSuffix :: Flag PathTemplate, -- ^Installed executable suffix. - configInstallDirs :: InstallDirs (Flag PathTemplate), -- ^Installation - -- paths - configScratchDir :: Flag FilePath, - configExtraLibDirs :: [FilePath], -- ^ path to search for extra libraries - configExtraLibDirsStatic :: [FilePath], -- ^ path to search for extra - -- libraries when linking - -- fully static executables - configExtraFrameworkDirs :: [FilePath], -- ^ path to search for extra - -- frameworks (OS X only) - configExtraIncludeDirs :: [FilePath], -- ^ path to search for header files - configIPID :: Flag String, -- ^ explicit IPID to be used - configCID :: Flag ComponentId, -- ^ explicit CID to be used - configDeterministic :: Flag Bool, -- ^ be as deterministic as possible - -- (e.g., invariant over GHC, database, - -- etc). Used by the test suite - - configDistPref :: Flag FilePath, -- ^"dist" prefix - configCabalFilePath :: Flag FilePath, -- ^ Cabal file to use - configVerbosity :: Flag Verbosity, -- ^verbosity level - configUserInstall :: Flag Bool, -- ^The --user\/--global flag - configPackageDBs :: [Maybe PackageDB], -- ^Which package DBs to use - configGHCiLib :: Flag Bool, -- ^Enable compiling library for GHCi - configSplitSections :: Flag Bool, -- ^Enable -split-sections with GHC - configSplitObjs :: Flag Bool, -- ^Enable -split-objs with GHC - configStripExes :: Flag Bool, -- ^Enable executable stripping - configStripLibs :: Flag Bool, -- ^Enable library stripping - configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for - -- dependencies. - configDependencies :: [GivenComponent], - -- ^The packages depended on. - configInstantiateWith :: [(ModuleName, Module)], - -- ^ The requested Backpack instantiation. If empty, either this - -- package does not use Backpack, or we just want to typecheck - -- the indefinite package. - configConfigurationsFlags :: FlagAssignment, - configTests :: Flag Bool, -- ^Enable test suite compilation - configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation - configCoverage :: Flag Bool, -- ^Enable program coverage - configLibCoverage :: Flag Bool, -- ^Enable program coverage (deprecated) - configExactConfiguration :: Flag Bool, - -- ^All direct dependencies and flags are provided on the command line by - -- the user via the '--dependency' and '--flags' options. - configFlagError :: Flag String, - -- ^Halt and show an error message indicating an error in flag assignment - configRelocatable :: Flag Bool, -- ^ Enable relocatable package built - configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. - configDumpBuildInfo :: Flag DumpBuildInfo, - -- ^ Should we dump available build information on build? - -- Dump build information to disk before attempting to build, - -- tooling can parse these files and use them to compile the - -- source files themselves. - configUseResponseFiles :: Flag Bool, - -- ^ Whether to use response files at all. They're used for such tools - -- as haddock, or ld. - configAllowDependingOnPrivateLibs :: Flag Bool - -- ^ Allow depending on private sublibraries. This is used by external - -- tools (like cabal-install) so they can add multiple-public-libraries - -- compatibility to older ghcs by checking visibility externally. - } - deriving (Generic, Read, Show, Typeable) - -instance Binary ConfigFlags -instance Structured ConfigFlags - --- | More convenient version of 'configPrograms'. Results in an --- 'error' if internal invariant is violated. -configPrograms :: WithCallStack (ConfigFlags -> ProgramDb) -configPrograms = fromMaybe (error "FIXME: remove configPrograms") . fmap getLast' - . getOption' . configPrograms_ - -instance Eq ConfigFlags where - (==) a b = - -- configPrograms skipped: not user specified, has no Eq instance - equal configProgramPaths - && equal configProgramArgs - && equal configProgramPathExtra - && equal configHcFlavor - && equal configHcPath - && equal configHcPkg - && equal configVanillaLib - && equal configProfLib - && equal configSharedLib - && equal configStaticLib - && equal configDynExe - && equal configFullyStaticExe - && equal configProfExe - && equal configProf - && equal configProfDetail - && equal configProfLibDetail - && equal configConfigureArgs - && equal configOptimization - && equal configProgPrefix - && equal configProgSuffix - && equal configInstallDirs - && equal configScratchDir - && equal configExtraLibDirs - && equal configExtraLibDirsStatic - && equal configExtraIncludeDirs - && equal configIPID - && equal configDeterministic - && equal configDistPref - && equal configVerbosity - && equal configUserInstall - && equal configPackageDBs - && equal configGHCiLib - && equal configSplitSections - && equal configSplitObjs - && equal configStripExes - && equal configStripLibs - && equal configConstraints - && equal configDependencies - && equal configConfigurationsFlags - && equal configTests - && equal configBenchmarks - && equal configCoverage - && equal configLibCoverage - && equal configExactConfiguration - && equal configFlagError - && equal configRelocatable - && equal configDebugInfo - && equal configDumpBuildInfo - && equal configUseResponseFiles - where - equal f = on (==) f a b - -configAbsolutePaths :: ConfigFlags -> IO ConfigFlags -configAbsolutePaths f = - (\v -> f { configPackageDBs = v }) - `liftM` traverse (maybe (return Nothing) (liftM Just . absolutePackageDBPath)) - (configPackageDBs f) - -defaultConfigFlags :: ProgramDb -> ConfigFlags -defaultConfigFlags progDb = emptyConfigFlags { - configArgs = [], - configPrograms_ = Option' (Just (Last' progDb)), - configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, - configVanillaLib = Flag True, - configProfLib = NoFlag, - configSharedLib = NoFlag, - configStaticLib = NoFlag, - configDynExe = Flag False, - configFullyStaticExe = Flag False, - configProfExe = NoFlag, - configProf = NoFlag, - configProfDetail = NoFlag, - configProfLibDetail= NoFlag, - configOptimization = Flag NormalOptimisation, - configProgPrefix = Flag (toPathTemplate ""), - configProgSuffix = Flag (toPathTemplate ""), - configDistPref = NoFlag, - configCabalFilePath = NoFlag, - configVerbosity = Flag normal, - configUserInstall = Flag False, --TODO: reverse this -#if defined(mingw32_HOST_OS) - -- See #8062 and GHC #21019. - configGHCiLib = Flag False, -#else - configGHCiLib = NoFlag, -#endif - configSplitSections = Flag False, - configSplitObjs = Flag False, -- takes longer, so turn off by default - configStripExes = NoFlag, - configStripLibs = NoFlag, - configTests = Flag False, - configBenchmarks = Flag False, - configCoverage = Flag False, - configLibCoverage = NoFlag, - configExactConfiguration = Flag False, - configFlagError = NoFlag, - configRelocatable = Flag False, - configDebugInfo = Flag NoDebugInfo, - configDumpBuildInfo = NoFlag, - configUseResponseFiles = NoFlag - } - -configureCommand :: ProgramDb -> CommandUI ConfigFlags -configureCommand progDb = CommandUI - { commandName = "configure" - , commandSynopsis = "Prepare to build the package." - , commandDescription = Just $ \_ -> wrapText $ - "Configure how the package is built by setting " - ++ "package (and other) flags.\n" - ++ "\n" - ++ "The configuration affects several other commands, " - ++ "including build, test, bench, run, repl.\n" - , commandNotes = Just $ \_pname -> programFlagsDescription progDb - , commandUsage = \pname -> - "Usage: " ++ pname ++ " configure [FLAGS]\n" - , commandDefaultFlags = defaultConfigFlags progDb - , commandOptions = \showOrParseArgs -> - configureOptions showOrParseArgs - ++ programDbPaths progDb showOrParseArgs - configProgramPaths (\v fs -> fs { configProgramPaths = v }) - ++ programDbOption progDb showOrParseArgs - configProgramArgs (\v fs -> fs { configProgramArgs = v }) - ++ programDbOptions progDb showOrParseArgs - configProgramArgs (\v fs -> fs { configProgramArgs = v }) - } - --- | Inverse to 'dispModSubstEntry'. -parsecModSubstEntry :: ParsecParser (ModuleName, Module) -parsecModSubstEntry = do - k <- parsec - _ <- P.char '=' - v <- parsec - return (k, v) - --- | Pretty-print a single entry of a module substitution. -dispModSubstEntry :: (ModuleName, Module) -> Disp.Doc -dispModSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v - -configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] -configureOptions showOrParseArgs = - [optionVerbosity configVerbosity - (\v flags -> flags { configVerbosity = v }) - ,optionDistPref - configDistPref (\d flags -> flags { configDistPref = d }) - showOrParseArgs - - ,option [] ["compiler"] "compiler" - configHcFlavor (\v flags -> flags { configHcFlavor = v }) - (choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") - , (Flag GHCJS, ([] , ["ghcjs"]), "compile with GHCJS") - , (Flag UHC, ([] , ["uhc"]), "compile with UHC") - -- "haskell-suite" compiler id string will be replaced - -- by a more specific one during the configure stage - , (Flag (HaskellSuite "haskell-suite"), ([] , ["haskell-suite"]), - "compile with a haskell-suite compiler")]) - - ,option "" ["cabal-file"] - "use this Cabal file" - configCabalFilePath (\v flags -> flags { configCabalFilePath = v }) - (reqArgFlag "PATH") - - ,option "w" ["with-compiler"] - "give the path to a particular compiler" - configHcPath (\v flags -> flags { configHcPath = v }) - (reqArgFlag "PATH") - - ,option "" ["with-hc-pkg"] - "give the path to the package tool" - configHcPkg (\v flags -> flags { configHcPkg = v }) - (reqArgFlag "PATH") - ] - ++ map liftInstallDirs installDirsOptions - ++ [option "" ["program-prefix"] - "prefix to be applied to installed executables" - configProgPrefix - (\v flags -> flags { configProgPrefix = v }) - (reqPathTemplateArgFlag "PREFIX") - - ,option "" ["program-suffix"] - "suffix to be applied to installed executables" - configProgSuffix (\v flags -> flags { configProgSuffix = v } ) - (reqPathTemplateArgFlag "SUFFIX") - - ,option "" ["library-vanilla"] - "Vanilla libraries" - configVanillaLib (\v flags -> flags { configVanillaLib = v }) - (boolOpt [] []) - - ,option "p" ["library-profiling"] - "Library profiling" - configProfLib (\v flags -> flags { configProfLib = v }) - (boolOpt "p" []) - - ,option "" ["shared"] - "Shared library" - configSharedLib (\v flags -> flags { configSharedLib = v }) - (boolOpt [] []) - - ,option "" ["static"] - "Static library" - configStaticLib (\v flags -> flags { configStaticLib = v }) - (boolOpt [] []) - - ,option "" ["executable-dynamic"] - "Executable dynamic linking" - configDynExe (\v flags -> flags { configDynExe = v }) - (boolOpt [] []) - - ,option "" ["executable-static"] - "Executable fully static linking" - configFullyStaticExe (\v flags -> flags { configFullyStaticExe = v }) - (boolOpt [] []) - - ,option "" ["profiling"] - "Executable and library profiling" - configProf (\v flags -> flags { configProf = v }) - (boolOpt [] []) - - ,option "" ["executable-profiling"] - "Executable profiling (DEPRECATED)" - configProfExe (\v flags -> flags { configProfExe = v }) - (boolOpt [] []) - - ,option "" ["profiling-detail"] - ("Profiling detail level for executable and library (default, " ++ - "none, exported-functions, toplevel-functions, all-functions, late).") - configProfDetail (\v flags -> flags { configProfDetail = v }) - (reqArg' "level" (Flag . flagToProfDetailLevel) - showProfDetailLevelFlag) - - ,option "" ["library-profiling-detail"] - "Profiling detail level for libraries only." - configProfLibDetail (\v flags -> flags { configProfLibDetail = v }) - (reqArg' "level" (Flag . flagToProfDetailLevel) - showProfDetailLevelFlag) - - ,multiOption "optimization" - configOptimization (\v flags -> flags { configOptimization = v }) - [optArg' "n" (Flag . flagToOptimisationLevel) - (\f -> case f of - Flag NoOptimisation -> [] - Flag NormalOptimisation -> [Nothing] - Flag MaximumOptimisation -> [Just "2"] - _ -> []) - "O" ["enable-optimization","enable-optimisation"] - "Build with optimization (n is 0--2, default is 1)", - noArg (Flag NoOptimisation) [] - ["disable-optimization","disable-optimisation"] - "Build without optimization" - ] - - ,multiOption "debug-info" - configDebugInfo (\v flags -> flags { configDebugInfo = v }) - [optArg' "n" (Flag . flagToDebugInfoLevel) - (\f -> case f of - Flag NoDebugInfo -> [] - Flag MinimalDebugInfo -> [Just "1"] - Flag NormalDebugInfo -> [Nothing] - Flag MaximalDebugInfo -> [Just "3"] - _ -> []) - "" ["enable-debug-info"] - "Emit debug info (n is 0--3, default is 0)", - noArg (Flag NoDebugInfo) [] - ["disable-debug-info"] - "Don't emit debug info" - ] - - , multiOption "build-info" - configDumpBuildInfo - (\v flags -> flags { configDumpBuildInfo = v }) - [noArg (Flag DumpBuildInfo) [] - ["enable-build-info"] - "Enable build information generation during project building", - noArg (Flag NoDumpBuildInfo) [] - ["disable-build-info"] - "Disable build information generation during project building" - ] - - ,option "" ["library-for-ghci"] - "compile library for use with GHCi" - configGHCiLib (\v flags -> flags { configGHCiLib = v }) - (boolOpt [] []) - - ,option "" ["split-sections"] - "compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)" - configSplitSections (\v flags -> flags { configSplitSections = v }) - (boolOpt [] []) - - ,option "" ["split-objs"] - "split library into smaller objects to reduce binary sizes (GHC 6.6+)" - configSplitObjs (\v flags -> flags { configSplitObjs = v }) - (boolOpt [] []) - - ,option "" ["executable-stripping"] - "strip executables upon installation to reduce binary sizes" - configStripExes (\v flags -> flags { configStripExes = v }) - (boolOpt [] []) - - ,option "" ["library-stripping"] - "strip libraries upon installation to reduce binary sizes" - configStripLibs (\v flags -> flags { configStripLibs = v }) - (boolOpt [] []) - - ,option "" ["configure-option"] - "Extra option for configure" - configConfigureArgs (\v flags -> flags { configConfigureArgs = v }) - (reqArg' "OPT" (\x -> [x]) id) - - ,option "" ["user-install"] - "doing a per-user installation" - configUserInstall (\v flags -> flags { configUserInstall = v }) - (boolOpt' ([],["user"]) ([], ["global"])) - - ,option "" ["package-db"] - ( "Append the given package database to the list of package" - ++ " databases used (to satisfy dependencies and register into)." - ++ " May be a specific file, 'global' or 'user'. The initial list" - ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," - ++ " depending on context. Use 'clear' to reset the list to empty." - ++ " See the user guide for details.") - configPackageDBs (\v flags -> flags { configPackageDBs = v }) - (reqArg' "DB" readPackageDbList showPackageDbList) - - ,option "f" ["flags"] - "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." - configConfigurationsFlags (\v flags -> flags { configConfigurationsFlags = v }) - (reqArg "FLAGS" - (parsecToReadE (\err -> "Invalid flag assignment: " ++ err) legacyParsecFlagAssignment) - legacyShowFlagAssignment') - - ,option "" ["extra-include-dirs"] - "A list of directories to search for header files" - configExtraIncludeDirs (\v flags -> flags {configExtraIncludeDirs = v}) - (reqArg' "PATH" (\x -> [x]) id) - - ,option "" ["deterministic"] - "Try to be as deterministic as possible (used by the test suite)" - configDeterministic (\v flags -> flags {configDeterministic = v}) - (boolOpt [] []) - - ,option "" ["ipid"] - "Installed package ID to compile this package as" - configIPID (\v flags -> flags {configIPID = v}) - (reqArgFlag "IPID") - - ,option "" ["cid"] - "Installed component ID to compile this component as" - (fmap prettyShow . configCID) (\v flags -> flags {configCID = fmap mkComponentId v}) - (reqArgFlag "CID") - - ,option "" ["extra-lib-dirs"] - "A list of directories to search for external libraries" - configExtraLibDirs (\v flags -> flags {configExtraLibDirs = v}) - (reqArg' "PATH" (\x -> [x]) id) - - ,option "" ["extra-lib-dirs-static"] - "A list of directories to search for external libraries when linking fully static executables" - configExtraLibDirsStatic (\v flags -> flags {configExtraLibDirsStatic = v}) - (reqArg' "PATH" (\x -> [x]) id) - - ,option "" ["extra-framework-dirs"] - "A list of directories to search for external frameworks (OS X only)" - configExtraFrameworkDirs - (\v flags -> flags {configExtraFrameworkDirs = v}) - (reqArg' "PATH" (\x -> [x]) id) - - ,option "" ["extra-prog-path"] - "A list of directories to search for required programs (in addition to the normal search locations)" - configProgramPathExtra (\v flags -> flags {configProgramPathExtra = v}) - (reqArg' "PATH" (\x -> toNubList [x]) fromNubList) - - ,option "" ["constraint"] - "A list of additional constraints on the dependencies." - configConstraints (\v flags -> flags { configConstraints = v}) - (reqArg "DEPENDENCY" - (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsec)) - (map prettyShow)) - - ,option "" ["dependency"] - "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" - configDependencies (\v flags -> flags { configDependencies = v}) - (reqArg "NAME[:COMPONENT_NAME]=CID" - (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) - (map (\(GivenComponent pn cn cid) -> - prettyShow pn - ++ case cn of LMainLibName -> "" - LSubLibName n -> ":" ++ prettyShow n - ++ "=" ++ prettyShow cid))) - - ,option "" ["instantiate-with"] - "A mapping of signature names to concrete module instantiations." - configInstantiateWith (\v flags -> flags { configInstantiateWith = v }) - (reqArg "NAME=MOD" - (parsecToReadE ("Cannot parse module substitution: " ++) (fmap (:[]) parsecModSubstEntry)) - (map (Disp.renderStyle defaultStyle . dispModSubstEntry))) - - ,option "" ["tests"] - "dependency checking and compilation for test suites listed in the package description file." - configTests (\v flags -> flags { configTests = v }) - (boolOpt [] []) - - ,option "" ["coverage"] - "build package with Haskell Program Coverage. (GHC only)" - configCoverage (\v flags -> flags { configCoverage = v }) - (boolOpt [] []) - - ,option "" ["library-coverage"] - "build package with Haskell Program Coverage. (GHC only) (DEPRECATED)" - configLibCoverage (\v flags -> flags { configLibCoverage = v }) - (boolOpt [] []) - - ,option "" ["exact-configuration"] - "All direct dependencies and flags are provided on the command line." - configExactConfiguration - (\v flags -> flags { configExactConfiguration = v }) - trueArg - - ,option "" ["benchmarks"] - "dependency checking and compilation for benchmarks listed in the package description file." - configBenchmarks (\v flags -> flags { configBenchmarks = v }) - (boolOpt [] []) - - ,option "" ["relocatable"] - "building a package that is relocatable. (GHC only)" - configRelocatable (\v flags -> flags { configRelocatable = v}) - (boolOpt [] []) - - ,option "" ["response-files"] - "enable workaround for old versions of programs like \"ar\" that do not support @file arguments" - configUseResponseFiles - (\v flags -> flags { configUseResponseFiles = v }) - (boolOpt' ([], ["disable-response-files"]) ([], [])) - - ,option "" ["allow-depending-on-private-libs"] - ( "Allow depending on private libraries. " - ++ "If set, the library visibility check MUST be done externally." ) - configAllowDependingOnPrivateLibs - (\v flags -> flags { configAllowDependingOnPrivateLibs = v }) - trueArg - ] - where - liftInstallDirs = - liftOption configInstallDirs (\v flags -> flags { configInstallDirs = v }) - - reqPathTemplateArgFlag title _sf _lf d get set = - reqArgFlag title _sf _lf d - (fmap fromPathTemplate . get) (set . fmap toPathTemplate) - -readPackageDbList :: String -> [Maybe PackageDB] -readPackageDbList str = [readPackageDb str] - --- | Parse a PackageDB stack entry --- --- @since 3.7.0.0 -readPackageDb :: String -> Maybe PackageDB -readPackageDb "clear" = Nothing -readPackageDb "global" = Just GlobalPackageDB -readPackageDb "user" = Just UserPackageDB -readPackageDb other = Just (SpecificPackageDB other) - -showPackageDbList :: [Maybe PackageDB] -> [String] -showPackageDbList = map showPackageDb - --- | Show a PackageDB stack entry --- --- @since 3.7.0.0 -showPackageDb :: Maybe PackageDB -> String -showPackageDb Nothing = "clear" -showPackageDb (Just GlobalPackageDB) = "global" -showPackageDb (Just UserPackageDB) = "user" -showPackageDb (Just (SpecificPackageDB db)) = db - -showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] -showProfDetailLevelFlag NoFlag = [] -showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] - -parsecGivenComponent :: ParsecParser GivenComponent -parsecGivenComponent = do - pn <- parsec - ln <- P.option LMainLibName $ do - _ <- P.char ':' - ucn <- parsec - return $ if unUnqualComponentName ucn == unPackageName pn - then LMainLibName - else LSubLibName ucn - _ <- P.char '=' - cid <- parsec - return $ GivenComponent pn ln cid - -installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] -installDirsOptions = - [ option "" ["prefix"] - "bake this prefix in preparation of installation" - prefix (\v flags -> flags { prefix = v }) - installDirArg - - , option "" ["bindir"] - "installation directory for executables" - bindir (\v flags -> flags { bindir = v }) - installDirArg - - , option "" ["libdir"] - "installation directory for libraries" - libdir (\v flags -> flags { libdir = v }) - installDirArg - - , option "" ["libsubdir"] - "subdirectory of libdir in which libs are installed" - libsubdir (\v flags -> flags { libsubdir = v }) - installDirArg - - , option "" ["dynlibdir"] - "installation directory for dynamic libraries" - dynlibdir (\v flags -> flags { dynlibdir = v }) - installDirArg - - , option "" ["libexecdir"] - "installation directory for program executables" - libexecdir (\v flags -> flags { libexecdir = v }) - installDirArg - - , option "" ["libexecsubdir"] - "subdirectory of libexecdir in which private executables are installed" - libexecsubdir (\v flags -> flags { libexecsubdir = v }) - installDirArg - - , option "" ["datadir"] - "installation directory for read-only data" - datadir (\v flags -> flags { datadir = v }) - installDirArg - - , option "" ["datasubdir"] - "subdirectory of datadir in which data files are installed" - datasubdir (\v flags -> flags { datasubdir = v }) - installDirArg - - , option "" ["docdir"] - "installation directory for documentation" - docdir (\v flags -> flags { docdir = v }) - installDirArg - - , option "" ["htmldir"] - "installation directory for HTML documentation" - htmldir (\v flags -> flags { htmldir = v }) - installDirArg - - , option "" ["haddockdir"] - "installation directory for haddock interfaces" - haddockdir (\v flags -> flags { haddockdir = v }) - installDirArg - - , option "" ["sysconfdir"] - "installation directory for configuration files" - sysconfdir (\v flags -> flags { sysconfdir = v }) - installDirArg - ] - where - installDirArg _sf _lf d get set = - reqArgFlag "DIR" _sf _lf d - (fmap fromPathTemplate . get) (set . fmap toPathTemplate) - -emptyConfigFlags :: ConfigFlags -emptyConfigFlags = mempty - -instance Monoid ConfigFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup ConfigFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Copy flags --- ------------------------------------------------------------ - --- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity) -data CopyFlags = CopyFlags { - copyDest :: Flag CopyDest, - copyDistPref :: Flag FilePath, - copyVerbosity :: Flag Verbosity, - -- This is the same hack as in 'buildArgs'. But I (ezyang) don't - -- think it's a hack, it's the right way to make hooks more robust - -- TODO: Stop using this eventually when 'UserHooks' gets changed - copyArgs :: [String], - copyCabalFilePath :: Flag FilePath - } - deriving (Show, Generic) - -defaultCopyFlags :: CopyFlags -defaultCopyFlags = CopyFlags { - copyDest = Flag NoCopyDest, - copyDistPref = NoFlag, - copyVerbosity = Flag normal, - copyArgs = [], - copyCabalFilePath = mempty - } - -copyCommand :: CommandUI CopyFlags -copyCommand = CommandUI - { commandName = "copy" - , commandSynopsis = "Copy the files of all/specific components to install locations." - , commandDescription = Just $ \_ -> wrapText $ - "Components encompass executables and libraries. " - ++ "Does not call register, and allows a prefix at install time. " - ++ "Without the --destdir flag, configure determines location.\n" - , commandNotes = Just $ \pname -> - "Examples:\n" - ++ " " ++ pname ++ " copy " - ++ " All the components in the package\n" - ++ " " ++ pname ++ " copy foo " - ++ " A component (i.e. lib, exe, test suite)" - , commandUsage = usageAlternatives "copy" $ - [ "[FLAGS]" - , "COMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultCopyFlags - , commandOptions = \showOrParseArgs -> case showOrParseArgs of - ShowArgs -> filter ((`notElem` ["target-package-db"]) - . optionName) $ copyOptions ShowArgs - ParseArgs -> copyOptions ParseArgs -} - -copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags] -copyOptions showOrParseArgs = - [optionVerbosity copyVerbosity (\v flags -> flags { copyVerbosity = v }) - - ,optionDistPref - copyDistPref (\d flags -> flags { copyDistPref = d }) - showOrParseArgs - - ,option "" ["destdir"] - "directory to copy files to, prepended to installation directories" - copyDest (\v flags -> case copyDest flags of - Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'." - _ -> flags { copyDest = v }) - (reqArg "DIR" (succeedReadE (Flag . CopyTo)) - (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])) - - ,option "" ["target-package-db"] - "package database to copy files into. Required when using ${pkgroot} prefix." - copyDest (\v flags -> case copyDest flags of - NoFlag -> flags { copyDest = v } - Flag NoCopyDest -> flags { copyDest = v } - _ -> error "Use either 'destdir' or 'target-package-db'.") - (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) - (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) - ] - -emptyCopyFlags :: CopyFlags -emptyCopyFlags = mempty - -instance Monoid CopyFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup CopyFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Install flags --- ------------------------------------------------------------ - --- | Flags to @install@: (package db, verbosity) -data InstallFlags = InstallFlags { - installPackageDB :: Flag PackageDB, - installDest :: Flag CopyDest, - installDistPref :: Flag FilePath, - installUseWrapper :: Flag Bool, - installInPlace :: Flag Bool, - installVerbosity :: Flag Verbosity, - -- this is only here, because we can not - -- change the hooks API. - installCabalFilePath :: Flag FilePath - } - deriving (Show, Generic) - -defaultInstallFlags :: InstallFlags -defaultInstallFlags = InstallFlags { - installPackageDB = NoFlag, - installDest = Flag NoCopyDest, - installDistPref = NoFlag, - installUseWrapper = Flag False, - installInPlace = Flag False, - installVerbosity = Flag normal, - installCabalFilePath = mempty - } - -installCommand :: CommandUI InstallFlags -installCommand = CommandUI - { commandName = "install" - , commandSynopsis = - "Copy the files into the install locations. Run register." - , commandDescription = Just $ \_ -> wrapText $ - "Unlike the copy command, install calls the register command." - ++ "If you want to install into a location that is not what was" - ++ "specified in the configure step, use the copy command.\n" - , commandNotes = Nothing - , commandUsage = \pname -> - "Usage: " ++ pname ++ " install [FLAGS]\n" - , commandDefaultFlags = defaultInstallFlags - , commandOptions = \showOrParseArgs -> case showOrParseArgs of - ShowArgs -> filter ((`notElem` ["target-package-db"]) - . optionName) $ installOptions ShowArgs - ParseArgs -> installOptions ParseArgs - } - -installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] -installOptions showOrParseArgs = - [optionVerbosity installVerbosity (\v flags -> flags { installVerbosity = v }) - ,optionDistPref - installDistPref (\d flags -> flags { installDistPref = d }) - showOrParseArgs - - ,option "" ["inplace"] - "install the package in the install subdirectory of the dist prefix, so it can be used without being installed" - installInPlace (\v flags -> flags { installInPlace = v }) - trueArg - - ,option "" ["shell-wrappers"] - "using shell script wrappers around executables" - installUseWrapper (\v flags -> flags { installUseWrapper = v }) - (boolOpt [] []) - - ,option "" ["package-db"] "" - installPackageDB (\v flags -> flags { installPackageDB = v }) - (choiceOpt [ (Flag UserPackageDB, ([],["user"]), - "upon configuration register this package in the user's local package database") - , (Flag GlobalPackageDB, ([],["global"]), - "(default) upon configuration register this package in the system-wide package database")]) - ,option "" ["target-package-db"] - "package database to install into. Required when using ${pkgroot} prefix." - installDest (\v flags -> flags { installDest = v }) - (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) - (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) - ] - -emptyInstallFlags :: InstallFlags -emptyInstallFlags = mempty - -instance Monoid InstallFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup InstallFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * SDist flags --- ------------------------------------------------------------ - --- | Flags to @sdist@: (snapshot, verbosity) -data SDistFlags = SDistFlags { - sDistSnapshot :: Flag Bool, - sDistDirectory :: Flag FilePath, - sDistDistPref :: Flag FilePath, - sDistListSources :: Flag FilePath, - sDistVerbosity :: Flag Verbosity - } - deriving (Show, Generic, Typeable) - -defaultSDistFlags :: SDistFlags -defaultSDistFlags = SDistFlags { - sDistSnapshot = Flag False, - sDistDirectory = mempty, - sDistDistPref = NoFlag, - sDistListSources = mempty, - sDistVerbosity = Flag normal - } - -sdistCommand :: CommandUI SDistFlags -sdistCommand = CommandUI - { commandName = "sdist" - , commandSynopsis = - "Generate a source distribution file (.tar.gz)." - , commandDescription = Nothing - , commandNotes = Nothing - , commandUsage = \pname -> - "Usage: " ++ pname ++ " sdist [FLAGS]\n" - , commandDefaultFlags = defaultSDistFlags - , commandOptions = \showOrParseArgs -> - [optionVerbosity sDistVerbosity (\v flags -> flags { sDistVerbosity = v }) - ,optionDistPref - sDistDistPref (\d flags -> flags { sDistDistPref = d }) - showOrParseArgs - - ,option "" ["list-sources"] - "Just write a list of the package's sources to a file" - sDistListSources (\v flags -> flags { sDistListSources = v }) - (reqArgFlag "FILE") - - ,option "" ["snapshot"] - "Produce a snapshot source distribution" - sDistSnapshot (\v flags -> flags { sDistSnapshot = v }) - trueArg - - ,option "" ["output-directory"] - ("Generate a source distribution in the given directory, " - ++ "without creating a tarball") - sDistDirectory (\v flags -> flags { sDistDirectory = v }) - (reqArgFlag "DIR") - ] - } - -emptySDistFlags :: SDistFlags -emptySDistFlags = mempty - -instance Monoid SDistFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup SDistFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Register flags --- ------------------------------------------------------------ - --- | Flags to @register@ and @unregister@: (user package, gen-script, --- in-place, verbosity) -data RegisterFlags = RegisterFlags { - regPackageDB :: Flag PackageDB, - regGenScript :: Flag Bool, - regGenPkgConf :: Flag (Maybe FilePath), - regInPlace :: Flag Bool, - regDistPref :: Flag FilePath, - regPrintId :: Flag Bool, - regVerbosity :: Flag Verbosity, - -- Same as in 'buildArgs' and 'copyArgs' - regArgs :: [String], - regCabalFilePath :: Flag FilePath - } - deriving (Show, Generic, Typeable) - -defaultRegisterFlags :: RegisterFlags -defaultRegisterFlags = RegisterFlags { - regPackageDB = NoFlag, - regGenScript = Flag False, - regGenPkgConf = NoFlag, - regInPlace = Flag False, - regDistPref = NoFlag, - regPrintId = Flag False, - regArgs = [], - regCabalFilePath = mempty, - regVerbosity = Flag normal - } - -registerCommand :: CommandUI RegisterFlags -registerCommand = CommandUI - { commandName = "register" - , commandSynopsis = - "Register this package with the compiler." - , commandDescription = Nothing - , commandNotes = Nothing - , commandUsage = \pname -> - "Usage: " ++ pname ++ " register [FLAGS]\n" - , commandDefaultFlags = defaultRegisterFlags - , commandOptions = \showOrParseArgs -> - [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) - ,optionDistPref - regDistPref (\d flags -> flags { regDistPref = d }) - showOrParseArgs - - ,option "" ["packageDB"] "" - regPackageDB (\v flags -> flags { regPackageDB = v }) - (choiceOpt [ (Flag UserPackageDB, ([],["user"]), - "upon registration, register this package in the user's local package database") - , (Flag GlobalPackageDB, ([],["global"]), - "(default)upon registration, register this package in the system-wide package database")]) - - ,option "" ["inplace"] - "register the package in the build location, so it can be used without being installed" - regInPlace (\v flags -> flags { regInPlace = v }) - trueArg - - ,option "" ["gen-script"] - "instead of registering, generate a script to register later" - regGenScript (\v flags -> flags { regGenScript = v }) - trueArg - - ,option "" ["gen-pkg-config"] - "instead of registering, generate a package registration file/directory" - regGenPkgConf (\v flags -> flags { regGenPkgConf = v }) - (optArg' "PKG" Flag flagToList) - - ,option "" ["print-ipid"] - "print the installed package ID calculated for this package" - regPrintId (\v flags -> flags { regPrintId = v }) - trueArg - ] - } - -unregisterCommand :: CommandUI RegisterFlags -unregisterCommand = CommandUI - { commandName = "unregister" - , commandSynopsis = - "Unregister this package with the compiler." - , commandDescription = Nothing - , commandNotes = Nothing - , commandUsage = \pname -> - "Usage: " ++ pname ++ " unregister [FLAGS]\n" - , commandDefaultFlags = defaultRegisterFlags - , commandOptions = \showOrParseArgs -> - [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) - ,optionDistPref - regDistPref (\d flags -> flags { regDistPref = d }) - showOrParseArgs - - ,option "" ["user"] "" - regPackageDB (\v flags -> flags { regPackageDB = v }) - (choiceOpt [ (Flag UserPackageDB, ([],["user"]), - "unregister this package in the user's local package database") - , (Flag GlobalPackageDB, ([],["global"]), - "(default) unregister this package in the system-wide package database")]) - - ,option "" ["gen-script"] - "Instead of performing the unregister command, generate a script to unregister later" - regGenScript (\v flags -> flags { regGenScript = v }) - trueArg - ] - } - -emptyRegisterFlags :: RegisterFlags -emptyRegisterFlags = mempty - -instance Monoid RegisterFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup RegisterFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * HsColour flags --- ------------------------------------------------------------ - -data HscolourFlags = HscolourFlags { - hscolourCSS :: Flag FilePath, - hscolourExecutables :: Flag Bool, - hscolourTestSuites :: Flag Bool, - hscolourBenchmarks :: Flag Bool, - hscolourForeignLibs :: Flag Bool, - hscolourDistPref :: Flag FilePath, - hscolourVerbosity :: Flag Verbosity, - hscolourCabalFilePath :: Flag FilePath - } - deriving (Show, Generic, Typeable) - -emptyHscolourFlags :: HscolourFlags -emptyHscolourFlags = mempty - -defaultHscolourFlags :: HscolourFlags -defaultHscolourFlags = HscolourFlags { - hscolourCSS = NoFlag, - hscolourExecutables = Flag False, - hscolourTestSuites = Flag False, - hscolourBenchmarks = Flag False, - hscolourDistPref = NoFlag, - hscolourForeignLibs = Flag False, - hscolourVerbosity = Flag normal, - hscolourCabalFilePath = mempty - } - -instance Monoid HscolourFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup HscolourFlags where - (<>) = gmappend - -hscolourCommand :: CommandUI HscolourFlags -hscolourCommand = CommandUI - { commandName = "hscolour" - , commandSynopsis = - "Generate HsColour colourised code, in HTML format." - , commandDescription = Just (\_ -> "Requires the hscolour program.\n") - , commandNotes = Just $ \_ -> - "Deprecated in favour of 'cabal haddock --hyperlink-source'." - , commandUsage = \pname -> - "Usage: " ++ pname ++ " hscolour [FLAGS]\n" - , commandDefaultFlags = defaultHscolourFlags - , commandOptions = \showOrParseArgs -> - [optionVerbosity hscolourVerbosity - (\v flags -> flags { hscolourVerbosity = v }) - ,optionDistPref - hscolourDistPref (\d flags -> flags { hscolourDistPref = d }) - showOrParseArgs - - ,option "" ["executables"] - "Run hscolour for Executables targets" - hscolourExecutables (\v flags -> flags { hscolourExecutables = v }) - trueArg - - ,option "" ["tests"] - "Run hscolour for Test Suite targets" - hscolourTestSuites (\v flags -> flags { hscolourTestSuites = v }) - trueArg - - ,option "" ["benchmarks"] - "Run hscolour for Benchmark targets" - hscolourBenchmarks (\v flags -> flags { hscolourBenchmarks = v }) - trueArg - - ,option "" ["foreign-libraries"] - "Run hscolour for Foreign Library targets" - hscolourForeignLibs (\v flags -> flags { hscolourForeignLibs = v }) - trueArg - - ,option "" ["all"] - "Run hscolour for all targets" - (\f -> allFlags [ hscolourExecutables f - , hscolourTestSuites f - , hscolourBenchmarks f - , hscolourForeignLibs f - ]) - (\v flags -> flags { hscolourExecutables = v - , hscolourTestSuites = v - , hscolourBenchmarks = v - , hscolourForeignLibs = v - }) - trueArg - - ,option "" ["css"] - "Use a cascading style sheet" - hscolourCSS (\v flags -> flags { hscolourCSS = v }) - (reqArgFlag "PATH") - ] - } - --- ------------------------------------------------------------ --- * Haddock flags --- ------------------------------------------------------------ - - --- | When we build haddock documentation, there are two cases: --- --- 1. We build haddocks only for the current development version, --- intended for local use and not for distribution. In this case, --- we store the generated documentation in @/doc/html/@. --- --- 2. We build haddocks for intended for uploading them to hackage. --- In this case, we need to follow the layout that hackage expects --- from documentation tarballs, and we might also want to use different --- flags than for development builds, so in this case we store the generated --- documentation in @/doc/html/-docs@. -data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic, Typeable) - -instance Binary HaddockTarget -instance Structured HaddockTarget - -instance Pretty HaddockTarget where - pretty ForHackage = Disp.text "for-hackage" - pretty ForDevelopment = Disp.text "for-development" - -instance Parsec HaddockTarget where - parsec = P.choice [ P.try $ P.string "for-hackage" >> return ForHackage - , P.string "for-development" >> return ForDevelopment] - -data HaddockFlags = HaddockFlags { - haddockProgramPaths :: [(String, FilePath)], - haddockProgramArgs :: [(String, [String])], - haddockHoogle :: Flag Bool, - haddockHtml :: Flag Bool, - haddockHtmlLocation :: Flag String, - haddockForHackage :: Flag HaddockTarget, - haddockExecutables :: Flag Bool, - haddockTestSuites :: Flag Bool, - haddockBenchmarks :: Flag Bool, - haddockForeignLibs :: Flag Bool, - haddockInternal :: Flag Bool, - haddockCss :: Flag FilePath, - haddockLinkedSource :: Flag Bool, - haddockQuickJump :: Flag Bool, - haddockHscolourCss :: Flag FilePath, - haddockContents :: Flag PathTemplate, - haddockIndex :: Flag PathTemplate, - haddockDistPref :: Flag FilePath, - haddockKeepTempFiles:: Flag Bool, - haddockVerbosity :: Flag Verbosity, - haddockCabalFilePath :: Flag FilePath, - haddockBaseUrl :: Flag String, - haddockLib :: Flag String, - haddockArgs :: [String] - } - deriving (Show, Generic, Typeable) - -defaultHaddockFlags :: HaddockFlags -defaultHaddockFlags = HaddockFlags { - haddockProgramPaths = mempty, - haddockProgramArgs = [], - haddockHoogle = Flag False, - haddockHtml = Flag False, - haddockHtmlLocation = NoFlag, - haddockForHackage = NoFlag, - haddockExecutables = Flag False, - haddockTestSuites = Flag False, - haddockBenchmarks = Flag False, - haddockForeignLibs = Flag False, - haddockInternal = Flag False, - haddockCss = NoFlag, - haddockLinkedSource = Flag False, - haddockQuickJump = Flag False, - haddockHscolourCss = NoFlag, - haddockContents = NoFlag, - haddockDistPref = NoFlag, - haddockKeepTempFiles= Flag False, - haddockVerbosity = Flag normal, - haddockCabalFilePath = mempty, - haddockIndex = NoFlag, - haddockBaseUrl = NoFlag, - haddockLib = NoFlag, - haddockArgs = mempty - } - -haddockCommand :: CommandUI HaddockFlags -haddockCommand = CommandUI - { commandName = "haddock" - , commandSynopsis = "Generate Haddock HTML documentation." - , commandDescription = Just $ \_ -> - "Requires the program haddock, version 2.x.\n" - , commandNotes = Nothing - , commandUsage = usageAlternatives "haddock" $ - [ "[FLAGS]" - , "COMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultHaddockFlags - , commandOptions = \showOrParseArgs -> - haddockOptions showOrParseArgs - ++ programDbPaths progDb ParseArgs - haddockProgramPaths (\v flags -> flags { haddockProgramPaths = v}) - ++ programDbOption progDb showOrParseArgs - haddockProgramArgs (\v fs -> fs { haddockProgramArgs = v }) - ++ programDbOptions progDb ParseArgs - haddockProgramArgs (\v flags -> flags { haddockProgramArgs = v}) - } - where - progDb = addKnownProgram haddockProgram - $ addKnownProgram ghcProgram - $ emptyProgramDb - -haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags] -haddockOptions showOrParseArgs = - [optionVerbosity haddockVerbosity - (\v flags -> flags { haddockVerbosity = v }) - ,optionDistPref - haddockDistPref (\d flags -> flags { haddockDistPref = d }) - showOrParseArgs - - ,option "" ["keep-temp-files"] - "Keep temporary files" - haddockKeepTempFiles (\b flags -> flags { haddockKeepTempFiles = b }) - trueArg - - ,option "" ["hoogle"] - "Generate a hoogle database" - haddockHoogle (\v flags -> flags { haddockHoogle = v }) - trueArg - - ,option "" ["html"] - "Generate HTML documentation (the default)" - haddockHtml (\v flags -> flags { haddockHtml = v }) - trueArg - - ,option "" ["html-location"] - "Location of HTML documentation for pre-requisite packages" - haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v }) - (reqArgFlag "URL") - - ,option "" ["for-hackage"] - "Collection of flags to generate documentation suitable for upload to hackage" - haddockForHackage (\v flags -> flags { haddockForHackage = v }) - (noArg (Flag ForHackage)) - - ,option "" ["executables"] - "Run haddock for Executables targets" - haddockExecutables (\v flags -> flags { haddockExecutables = v }) - trueArg - - ,option "" ["tests"] - "Run haddock for Test Suite targets" - haddockTestSuites (\v flags -> flags { haddockTestSuites = v }) - trueArg - - ,option "" ["benchmarks"] - "Run haddock for Benchmark targets" - haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v }) - trueArg - - ,option "" ["foreign-libraries"] - "Run haddock for Foreign Library targets" - haddockForeignLibs (\v flags -> flags { haddockForeignLibs = v }) - trueArg - - ,option "" ["all"] - "Run haddock for all targets" - (\f -> allFlags [ haddockExecutables f - , haddockTestSuites f - , haddockBenchmarks f - , haddockForeignLibs f - ]) - (\v flags -> flags { haddockExecutables = v - , haddockTestSuites = v - , haddockBenchmarks = v - , haddockForeignLibs = v - }) - trueArg - - ,option "" ["internal"] - "Run haddock for internal modules and include all symbols" - haddockInternal (\v flags -> flags { haddockInternal = v }) - trueArg - - ,option "" ["css"] - "Use PATH as the haddock stylesheet" - haddockCss (\v flags -> flags { haddockCss = v }) - (reqArgFlag "PATH") - - ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"] - "Hyperlink the documentation to the source code" - haddockLinkedSource (\v flags -> flags { haddockLinkedSource = v }) - trueArg - - ,option "" ["quickjump"] - "Generate an index for interactive documentation navigation" - haddockQuickJump (\v flags -> flags { haddockQuickJump = v }) - trueArg - - ,option "" ["hscolour-css"] - "Use PATH as the HsColour stylesheet" - haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v }) - (reqArgFlag "PATH") - - ,option "" ["contents-location"] - "Bake URL in as the location for the contents page" - haddockContents (\v flags -> flags { haddockContents = v }) - (reqArg' "URL" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - - ,option "" ["index-location"] - "Use a separately-generated HTML index" - haddockIndex (\v flags -> flags { haddockIndex = v}) - (reqArg' "URL" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - - ,option "" ["base-url"] - "Base URL for static files." - haddockBaseUrl (\v flags -> flags { haddockBaseUrl = v}) - (reqArgFlag "URL") - - ,option "" ["lib"] - "location of Haddocks static / auxiliary files" - haddockLib (\v flags -> flags { haddockLib = v}) - (reqArgFlag "DIR") - ] - -emptyHaddockFlags :: HaddockFlags -emptyHaddockFlags = mempty - -instance Monoid HaddockFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup HaddockFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * HaddocksFlags flags --- ------------------------------------------------------------ - --- | Governs whether modules from a given interface should be visible or --- hidden in the Haddock generated content page. We don't expose this --- functionality to the user, but simply use 'Visible' for only local packages. --- Visibility of modules is available since @haddock-2.26.1@. --- -data Visibility = Visible | Hidden - deriving (Eq, Show) - -data HaddockProjectFlags = HaddockProjectFlags { - haddockProjectHackage :: Flag Bool, - -- ^ a shortcut option which builds documentation linked to hackage. It implies: - -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs' - -- * `--quickjump` - -- * `--gen-index` - -- * `--gen-contents` - -- * `--hyperlinked-source` - haddockProjectLocal :: Flag Bool, - -- ^ a shortcut option which builds self contained directory which contains - -- all the documentation, it implies: - -- * `--quickjump` - -- * `--gen-index` - -- * `--gen-contents` - -- * `--hyperlinked-source` - -- - -- And it will also pass `--base-url` option to `haddock`. - - -- options passed to @haddock@ via 'createHaddockIndex' - haddockProjectDir :: Flag String, - -- ^ output directory of combined haddocks, the default is './haddocks' - haddockProjectPrologue :: Flag String, - haddockProjectGenIndex :: Flag Bool, - haddockProjectGenContents :: Flag Bool, - haddockProjectInterfaces :: Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)], - -- ^ 'haddocksInterfaces' is inferred by the 'haddocksAction'; currently not - -- exposed to the user. - - -- options passed to @haddock@ via 'HaddockFlags' when building - -- documentation - - haddockProjectProgramPaths :: [(String, FilePath)], - haddockProjectProgramArgs :: [(String, [String])], - haddockProjectHoogle :: Flag Bool, - -- haddockHtml is not supported - haddockProjectHtmlLocation :: Flag String, - -- haddockForHackage is not supported - haddockProjectExecutables :: Flag Bool, - haddockProjectTestSuites :: Flag Bool, - haddockProjectBenchmarks :: Flag Bool, - haddockProjectForeignLibs :: Flag Bool, - haddockProjectInternal :: Flag Bool, - haddockProjectCss :: Flag FilePath, - haddockProjectLinkedSource :: Flag Bool, - haddockProjectQuickJump :: Flag Bool, - haddockProjectHscolourCss :: Flag FilePath, - -- haddockContent is not supported, a fixed value is provided - -- haddockIndex is not supported, a fixed value is provided - -- haddockDistPerf is not supported, note: it changes location of the haddocks - haddockProjectKeepTempFiles:: Flag Bool, - haddockProjectVerbosity :: Flag Verbosity, - -- haddockBaseUrl is not supported, a fixed value is provided - haddockProjectLib :: Flag String - } - deriving (Show, Generic, Typeable) - -defaultHaddockProjectFlags :: HaddockProjectFlags -defaultHaddockProjectFlags = HaddockProjectFlags { - haddockProjectHackage = Flag False, - haddockProjectLocal = Flag False, - haddockProjectDir = Flag "./haddocks", - haddockProjectPrologue = NoFlag, - haddockProjectGenIndex = Flag False, - haddockProjectGenContents = Flag False, - haddockProjectTestSuites = Flag False, - haddockProjectProgramPaths = mempty, - haddockProjectProgramArgs = mempty, - haddockProjectHoogle = Flag False, - haddockProjectHtmlLocation = NoFlag, - haddockProjectExecutables = Flag False, - haddockProjectBenchmarks = Flag False, - haddockProjectForeignLibs = Flag False, - haddockProjectInternal = Flag False, - haddockProjectCss = NoFlag, - haddockProjectLinkedSource = Flag False, - haddockProjectQuickJump = Flag False, - haddockProjectHscolourCss = NoFlag, - haddockProjectKeepTempFiles= Flag False, - haddockProjectVerbosity = Flag normal, - haddockProjectLib = NoFlag, - haddockProjectInterfaces = NoFlag - } - -haddockProjectCommand :: CommandUI HaddockProjectFlags -haddockProjectCommand = CommandUI - { commandName = "v2-haddock-project" - , commandSynopsis = "Generate Haddocks HTML documentation for the cabal project." - , commandDescription = Just $ \_ -> - "Require the programm haddock, version 2.26.\n" - , commandNotes = Nothing - , commandUsage = usageAlternatives "haddocks" $ - [ "[FLAGS]" - , "COMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultHaddockProjectFlags - , commandOptions = \showOrParseArgs -> - haddockProjectOptions showOrParseArgs - ++ programDbPaths progDb ParseArgs - haddockProjectProgramPaths (\v flags -> flags { haddockProjectProgramPaths = v}) - ++ programDbOption progDb showOrParseArgs - haddockProjectProgramArgs (\v fs -> fs { haddockProjectProgramArgs = v }) - ++ programDbOptions progDb ParseArgs - haddockProjectProgramArgs (\v flags -> flags { haddockProjectProgramArgs = v}) - } - where - progDb = addKnownProgram haddockProgram - $ addKnownProgram ghcProgram - $ emptyProgramDb - -haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags] -haddockProjectOptions _showOrParseArgs = - [option "" ["hackage"] - (concat ["A short-cut option to build documentation linked to hackage; " - ,"it implies --quickjump, --gen-index, --gen-contents, " - ,"--hyperlinked-source and --html-location" - ]) - haddockProjectHackage (\v flags -> flags { haddockProjectHackage = v }) - trueArg - - ,option "" ["local"] - (concat ["A short-cut option to build self contained documentation; " - ,"it implies --quickjump, --gen-index, --gen-contents " - ,"and --hyperlinked-source." - ]) - haddockProjectLocal (\v flags -> flags { haddockProjectLocal = v }) - trueArg - - ,option "" ["output"] - "Output directory" - haddockProjectDir (\v flags -> flags { haddockProjectDir = v }) - (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList)) - - ,option "" ["prologue"] - "File path to a prologue file in haddock format" - haddockProjectPrologue (\v flags -> flags { haddockProjectPrologue = v}) - (optArg' "PATH" maybeToFlag (fmap Just . flagToList)) - - ,option "" ["gen-index"] - "Generate index" - haddockProjectGenIndex (\v flags -> flags { haddockProjectGenIndex = v}) - trueArg - - ,option "" ["gen-contents"] - "Generate contents" - haddockProjectGenContents (\v flags -> flags { haddockProjectGenContents = v}) - trueArg - - ,option "" ["hoogle"] - "Generate a hoogle database" - haddockProjectHoogle (\v flags -> flags { haddockProjectHoogle = v }) - trueArg - - ,option "" ["html-location"] - "Location of HTML documentation for pre-requisite packages" - haddockProjectHtmlLocation (\v flags -> flags { haddockProjectHtmlLocation = v }) - (reqArgFlag "URL") - - ,option "" ["executables"] - "Run haddock for Executables targets" - haddockProjectExecutables (\v flags -> flags { haddockProjectExecutables = v }) - trueArg - - ,option "" ["tests"] - "Run haddock for Test Suite targets" - haddockProjectTestSuites (\v flags -> flags { haddockProjectTestSuites = v }) - trueArg - - ,option "" ["benchmarks"] - "Run haddock for Benchmark targets" - haddockProjectBenchmarks (\v flags -> flags { haddockProjectBenchmarks = v }) - trueArg - - ,option "" ["foreign-libraries"] - "Run haddock for Foreign Library targets" - haddockProjectForeignLibs (\v flags -> flags { haddockProjectForeignLibs = v }) - trueArg - - ,option "" ["internal"] - "Run haddock for internal modules and include all symbols" - haddockProjectInternal (\v flags -> flags { haddockProjectInternal = v }) - trueArg - - ,option "" ["css"] - "Use PATH as the haddock stylesheet" - haddockProjectCss (\v flags -> flags { haddockProjectCss = v }) - (reqArgFlag "PATH") - - ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"] - "Hyperlink the documentation to the source code" - haddockProjectLinkedSource (\v flags -> flags { haddockProjectLinkedSource = v }) - trueArg - - ,option "" ["quickjump"] - "Generate an index for interactive documentation navigation" - haddockProjectQuickJump (\v flags -> flags { haddockProjectQuickJump = v }) - trueArg - - ,option "" ["hscolour-css"] - "Use PATH as the HsColour stylesheet" - haddockProjectHscolourCss (\v flags -> flags { haddockProjectHscolourCss = v }) - (reqArgFlag "PATH") - - ,option "" ["keep-temp-files"] - "Keep temporary files" - haddockProjectKeepTempFiles (\b flags -> flags { haddockProjectKeepTempFiles = b }) - trueArg - - ,optionVerbosity haddockProjectVerbosity - (\v flags -> flags { haddockProjectVerbosity = v }) - - ,option "" ["lib"] - "location of Haddocks static / auxiliary files" - haddockProjectLib (\v flags -> flags { haddockProjectLib = v}) - (reqArgFlag "DIR") - ] - - -emptyHaddockProjectFlags :: HaddockProjectFlags -emptyHaddockProjectFlags = mempty - -instance Monoid HaddockProjectFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup HaddockProjectFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Clean flags --- ------------------------------------------------------------ - -data CleanFlags = CleanFlags { - cleanSaveConf :: Flag Bool, - cleanDistPref :: Flag FilePath, - cleanVerbosity :: Flag Verbosity, - cleanCabalFilePath :: Flag FilePath - } - deriving (Show, Generic, Typeable) - -defaultCleanFlags :: CleanFlags -defaultCleanFlags = CleanFlags { - cleanSaveConf = Flag False, - cleanDistPref = NoFlag, - cleanVerbosity = Flag normal, - cleanCabalFilePath = mempty - } - -cleanCommand :: CommandUI CleanFlags -cleanCommand = CommandUI - { commandName = "clean" - , commandSynopsis = "Clean up after a build." - , commandDescription = Just $ \_ -> - "Removes .hi, .o, preprocessed sources, etc.\n" - , commandNotes = Nothing - , commandUsage = \pname -> - "Usage: " ++ pname ++ " clean [FLAGS]\n" - , commandDefaultFlags = defaultCleanFlags - , commandOptions = \showOrParseArgs -> - [optionVerbosity cleanVerbosity (\v flags -> flags { cleanVerbosity = v }) - ,optionDistPref - cleanDistPref (\d flags -> flags { cleanDistPref = d }) - showOrParseArgs - - ,option "s" ["save-configure"] - "Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure." - cleanSaveConf (\v flags -> flags { cleanSaveConf = v }) - trueArg - ] - } - -emptyCleanFlags :: CleanFlags -emptyCleanFlags = mempty - -instance Monoid CleanFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup CleanFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Build flags --- ------------------------------------------------------------ - -data BuildFlags = BuildFlags { - buildProgramPaths :: [(String, FilePath)], - buildProgramArgs :: [(String, [String])], - buildDistPref :: Flag FilePath, - buildVerbosity :: Flag Verbosity, - buildNumJobs :: Flag (Maybe Int), - -- TODO: this one should not be here, it's just that the silly - -- UserHooks stop us from passing extra info in other ways - buildArgs :: [String], - buildCabalFilePath :: Flag FilePath - } - deriving (Read, Show, Generic, Typeable) - -defaultBuildFlags :: BuildFlags -defaultBuildFlags = BuildFlags { - buildProgramPaths = mempty, - buildProgramArgs = [], - buildDistPref = mempty, - buildVerbosity = Flag normal, - buildNumJobs = mempty, - buildArgs = [], - buildCabalFilePath = mempty - } - -buildCommand :: ProgramDb -> CommandUI BuildFlags -buildCommand progDb = CommandUI - { commandName = "build" - , commandSynopsis = "Compile all/specific components." - , commandDescription = Just $ \_ -> wrapText $ - "Components encompass executables, tests, and benchmarks.\n" - ++ "\n" - ++ "Affected by configuration options, see `configure`.\n" - , commandNotes = Just $ \pname -> - "Examples:\n" - ++ " " ++ pname ++ " build " - ++ " All the components in the package\n" - ++ " " ++ pname ++ " build foo " - ++ " A component (i.e. lib, exe, test suite)\n\n" - ++ programFlagsDescription progDb ---TODO: re-enable once we have support for module/file targets --- ++ " " ++ pname ++ " build Foo.Bar " --- ++ " A module\n" --- ++ " " ++ pname ++ " build Foo/Bar.hs" --- ++ " A file\n\n" --- ++ "If a target is ambiguous it can be qualified with the component " --- ++ "name, e.g.\n" --- ++ " " ++ pname ++ " build foo:Foo.Bar\n" --- ++ " " ++ pname ++ " build testsuite1:Foo/Bar.hs\n" - , commandUsage = usageAlternatives "build" $ - [ "[FLAGS]" - , "COMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultBuildFlags - , commandOptions = \showOrParseArgs -> - [ optionVerbosity - buildVerbosity (\v flags -> flags { buildVerbosity = v }) - - , optionDistPref - buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs - ] - ++ buildOptions progDb showOrParseArgs - } - -buildOptions :: ProgramDb -> ShowOrParseArgs - -> [OptionField BuildFlags] -buildOptions progDb showOrParseArgs = - [ optionNumJobs - buildNumJobs (\v flags -> flags { buildNumJobs = v }) - ] - - ++ programDbPaths progDb showOrParseArgs - buildProgramPaths (\v flags -> flags { buildProgramPaths = v}) - - ++ programDbOption progDb showOrParseArgs - buildProgramArgs (\v fs -> fs { buildProgramArgs = v }) - - ++ programDbOptions progDb showOrParseArgs - buildProgramArgs (\v flags -> flags { buildProgramArgs = v}) - -emptyBuildFlags :: BuildFlags -emptyBuildFlags = mempty - -instance Monoid BuildFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup BuildFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * REPL Flags --- ------------------------------------------------------------ - -data ReplOptions = ReplOptions { - replOptionsFlags :: [String], - replOptionsNoLoad :: Flag Bool - } - deriving (Show, Generic, Typeable) - -instance Binary ReplOptions -instance Structured ReplOptions - - -instance Monoid ReplOptions where - mempty = ReplOptions mempty (Flag False) - mappend = (<>) - -instance Semigroup ReplOptions where - (<>) = gmappend - -data ReplFlags = ReplFlags { - replProgramPaths :: [(String, FilePath)], - replProgramArgs :: [(String, [String])], - replDistPref :: Flag FilePath, - replVerbosity :: Flag Verbosity, - replReload :: Flag Bool, - replReplOptions :: ReplOptions - } - deriving (Show, Generic, Typeable) - -defaultReplFlags :: ReplFlags -defaultReplFlags = ReplFlags { - replProgramPaths = mempty, - replProgramArgs = [], - replDistPref = NoFlag, - replVerbosity = Flag normal, - replReload = Flag False, - replReplOptions = mempty - } - -instance Monoid ReplFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup ReplFlags where - (<>) = gmappend - -replCommand :: ProgramDb -> CommandUI ReplFlags -replCommand progDb = CommandUI - { commandName = "repl" - , commandSynopsis = - "Open an interpreter session for the given component." - , commandDescription = Just $ \pname -> wrapText $ - "If the current directory contains no package, ignores COMPONENT " - ++ "parameters and opens an interactive interpreter session; if a " - ++ "sandbox is present, its package database will be used.\n" - ++ "\n" - ++ "Otherwise, (re)configures with the given or default flags, and " - ++ "loads the interpreter with the relevant modules. For executables, " - ++ "tests and benchmarks, loads the main module (and its " - ++ "dependencies); for libraries all exposed/other modules.\n" - ++ "\n" - ++ "The default component is the library itself, or the executable " - ++ "if that is the only component.\n" - ++ "\n" - ++ "Support for loading specific modules is planned but not " - ++ "implemented yet. For certain scenarios, `" ++ pname - ++ " exec -- ghci :l Foo` may be used instead. Note that `exec` will " - ++ "not (re)configure and you will have to specify the location of " - ++ "other modules, if required.\n" - - , commandNotes = Just $ \pname -> - "Examples:\n" - ++ " " ++ pname ++ " repl " - ++ " The first component in the package\n" - ++ " " ++ pname ++ " repl foo " - ++ " A named component (i.e. lib, exe, test suite)\n" - ++ " " ++ pname ++ " repl --repl-options=\"-lstdc++\"" - ++ " Specifying flags for interpreter\n" ---TODO: re-enable once we have support for module/file targets --- ++ " " ++ pname ++ " repl Foo.Bar " --- ++ " A module\n" --- ++ " " ++ pname ++ " repl Foo/Bar.hs" --- ++ " A file\n\n" --- ++ "If a target is ambiguous it can be qualified with the component " --- ++ "name, e.g.\n" --- ++ " " ++ pname ++ " repl foo:Foo.Bar\n" --- ++ " " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n" - , commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n" - , commandDefaultFlags = defaultReplFlags - , commandOptions = \showOrParseArgs -> - optionVerbosity replVerbosity (\v flags -> flags { replVerbosity = v }) - : optionDistPref - replDistPref (\d flags -> flags { replDistPref = d }) - showOrParseArgs - - : programDbPaths progDb showOrParseArgs - replProgramPaths (\v flags -> flags { replProgramPaths = v}) - - ++ programDbOption progDb showOrParseArgs - replProgramArgs (\v flags -> flags { replProgramArgs = v}) - - ++ programDbOptions progDb showOrParseArgs - replProgramArgs (\v flags -> flags { replProgramArgs = v}) - - ++ case showOrParseArgs of - ParseArgs -> - [ option "" ["reload"] - "Used from within an interpreter to update files." - replReload (\v flags -> flags { replReload = v }) - trueArg - ] - _ -> [] - ++ map liftReplOption (replOptions showOrParseArgs) - } - where - liftReplOption = liftOption replReplOptions (\v flags -> flags { replReplOptions = v }) - -replOptions :: ShowOrParseArgs -> [OptionField ReplOptions] -replOptions _ = - [ option [] ["repl-no-load"] - "Disable loading of project modules at REPL startup." - replOptionsNoLoad (\p flags -> flags { replOptionsNoLoad = p }) - trueArg - , option [] ["repl-options"] - "Use the option(s) for the repl" - replOptionsFlags (\p flags -> flags { replOptionsFlags = p }) - (reqArg "FLAG" (succeedReadE words) id) - ] - --- ------------------------------------------------------------ --- * Test flags --- ------------------------------------------------------------ - -data TestShowDetails = Never | Failures | Always | Streaming | Direct - deriving (Eq, Ord, Enum, Bounded, Generic, Show, Typeable) - -instance Binary TestShowDetails -instance Structured TestShowDetails - -knownTestShowDetails :: [TestShowDetails] -knownTestShowDetails = [minBound..maxBound] - -instance Pretty TestShowDetails where - pretty = Disp.text . lowercase . show - -instance Parsec TestShowDetails where - parsec = maybe (fail "invalid TestShowDetails") return . classify =<< ident - where - ident = P.munch1 (\c -> isAlpha c || c == '_' || c == '-') - classify str = lookup (lowercase str) enumMap - enumMap :: [(String, TestShowDetails)] - enumMap = [ (prettyShow x, x) - | x <- knownTestShowDetails ] - ---TODO: do we need this instance? -instance Monoid TestShowDetails where - mempty = Never - mappend = (<>) - -instance Semigroup TestShowDetails where - a <> b = if a < b then b else a - -data TestFlags = TestFlags { - testDistPref :: Flag FilePath, - testVerbosity :: Flag Verbosity, - testHumanLog :: Flag PathTemplate, - testMachineLog :: Flag PathTemplate, - testShowDetails :: Flag TestShowDetails, - testKeepTix :: Flag Bool, - testWrapper :: Flag FilePath, - testFailWhenNoTestSuites :: Flag Bool, - -- TODO: think about if/how options are passed to test exes - testOptions :: [PathTemplate] - } deriving (Show, Generic, Typeable) - -defaultTestFlags :: TestFlags -defaultTestFlags = TestFlags { - testDistPref = NoFlag, - testVerbosity = Flag normal, - testHumanLog = toFlag $ toPathTemplate $ "$pkgid-$test-suite.log", - testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log", - testShowDetails = toFlag Failures, - testKeepTix = toFlag False, - testWrapper = NoFlag, - testFailWhenNoTestSuites = toFlag False, - testOptions = [] - } - -testCommand :: CommandUI TestFlags -testCommand = CommandUI - { commandName = "test" - , commandSynopsis = - "Run all/specific tests in the test suite." - , commandDescription = Just $ \ _pname -> wrapText $ - testOrBenchmarkHelpText "test" - , commandNotes = Nothing - , commandUsage = usageAlternatives "test" - [ "[FLAGS]" - , "TESTCOMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultTestFlags - , commandOptions = testOptions' - } - --- | Help text for @test@ and @bench@ commands. -testOrBenchmarkHelpText - :: String -- ^ Either @"test"@ or @"benchmark"@. - -> String -- ^ Help text. -testOrBenchmarkHelpText s = unlines $ map unwords - [ [ "The package must have been build with configuration" - , concat [ "flag `--enable-", s, "s`." ] - ] - , [] -- blank line - , [ concat [ "Note that additional dependencies of the ", s, "s" ] - , "must have already been installed." - ] - , [] - , [ "By defining UserHooks in a custom Setup.hs, the package can define" - , concat [ "actions to be executed before and after running ", s, "s." ] - ] - ] - -testOptions' :: ShowOrParseArgs -> [OptionField TestFlags] -testOptions' showOrParseArgs = - [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) - , optionDistPref - testDistPref (\d flags -> flags { testDistPref = d }) - showOrParseArgs - , option [] ["log"] - ("Log all test suite results to file (name template can use " - ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)") - testHumanLog (\v flags -> flags { testHumanLog = v }) - (reqArg' "TEMPLATE" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - , option [] ["machine-log"] - ("Produce a machine-readable log file (name template can use " - ++ "$pkgid, $compiler, $os, $arch, $result)") - testMachineLog (\v flags -> flags { testMachineLog = v }) - (reqArg' "TEMPLATE" - (toFlag . toPathTemplate) - (flagToList . fmap fromPathTemplate)) - , option [] ["show-details"] - ("'always': always show results of individual test cases. " - ++ "'never': never show results of individual test cases. " - ++ "'failures': show results of failing test cases. " - ++ "'streaming': show results of test cases in real time." - ++ "'direct': send results of test cases in real time; no log file.") - testShowDetails (\v flags -> flags { testShowDetails = v }) - (reqArg "FILTER" - (parsecToReadE (\_ -> "--show-details flag expects one of " - ++ intercalate ", " - (map prettyShow knownTestShowDetails)) - (fmap toFlag parsec)) - (flagToList . fmap prettyShow)) - , option [] ["keep-tix-files"] - "keep .tix files for HPC between test runs" - testKeepTix (\v flags -> flags { testKeepTix = v}) - trueArg - , option [] ["test-wrapper"] - "Run test through a wrapper." - testWrapper (\v flags -> flags { testWrapper = v }) - (reqArg' "FILE" (toFlag :: FilePath -> Flag FilePath) - (flagToList :: Flag FilePath -> [FilePath])) - , option [] ["fail-when-no-test-suites"] - ("Exit with failure when no test suites are found.") - testFailWhenNoTestSuites (\v flags -> flags { testFailWhenNoTestSuites = v}) - trueArg - , option [] ["test-options"] - ("give extra options to test executables " - ++ "(name templates can use $pkgid, $compiler, " - ++ "$os, $arch, $test-suite)") - testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) - (const [])) - , option [] ["test-option"] - ("give extra option to test executables " - ++ "(no need to quote options containing spaces, " - ++ "name template can use $pkgid, $compiler, " - ++ "$os, $arch, $test-suite)") - testOptions (\v flags -> flags { testOptions = v }) - (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) - (map fromPathTemplate)) - ] - -emptyTestFlags :: TestFlags -emptyTestFlags = mempty - -instance Monoid TestFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup TestFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Benchmark flags --- ------------------------------------------------------------ - -data BenchmarkFlags = BenchmarkFlags { - benchmarkDistPref :: Flag FilePath, - benchmarkVerbosity :: Flag Verbosity, - benchmarkOptions :: [PathTemplate] - } deriving (Show, Generic, Typeable) - -defaultBenchmarkFlags :: BenchmarkFlags -defaultBenchmarkFlags = BenchmarkFlags { - benchmarkDistPref = NoFlag, - benchmarkVerbosity = Flag normal, - benchmarkOptions = [] - } - -benchmarkCommand :: CommandUI BenchmarkFlags -benchmarkCommand = CommandUI - { commandName = "bench" - , commandSynopsis = - "Run all/specific benchmarks." - , commandDescription = Just $ \ _pname -> wrapText $ - testOrBenchmarkHelpText "benchmark" - , commandNotes = Nothing - , commandUsage = usageAlternatives "bench" - [ "[FLAGS]" - , "BENCHCOMPONENTS [FLAGS]" - ] - , commandDefaultFlags = defaultBenchmarkFlags - , commandOptions = benchmarkOptions' - } - -benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags] -benchmarkOptions' showOrParseArgs = - [ optionVerbosity benchmarkVerbosity - (\v flags -> flags { benchmarkVerbosity = v }) - , optionDistPref - benchmarkDistPref (\d flags -> flags { benchmarkDistPref = d }) - showOrParseArgs - , option [] ["benchmark-options"] - ("give extra options to benchmark executables " - ++ "(name templates can use $pkgid, $compiler, " - ++ "$os, $arch, $benchmark)") - benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) - (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) - (const [])) - , option [] ["benchmark-option"] - ("give extra option to benchmark executables " - ++ "(no need to quote options containing spaces, " - ++ "name template can use $pkgid, $compiler, " - ++ "$os, $arch, $benchmark)") - benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) - (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) - (map fromPathTemplate)) - ] - -emptyBenchmarkFlags :: BenchmarkFlags -emptyBenchmarkFlags = mempty - -instance Monoid BenchmarkFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup BenchmarkFlags where - (<>) = gmappend - --- ------------------------------------------------------------ --- * Shared options utils --- ------------------------------------------------------------ - -programFlagsDescription :: ProgramDb -> String -programFlagsDescription progDb = - "The flags --with-PROG and --PROG-option(s) can be used with" - ++ " the following programs:" - ++ (concatMap (\line -> "\n " ++ unwords line) . wrapLine 77 . sort) - [ programName prog | (prog, _) <- knownPrograms progDb ] - ++ "\n" - --- | For each known program @PROG@ in 'progDb', produce a @with-PROG@ --- 'OptionField'. -programDbPaths - :: ProgramDb - -> ShowOrParseArgs - -> (flags -> [(String, FilePath)]) - -> ([(String, FilePath)] -> (flags -> flags)) - -> [OptionField flags] -programDbPaths progDb showOrParseArgs get set = - programDbPaths' ("with-" ++) progDb showOrParseArgs get set - --- | Like 'programDbPaths', but allows to customise the option name. -programDbPaths' - :: (String -> String) - -> ProgramDb - -> ShowOrParseArgs - -> (flags -> [(String, FilePath)]) - -> ([(String, FilePath)] -> (flags -> flags)) - -> [OptionField flags] -programDbPaths' mkName progDb showOrParseArgs get set = - case showOrParseArgs of - -- we don't want a verbose help text list so we just show a generic one: - ShowArgs -> [withProgramPath "PROG"] - ParseArgs -> map (withProgramPath . programName . fst) - (knownPrograms progDb) - where - withProgramPath prog = - option "" [mkName prog] - ("give the path to " ++ prog) - get set - (reqArg' "PATH" (\path -> [(prog, path)]) - (\progPaths -> [ path | (prog', path) <- progPaths, prog==prog' ])) - --- | For each known program @PROG@ in 'progDb', produce a @PROG-option@ --- 'OptionField'. -programDbOption - :: ProgramDb - -> ShowOrParseArgs - -> (flags -> [(String, [String])]) - -> ([(String, [String])] -> (flags -> flags)) - -> [OptionField flags] -programDbOption progDb showOrParseArgs get set = - case showOrParseArgs of - -- we don't want a verbose help text list so we just show a generic one: - ShowArgs -> [programOption "PROG"] - ParseArgs -> map (programOption . programName . fst) - (knownPrograms progDb) - where - programOption prog = - option "" [prog ++ "-option"] - ("give an extra option to " ++ prog ++ - " (no need to quote options containing spaces)") - get set - (reqArg' "OPT" (\arg -> [(prog, [arg])]) - (\progArgs -> concat [ args - | (prog', args) <- progArgs, prog==prog' ])) - - --- | For each known program @PROG@ in 'progDb', produce a @PROG-options@ --- 'OptionField'. -programDbOptions - :: ProgramDb - -> ShowOrParseArgs - -> (flags -> [(String, [String])]) - -> ([(String, [String])] -> (flags -> flags)) - -> [OptionField flags] -programDbOptions progDb showOrParseArgs get set = - case showOrParseArgs of - -- we don't want a verbose help text list so we just show a generic one: - ShowArgs -> [programOptions "PROG"] - ParseArgs -> map (programOptions . programName . fst) - (knownPrograms progDb) - where - programOptions prog = - option "" [prog ++ "-options"] - ("give extra options to " ++ prog) - get set - (reqArg' "OPTS" (\args -> [(prog, splitArgs args)]) (const [])) - --- ------------------------------------------------------------ --- * GetOpt Utils --- ------------------------------------------------------------ - -boolOpt :: SFlags -> SFlags - -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a -boolOpt = Command.boolOpt flagToMaybe Flag - -boolOpt' :: OptFlags -> OptFlags - -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a -boolOpt' = Command.boolOpt' flagToMaybe Flag - -trueArg, falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a -trueArg sfT lfT = boolOpt' (sfT, lfT) ([], []) sfT lfT -falseArg sfF lfF = boolOpt' ([], []) (sfF, lfF) sfF lfF - -reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description -> - (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b -reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList - -optionDistPref :: (flags -> Flag FilePath) - -> (Flag FilePath -> flags -> flags) - -> ShowOrParseArgs - -> OptionField flags -optionDistPref get set = \showOrParseArgs -> - option "" (distPrefFlagName showOrParseArgs) - ( "The directory where Cabal puts generated build files " - ++ "(default " ++ defaultDistPref ++ ")") - get set - (reqArgFlag "DIR") - where - distPrefFlagName ShowArgs = ["builddir"] - distPrefFlagName ParseArgs = ["builddir", "distdir", "distpref"] - -optionVerbosity :: (flags -> Flag Verbosity) - -> (Flag Verbosity -> flags -> flags) - -> OptionField flags -optionVerbosity get set = - option "v" ["verbose"] - "Control verbosity (n is 0--3, default verbosity level is 1)" - get set - (optArg "n" (fmap Flag flagToVerbosity) - (Flag verbose) -- default Value if no n is given - (fmap (Just . showForCabal) . flagToList)) - -optionNumJobs :: (flags -> Flag (Maybe Int)) - -> (Flag (Maybe Int) -> flags -> flags) - -> OptionField flags -optionNumJobs get set = - option "j" ["jobs"] - "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)." - get set - (optArg "NUM" (fmap Flag numJobsParser) - (Flag Nothing) - (map (Just . maybe "$ncpus" show) . flagToList)) - where - numJobsParser :: ReadE (Maybe Int) - numJobsParser = ReadE $ \s -> - case s of - "$ncpus" -> Right Nothing - _ -> case reads s of - [(n, "")] - | n < 1 -> Left "The number of jobs should be 1 or more." - | otherwise -> Right (Just n) - _ -> Left "The jobs value should be a number or '$ncpus'" - --- ------------------------------------------------------------ --- * Other Utils --- ------------------------------------------------------------ - --- | Arguments to pass to a @configure@ script, e.g. generated by --- @autoconf@. -configureArgs :: Bool -> ConfigFlags -> [String] -configureArgs bcHack flags - = hc_flag - ++ optFlag "with-hc-pkg" configHcPkg - ++ optFlag' "prefix" prefix - ++ optFlag' "bindir" bindir - ++ optFlag' "libdir" libdir - ++ optFlag' "libexecdir" libexecdir - ++ optFlag' "datadir" datadir - ++ optFlag' "sysconfdir" sysconfdir - ++ configConfigureArgs flags - where - hc_flag = case (configHcFlavor flags, configHcPath flags) of - (_, Flag hc_path) -> [hc_flag_name ++ hc_path] - (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] - (NoFlag,NoFlag) -> [] - hc_flag_name - --TODO kill off thic bc hack when defaultUserHooks is removed. - | bcHack = "--with-hc=" - | otherwise = "--with-compiler=" - optFlag name config_field = case config_field flags of - Flag p -> ["--" ++ name ++ "=" ++ p] - NoFlag -> [] - optFlag' name config_field = optFlag name (fmap fromPathTemplate - . config_field - . configInstallDirs) - -configureCCompiler :: Verbosity -> ProgramDb - -> IO (FilePath, [String]) -configureCCompiler verbosity progdb = configureProg verbosity progdb gccProgram - -configureLinker :: Verbosity -> ProgramDb -> IO (FilePath, [String]) -configureLinker verbosity progdb = configureProg verbosity progdb ldProgram - -configureProg :: Verbosity -> ProgramDb -> Program - -> IO (FilePath, [String]) -configureProg verbosity programDb prog = do - (p, _) <- requireProgram verbosity prog programDb - let pInv = programInvocation p [] - return (progInvokePath pInv, progInvokeArgs pInv) - --- | Helper function to split a string into a list of arguments. --- It's supposed to handle quoted things sensibly, eg: --- --- > splitArgs "--foo=\"C:/Program Files/Bar/" --baz" --- > = ["--foo=C:/Program Files/Bar", "--baz"] --- --- > splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" --- > = ["-DMSGSTR=\"foo bar\"","--baz"] --- -splitArgs :: String -> [String] -splitArgs = space [] - where - space :: String -> String -> [String] - space w [] = word w [] - space w ( c :s) - | isSpace c = word w (space [] s) - space w ('"':s) = string w s - space w s = nonstring w s - - string :: String -> String -> [String] - string w [] = word w [] - string w ('"':s) = space w s - string w ('\\':'"':s) = string ('"':w) s - string w ( c :s) = string (c:w) s - - nonstring :: String -> String -> [String] - nonstring w [] = word w [] - nonstring w ('"':s) = string w s - nonstring w ( c :s) = space (c:w) s - - word [] s = s - word w s = reverse w : s +import Distribution.Simple.Setup.Benchmark +import Distribution.Simple.Setup.Build +import Distribution.Simple.Setup.Clean +import Distribution.Simple.Setup.Common +import Distribution.Simple.Setup.Config +import Distribution.Simple.Setup.Copy +import Distribution.Simple.Setup.Global +import Distribution.Simple.Setup.Haddock +import Distribution.Simple.Setup.Hscolour +import Distribution.Simple.Setup.Install +import Distribution.Simple.Setup.Register +import Distribution.Simple.Setup.Repl +import Distribution.Simple.Setup.SDist +import Distribution.Simple.Setup.Test -- The test cases kinda have to be rewritten from the ground up... :/ --hunitTests :: [Test] diff --git a/Cabal/src/Distribution/Simple/Setup/Benchmark.hs b/Cabal/src/Distribution/Simple/Setup/Benchmark.hs new file mode 100644 index 00000000000..0b854f551ae --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Benchmark.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Benchmark +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the benchmarking command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Benchmark ( + BenchmarkFlags(..), emptyBenchmarkFlags, + defaultBenchmarkFlags, benchmarkCommand, + benchmarkOptions' + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Benchmark flags +-- ------------------------------------------------------------ + +data BenchmarkFlags = BenchmarkFlags { + benchmarkDistPref :: Flag FilePath, + benchmarkVerbosity :: Flag Verbosity, + benchmarkOptions :: [PathTemplate] + } deriving (Show, Generic, Typeable) + +defaultBenchmarkFlags :: BenchmarkFlags +defaultBenchmarkFlags = BenchmarkFlags { + benchmarkDistPref = NoFlag, + benchmarkVerbosity = Flag normal, + benchmarkOptions = [] + } + +benchmarkCommand :: CommandUI BenchmarkFlags +benchmarkCommand = CommandUI + { commandName = "bench" + , commandSynopsis = + "Run all/specific benchmarks." + , commandDescription = Just $ \ _pname -> wrapText $ + testOrBenchmarkHelpText "benchmark" + , commandNotes = Nothing + , commandUsage = usageAlternatives "bench" + [ "[FLAGS]" + , "BENCHCOMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultBenchmarkFlags + , commandOptions = benchmarkOptions' + } + +benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags] +benchmarkOptions' showOrParseArgs = + [ optionVerbosity benchmarkVerbosity + (\v flags -> flags { benchmarkVerbosity = v }) + , optionDistPref + benchmarkDistPref (\d flags -> flags { benchmarkDistPref = d }) + showOrParseArgs + , option [] ["benchmark-options"] + ("give extra options to benchmark executables " + ++ "(name templates can use $pkgid, $compiler, " + ++ "$os, $arch, $benchmark)") + benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) + (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) + (const [])) + , option [] ["benchmark-option"] + ("give extra option to benchmark executables " + ++ "(no need to quote options containing spaces, " + ++ "name template can use $pkgid, $compiler, " + ++ "$os, $arch, $benchmark)") + benchmarkOptions (\v flags -> flags { benchmarkOptions = v }) + (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) + (map fromPathTemplate)) + ] + +emptyBenchmarkFlags :: BenchmarkFlags +emptyBenchmarkFlags = mempty + +instance Monoid BenchmarkFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup BenchmarkFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Build.hs b/Cabal/src/Distribution/Simple/Setup/Build.hs new file mode 100644 index 00000000000..7adf67f3e01 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Build.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Build +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the build command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Build ( + BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand, + DumpBuildInfo(..), + buildOptions, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.Program +import Distribution.Verbosity +import Distribution.Types.DumpBuildInfo + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Build flags +-- ------------------------------------------------------------ + +data BuildFlags = BuildFlags { + buildProgramPaths :: [(String, FilePath)], + buildProgramArgs :: [(String, [String])], + buildDistPref :: Flag FilePath, + buildVerbosity :: Flag Verbosity, + buildNumJobs :: Flag (Maybe Int), + -- TODO: this one should not be here, it's just that the silly + -- UserHooks stop us from passing extra info in other ways + buildArgs :: [String], + buildCabalFilePath :: Flag FilePath + } + deriving (Read, Show, Generic, Typeable) + +defaultBuildFlags :: BuildFlags +defaultBuildFlags = BuildFlags { + buildProgramPaths = mempty, + buildProgramArgs = [], + buildDistPref = mempty, + buildVerbosity = Flag normal, + buildNumJobs = mempty, + buildArgs = [], + buildCabalFilePath = mempty + } + +buildCommand :: ProgramDb -> CommandUI BuildFlags +buildCommand progDb = CommandUI + { commandName = "build" + , commandSynopsis = "Compile all/specific components." + , commandDescription = Just $ \_ -> wrapText $ + "Components encompass executables, tests, and benchmarks.\n" + ++ "\n" + ++ "Affected by configuration options, see `configure`.\n" + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " build " + ++ " All the components in the package\n" + ++ " " ++ pname ++ " build foo " + ++ " A component (i.e. lib, exe, test suite)\n\n" + ++ programFlagsDescription progDb +--TODO: re-enable once we have support for module/file targets +-- ++ " " ++ pname ++ " build Foo.Bar " +-- ++ " A module\n" +-- ++ " " ++ pname ++ " build Foo/Bar.hs" +-- ++ " A file\n\n" +-- ++ "If a target is ambiguous it can be qualified with the component " +-- ++ "name, e.g.\n" +-- ++ " " ++ pname ++ " build foo:Foo.Bar\n" +-- ++ " " ++ pname ++ " build testsuite1:Foo/Bar.hs\n" + , commandUsage = usageAlternatives "build" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultBuildFlags + , commandOptions = \showOrParseArgs -> + [ optionVerbosity + buildVerbosity (\v flags -> flags { buildVerbosity = v }) + + , optionDistPref + buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs + ] + ++ buildOptions progDb showOrParseArgs + } + +buildOptions :: ProgramDb -> ShowOrParseArgs + -> [OptionField BuildFlags] +buildOptions progDb showOrParseArgs = + [ optionNumJobs + buildNumJobs (\v flags -> flags { buildNumJobs = v }) + ] + + ++ programDbPaths progDb showOrParseArgs + buildProgramPaths (\v flags -> flags { buildProgramPaths = v}) + + ++ programDbOption progDb showOrParseArgs + buildProgramArgs (\v fs -> fs { buildProgramArgs = v }) + + ++ programDbOptions progDb showOrParseArgs + buildProgramArgs (\v flags -> flags { buildProgramArgs = v}) + +emptyBuildFlags :: BuildFlags +emptyBuildFlags = mempty + +instance Monoid BuildFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup BuildFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Clean.hs b/Cabal/src/Distribution/Simple/Setup/Clean.hs new file mode 100644 index 00000000000..e2b723c22a7 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Clean.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Clean +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the clean command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Clean ( + + CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Clean flags +-- ------------------------------------------------------------ + +data CleanFlags = CleanFlags { + cleanSaveConf :: Flag Bool, + cleanDistPref :: Flag FilePath, + cleanVerbosity :: Flag Verbosity, + cleanCabalFilePath :: Flag FilePath + } + deriving (Show, Generic, Typeable) + +defaultCleanFlags :: CleanFlags +defaultCleanFlags = CleanFlags { + cleanSaveConf = Flag False, + cleanDistPref = NoFlag, + cleanVerbosity = Flag normal, + cleanCabalFilePath = mempty + } + +cleanCommand :: CommandUI CleanFlags +cleanCommand = CommandUI + { commandName = "clean" + , commandSynopsis = "Clean up after a build." + , commandDescription = Just $ \_ -> + "Removes .hi, .o, preprocessed sources, etc.\n" + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " clean [FLAGS]\n" + , commandDefaultFlags = defaultCleanFlags + , commandOptions = \showOrParseArgs -> + [optionVerbosity cleanVerbosity (\v flags -> flags { cleanVerbosity = v }) + ,optionDistPref + cleanDistPref (\d flags -> flags { cleanDistPref = d }) + showOrParseArgs + + ,option "s" ["save-configure"] + "Do not remove the configuration file (dist/setup-config) during cleaning. Saves need to reconfigure." + cleanSaveConf (\v flags -> flags { cleanSaveConf = v }) + trueArg + ] + } + +emptyCleanFlags :: CleanFlags +emptyCleanFlags = mempty + +instance Monoid CleanFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup CleanFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs new file mode 100644 index 00000000000..ff9187b4550 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Common.hs @@ -0,0 +1,284 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Common +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Common utilities for defining command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Common ( + CopyDest(..), + configureCCompiler, configureLinker, + programDbOption, programDbOptions, + programDbPaths, programDbPaths', + programFlagsDescription, + splitArgs, testOrBenchmarkHelpText, + + defaultDistPref, optionDistPref, + + Flag(..), + toFlag, + fromFlag, + fromFlagOrDefault, + flagToMaybe, + flagToList, + maybeToFlag, + BooleanFlag(..), + boolOpt, boolOpt', trueArg, falseArg, + reqArgFlag, + optionVerbosity, optionNumJobs + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.ReadE +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import qualified Distribution.Simple.Command as Command +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.Program +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + + +-- FIXME Not sure where this should live +defaultDistPref :: FilePath +defaultDistPref = "dist" + +-- | Help text for @test@ and @bench@ commands. +testOrBenchmarkHelpText + :: String -- ^ Either @"test"@ or @"benchmark"@. + -> String -- ^ Help text. +testOrBenchmarkHelpText s = unlines $ map unwords + [ [ "The package must have been build with configuration" + , concat [ "flag `--enable-", s, "s`." ] + ] + , [] -- blank line + , [ concat [ "Note that additional dependencies of the ", s, "s" ] + , "must have already been installed." + ] + , [] + , [ "By defining UserHooks in a custom Setup.hs, the package can define" + , concat [ "actions to be executed before and after running ", s, "s." ] + ] + ] + +-- ------------------------------------------------------------ +-- * Shared options utils +-- ------------------------------------------------------------ + +programFlagsDescription :: ProgramDb -> String +programFlagsDescription progDb = + "The flags --with-PROG and --PROG-option(s) can be used with" + ++ " the following programs:" + ++ (concatMap (\line -> "\n " ++ unwords line) . wrapLine 77 . sort) + [ programName prog | (prog, _) <- knownPrograms progDb ] + ++ "\n" + +-- | For each known program @PROG@ in 'progDb', produce a @with-PROG@ +-- 'OptionField'. +programDbPaths + :: ProgramDb + -> ShowOrParseArgs + -> (flags -> [(String, FilePath)]) + -> ([(String, FilePath)] -> (flags -> flags)) + -> [OptionField flags] +programDbPaths progDb showOrParseArgs get set = + programDbPaths' ("with-" ++) progDb showOrParseArgs get set + +-- | Like 'programDbPaths', but allows to customise the option name. +programDbPaths' + :: (String -> String) + -> ProgramDb + -> ShowOrParseArgs + -> (flags -> [(String, FilePath)]) + -> ([(String, FilePath)] -> (flags -> flags)) + -> [OptionField flags] +programDbPaths' mkName progDb showOrParseArgs get set = + case showOrParseArgs of + -- we don't want a verbose help text list so we just show a generic one: + ShowArgs -> [withProgramPath "PROG"] + ParseArgs -> map (withProgramPath . programName . fst) + (knownPrograms progDb) + where + withProgramPath prog = + option "" [mkName prog] + ("give the path to " ++ prog) + get set + (reqArg' "PATH" (\path -> [(prog, path)]) + (\progPaths -> [ path | (prog', path) <- progPaths, prog==prog' ])) + +-- | For each known program @PROG@ in 'progDb', produce a @PROG-option@ +-- 'OptionField'. +programDbOption + :: ProgramDb + -> ShowOrParseArgs + -> (flags -> [(String, [String])]) + -> ([(String, [String])] -> (flags -> flags)) + -> [OptionField flags] +programDbOption progDb showOrParseArgs get set = + case showOrParseArgs of + -- we don't want a verbose help text list so we just show a generic one: + ShowArgs -> [programOption "PROG"] + ParseArgs -> map (programOption . programName . fst) + (knownPrograms progDb) + where + programOption prog = + option "" [prog ++ "-option"] + ("give an extra option to " ++ prog ++ + " (no need to quote options containing spaces)") + get set + (reqArg' "OPT" (\arg -> [(prog, [arg])]) + (\progArgs -> concat [ args + | (prog', args) <- progArgs, prog==prog' ])) + + +-- | For each known program @PROG@ in 'progDb', produce a @PROG-options@ +-- 'OptionField'. +programDbOptions + :: ProgramDb + -> ShowOrParseArgs + -> (flags -> [(String, [String])]) + -> ([(String, [String])] -> (flags -> flags)) + -> [OptionField flags] +programDbOptions progDb showOrParseArgs get set = + case showOrParseArgs of + -- we don't want a verbose help text list so we just show a generic one: + ShowArgs -> [programOptions "PROG"] + ParseArgs -> map (programOptions . programName . fst) + (knownPrograms progDb) + where + programOptions prog = + option "" [prog ++ "-options"] + ("give extra options to " ++ prog) + get set + (reqArg' "OPTS" (\args -> [(prog, splitArgs args)]) (const [])) + +-- ------------------------------------------------------------ +-- * GetOpt Utils +-- ------------------------------------------------------------ + +boolOpt :: SFlags -> SFlags + -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a +boolOpt = Command.boolOpt flagToMaybe Flag + +boolOpt' :: OptFlags -> OptFlags + -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a +boolOpt' = Command.boolOpt' flagToMaybe Flag + +trueArg, falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a +trueArg sfT lfT = boolOpt' (sfT, lfT) ([], []) sfT lfT +falseArg sfF lfF = boolOpt' ([], []) (sfF, lfF) sfF lfF + +reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description -> + (b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b +reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList + +optionDistPref :: (flags -> Flag FilePath) + -> (Flag FilePath -> flags -> flags) + -> ShowOrParseArgs + -> OptionField flags +optionDistPref get set = \showOrParseArgs -> + option "" (distPrefFlagName showOrParseArgs) + ( "The directory where Cabal puts generated build files " + ++ "(default " ++ defaultDistPref ++ ")") + get set + (reqArgFlag "DIR") + where + distPrefFlagName ShowArgs = ["builddir"] + distPrefFlagName ParseArgs = ["builddir", "distdir", "distpref"] + +optionVerbosity :: (flags -> Flag Verbosity) + -> (Flag Verbosity -> flags -> flags) + -> OptionField flags +optionVerbosity get set = + option "v" ["verbose"] + "Control verbosity (n is 0--3, default verbosity level is 1)" + get set + (optArg "n" (fmap Flag flagToVerbosity) + (Flag verbose) -- default Value if no n is given + (fmap (Just . showForCabal) . flagToList)) + +optionNumJobs :: (flags -> Flag (Maybe Int)) + -> (Flag (Maybe Int) -> flags -> flags) + -> OptionField flags +optionNumJobs get set = + option "j" ["jobs"] + "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)." + get set + (optArg "NUM" (fmap Flag numJobsParser) + (Flag Nothing) + (map (Just . maybe "$ncpus" show) . flagToList)) + where + numJobsParser :: ReadE (Maybe Int) + numJobsParser = ReadE $ \s -> + case s of + "$ncpus" -> Right Nothing + _ -> case reads s of + [(n, "")] + | n < 1 -> Left "The number of jobs should be 1 or more." + | otherwise -> Right (Just n) + _ -> Left "The jobs value should be a number or '$ncpus'" + +-- ------------------------------------------------------------ +-- * Other Utils +-- ------------------------------------------------------------ + +configureCCompiler :: Verbosity -> ProgramDb + -> IO (FilePath, [String]) +configureCCompiler verbosity progdb = configureProg verbosity progdb gccProgram + +configureLinker :: Verbosity -> ProgramDb -> IO (FilePath, [String]) +configureLinker verbosity progdb = configureProg verbosity progdb ldProgram + +configureProg :: Verbosity -> ProgramDb -> Program + -> IO (FilePath, [String]) +configureProg verbosity programDb prog = do + (p, _) <- requireProgram verbosity prog programDb + let pInv = programInvocation p [] + return (progInvokePath pInv, progInvokeArgs pInv) + +-- | Helper function to split a string into a list of arguments. +-- It's supposed to handle quoted things sensibly, eg: +-- +-- > splitArgs "--foo=\"C:/Program Files/Bar/" --baz" +-- > = ["--foo=C:/Program Files/Bar", "--baz"] +-- +-- > splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" +-- > = ["-DMSGSTR=\"foo bar\"","--baz"] +-- +splitArgs :: String -> [String] +splitArgs = space [] + where + space :: String -> String -> [String] + space w [] = word w [] + space w ( c :s) + | isSpace c = word w (space [] s) + space w ('"':s) = string w s + space w s = nonstring w s + + string :: String -> String -> [String] + string w [] = word w [] + string w ('"':s) = space w s + string w ('\\':'"':s) = string ('"':w) s + string w ( c :s) = string (c:w) s + + nonstring :: String -> String -> [String] + nonstring w [] = word w [] + nonstring w ('"':s) = string w s + nonstring w ( c :s) = space (c:w) s + + word [] s = s + word w s = reverse w : s diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs new file mode 100644 index 00000000000..1de98c0c88f --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -0,0 +1,776 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Config +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the configure command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Config ( + ConfigFlags(..), emptyConfigFlags, defaultConfigFlags, configureCommand, + configPrograms, + configAbsolutePaths, readPackageDb, readPackageDbList, showPackageDb, showPackageDbList, + configureArgs, configureOptions, installDirsOptions + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Compiler +import Distribution.ReadE +import Distribution.Parsec +import Distribution.Pretty +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp +import Distribution.ModuleName +import Distribution.PackageDescription +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Compiler +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.Program +import Distribution.Simple.InstallDirs +import Distribution.Verbosity +import Distribution.Utils.NubList +import Distribution.Types.ComponentId +import Distribution.Types.DumpBuildInfo +import Distribution.Types.GivenComponent +import Distribution.Types.Module +import Distribution.Types.PackageVersionConstraint + +import Distribution.Compat.Stack +import Distribution.Compat.Semigroup (Last' (..), Option' (..)) + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Config flags +-- ------------------------------------------------------------ + +-- | Flags to @configure@ command. +-- +-- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags' +-- should be updated. +-- IMPORTANT: every time a new flag is added, it should be added to the Eq instance +data ConfigFlags = ConfigFlags { + -- This is the same hack as in 'buildArgs' and 'copyArgs'. + -- TODO: Stop using this eventually when 'UserHooks' gets changed + configArgs :: [String], + + --FIXME: the configPrograms is only here to pass info through to configure + -- because the type of configure is constrained by the UserHooks. + -- when we change UserHooks next we should pass the initial + -- ProgramDb directly and not via ConfigFlags + configPrograms_ :: Option' (Last' ProgramDb), -- ^All programs that + -- @cabal@ may run + configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths + configProgramArgs :: [(String, [String])], -- ^user specified programs args + configProgramPathExtra :: NubList FilePath, -- ^Extend the $PATH + configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the + -- compiler, e.g. GHC. + configHcPath :: Flag FilePath, -- ^given compiler location + configHcPkg :: Flag FilePath, -- ^given hc-pkg location + configVanillaLib :: Flag Bool, -- ^Enable vanilla library + configProfLib :: Flag Bool, -- ^Enable profiling in the library + configSharedLib :: Flag Bool, -- ^Build shared library + configStaticLib :: Flag Bool, -- ^Build static library + configDynExe :: Flag Bool, -- ^Enable dynamic linking of the + -- executables. + configFullyStaticExe :: Flag Bool, -- ^Enable fully static linking of the + -- executables. + configProfExe :: Flag Bool, -- ^Enable profiling in the + -- executables. + configProf :: Flag Bool, -- ^Enable profiling in the library + -- and executables. + configProfDetail :: Flag ProfDetailLevel, -- ^Profiling detail level + -- in the library and executables. + configProfLibDetail :: Flag ProfDetailLevel, -- ^Profiling detail level + -- in the library + configConfigureArgs :: [String], -- ^Extra arguments to @configure@ + configOptimization :: Flag OptimisationLevel, -- ^Enable optimization. + configProgPrefix :: Flag PathTemplate, -- ^Installed executable prefix. + configProgSuffix :: Flag PathTemplate, -- ^Installed executable suffix. + configInstallDirs :: InstallDirs (Flag PathTemplate), -- ^Installation + -- paths + configScratchDir :: Flag FilePath, + configExtraLibDirs :: [FilePath], -- ^ path to search for extra libraries + configExtraLibDirsStatic :: [FilePath], -- ^ path to search for extra + -- libraries when linking + -- fully static executables + configExtraFrameworkDirs :: [FilePath], -- ^ path to search for extra + -- frameworks (OS X only) + configExtraIncludeDirs :: [FilePath], -- ^ path to search for header files + configIPID :: Flag String, -- ^ explicit IPID to be used + configCID :: Flag ComponentId, -- ^ explicit CID to be used + configDeterministic :: Flag Bool, -- ^ be as deterministic as possible + -- (e.g., invariant over GHC, database, + -- etc). Used by the test suite + + configDistPref :: Flag FilePath, -- ^"dist" prefix + configCabalFilePath :: Flag FilePath, -- ^ Cabal file to use + configVerbosity :: Flag Verbosity, -- ^verbosity level + configUserInstall :: Flag Bool, -- ^The --user\/--global flag + configPackageDBs :: [Maybe PackageDB], -- ^Which package DBs to use + configGHCiLib :: Flag Bool, -- ^Enable compiling library for GHCi + configSplitSections :: Flag Bool, -- ^Enable -split-sections with GHC + configSplitObjs :: Flag Bool, -- ^Enable -split-objs with GHC + configStripExes :: Flag Bool, -- ^Enable executable stripping + configStripLibs :: Flag Bool, -- ^Enable library stripping + configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for + -- dependencies. + configDependencies :: [GivenComponent], + -- ^The packages depended on. + configInstantiateWith :: [(ModuleName, Module)], + -- ^ The requested Backpack instantiation. If empty, either this + -- package does not use Backpack, or we just want to typecheck + -- the indefinite package. + configConfigurationsFlags :: FlagAssignment, + configTests :: Flag Bool, -- ^Enable test suite compilation + configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation + configCoverage :: Flag Bool, -- ^Enable program coverage + configLibCoverage :: Flag Bool, -- ^Enable program coverage (deprecated) + configExactConfiguration :: Flag Bool, + -- ^All direct dependencies and flags are provided on the command line by + -- the user via the '--dependency' and '--flags' options. + configFlagError :: Flag String, + -- ^Halt and show an error message indicating an error in flag assignment + configRelocatable :: Flag Bool, -- ^ Enable relocatable package built + configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info. + configDumpBuildInfo :: Flag DumpBuildInfo, + -- ^ Should we dump available build information on build? + -- Dump build information to disk before attempting to build, + -- tooling can parse these files and use them to compile the + -- source files themselves. + configUseResponseFiles :: Flag Bool, + -- ^ Whether to use response files at all. They're used for such tools + -- as haddock, or ld. + configAllowDependingOnPrivateLibs :: Flag Bool + -- ^ Allow depending on private sublibraries. This is used by external + -- tools (like cabal-install) so they can add multiple-public-libraries + -- compatibility to older ghcs by checking visibility externally. + } + deriving (Generic, Read, Show, Typeable) + +instance Binary ConfigFlags +instance Structured ConfigFlags + +-- | More convenient version of 'configPrograms'. Results in an +-- 'error' if internal invariant is violated. +configPrograms :: WithCallStack (ConfigFlags -> ProgramDb) +configPrograms = fromMaybe (error "FIXME: remove configPrograms") . fmap getLast' + . getOption' . configPrograms_ + +instance Eq ConfigFlags where + (==) a b = + -- configPrograms skipped: not user specified, has no Eq instance + equal configProgramPaths + && equal configProgramArgs + && equal configProgramPathExtra + && equal configHcFlavor + && equal configHcPath + && equal configHcPkg + && equal configVanillaLib + && equal configProfLib + && equal configSharedLib + && equal configStaticLib + && equal configDynExe + && equal configFullyStaticExe + && equal configProfExe + && equal configProf + && equal configProfDetail + && equal configProfLibDetail + && equal configConfigureArgs + && equal configOptimization + && equal configProgPrefix + && equal configProgSuffix + && equal configInstallDirs + && equal configScratchDir + && equal configExtraLibDirs + && equal configExtraLibDirsStatic + && equal configExtraIncludeDirs + && equal configIPID + && equal configDeterministic + && equal configDistPref + && equal configVerbosity + && equal configUserInstall + && equal configPackageDBs + && equal configGHCiLib + && equal configSplitSections + && equal configSplitObjs + && equal configStripExes + && equal configStripLibs + && equal configConstraints + && equal configDependencies + && equal configConfigurationsFlags + && equal configTests + && equal configBenchmarks + && equal configCoverage + && equal configLibCoverage + && equal configExactConfiguration + && equal configFlagError + && equal configRelocatable + && equal configDebugInfo + && equal configDumpBuildInfo + && equal configUseResponseFiles + where + equal f = on (==) f a b + +configAbsolutePaths :: ConfigFlags -> IO ConfigFlags +configAbsolutePaths f = + (\v -> f { configPackageDBs = v }) + `liftM` traverse (maybe (return Nothing) (liftM Just . absolutePackageDBPath)) + (configPackageDBs f) + +defaultConfigFlags :: ProgramDb -> ConfigFlags +defaultConfigFlags progDb = emptyConfigFlags { + configArgs = [], + configPrograms_ = Option' (Just (Last' progDb)), + configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, + configVanillaLib = Flag True, + configProfLib = NoFlag, + configSharedLib = NoFlag, + configStaticLib = NoFlag, + configDynExe = Flag False, + configFullyStaticExe = Flag False, + configProfExe = NoFlag, + configProf = NoFlag, + configProfDetail = NoFlag, + configProfLibDetail= NoFlag, + configOptimization = Flag NormalOptimisation, + configProgPrefix = Flag (toPathTemplate ""), + configProgSuffix = Flag (toPathTemplate ""), + configDistPref = NoFlag, + configCabalFilePath = NoFlag, + configVerbosity = Flag normal, + configUserInstall = Flag False, --TODO: reverse this +#if defined(mingw32_HOST_OS) + -- See #8062 and GHC #21019. + configGHCiLib = Flag False, +#else + configGHCiLib = NoFlag, +#endif + configSplitSections = Flag False, + configSplitObjs = Flag False, -- takes longer, so turn off by default + configStripExes = NoFlag, + configStripLibs = NoFlag, + configTests = Flag False, + configBenchmarks = Flag False, + configCoverage = Flag False, + configLibCoverage = NoFlag, + configExactConfiguration = Flag False, + configFlagError = NoFlag, + configRelocatable = Flag False, + configDebugInfo = Flag NoDebugInfo, + configDumpBuildInfo = NoFlag, + configUseResponseFiles = NoFlag + } + +configureCommand :: ProgramDb -> CommandUI ConfigFlags +configureCommand progDb = CommandUI + { commandName = "configure" + , commandSynopsis = "Prepare to build the package." + , commandDescription = Just $ \_ -> wrapText $ + "Configure how the package is built by setting " + ++ "package (and other) flags.\n" + ++ "\n" + ++ "The configuration affects several other commands, " + ++ "including build, test, bench, run, repl.\n" + , commandNotes = Just $ \_pname -> programFlagsDescription progDb + , commandUsage = \pname -> + "Usage: " ++ pname ++ " configure [FLAGS]\n" + , commandDefaultFlags = defaultConfigFlags progDb + , commandOptions = \showOrParseArgs -> + configureOptions showOrParseArgs + ++ programDbPaths progDb showOrParseArgs + configProgramPaths (\v fs -> fs { configProgramPaths = v }) + ++ programDbOption progDb showOrParseArgs + configProgramArgs (\v fs -> fs { configProgramArgs = v }) + ++ programDbOptions progDb showOrParseArgs + configProgramArgs (\v fs -> fs { configProgramArgs = v }) + } + +-- | Inverse to 'dispModSubstEntry'. +parsecModSubstEntry :: ParsecParser (ModuleName, Module) +parsecModSubstEntry = do + k <- parsec + _ <- P.char '=' + v <- parsec + return (k, v) + +-- | Pretty-print a single entry of a module substitution. +dispModSubstEntry :: (ModuleName, Module) -> Disp.Doc +dispModSubstEntry (k, v) = pretty k <<>> Disp.char '=' <<>> pretty v + +configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] +configureOptions showOrParseArgs = + [optionVerbosity configVerbosity + (\v flags -> flags { configVerbosity = v }) + ,optionDistPref + configDistPref (\d flags -> flags { configDistPref = d }) + showOrParseArgs + + ,option [] ["compiler"] "compiler" + configHcFlavor (\v flags -> flags { configHcFlavor = v }) + (choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") + , (Flag GHCJS, ([] , ["ghcjs"]), "compile with GHCJS") + , (Flag UHC, ([] , ["uhc"]), "compile with UHC") + -- "haskell-suite" compiler id string will be replaced + -- by a more specific one during the configure stage + , (Flag (HaskellSuite "haskell-suite"), ([] , ["haskell-suite"]), + "compile with a haskell-suite compiler")]) + + ,option "" ["cabal-file"] + "use this Cabal file" + configCabalFilePath (\v flags -> flags { configCabalFilePath = v }) + (reqArgFlag "PATH") + + ,option "w" ["with-compiler"] + "give the path to a particular compiler" + configHcPath (\v flags -> flags { configHcPath = v }) + (reqArgFlag "PATH") + + ,option "" ["with-hc-pkg"] + "give the path to the package tool" + configHcPkg (\v flags -> flags { configHcPkg = v }) + (reqArgFlag "PATH") + ] + ++ map liftInstallDirs installDirsOptions + ++ [option "" ["program-prefix"] + "prefix to be applied to installed executables" + configProgPrefix + (\v flags -> flags { configProgPrefix = v }) + (reqPathTemplateArgFlag "PREFIX") + + ,option "" ["program-suffix"] + "suffix to be applied to installed executables" + configProgSuffix (\v flags -> flags { configProgSuffix = v } ) + (reqPathTemplateArgFlag "SUFFIX") + + ,option "" ["library-vanilla"] + "Vanilla libraries" + configVanillaLib (\v flags -> flags { configVanillaLib = v }) + (boolOpt [] []) + + ,option "p" ["library-profiling"] + "Library profiling" + configProfLib (\v flags -> flags { configProfLib = v }) + (boolOpt "p" []) + + ,option "" ["shared"] + "Shared library" + configSharedLib (\v flags -> flags { configSharedLib = v }) + (boolOpt [] []) + + ,option "" ["static"] + "Static library" + configStaticLib (\v flags -> flags { configStaticLib = v }) + (boolOpt [] []) + + ,option "" ["executable-dynamic"] + "Executable dynamic linking" + configDynExe (\v flags -> flags { configDynExe = v }) + (boolOpt [] []) + + ,option "" ["executable-static"] + "Executable fully static linking" + configFullyStaticExe (\v flags -> flags { configFullyStaticExe = v }) + (boolOpt [] []) + + ,option "" ["profiling"] + "Executable and library profiling" + configProf (\v flags -> flags { configProf = v }) + (boolOpt [] []) + + ,option "" ["executable-profiling"] + "Executable profiling (DEPRECATED)" + configProfExe (\v flags -> flags { configProfExe = v }) + (boolOpt [] []) + + ,option "" ["profiling-detail"] + ("Profiling detail level for executable and library (default, " ++ + "none, exported-functions, toplevel-functions, all-functions, late).") + configProfDetail (\v flags -> flags { configProfDetail = v }) + (reqArg' "level" (Flag . flagToProfDetailLevel) + showProfDetailLevelFlag) + + ,option "" ["library-profiling-detail"] + "Profiling detail level for libraries only." + configProfLibDetail (\v flags -> flags { configProfLibDetail = v }) + (reqArg' "level" (Flag . flagToProfDetailLevel) + showProfDetailLevelFlag) + + ,multiOption "optimization" + configOptimization (\v flags -> flags { configOptimization = v }) + [optArg' "n" (Flag . flagToOptimisationLevel) + (\f -> case f of + Flag NoOptimisation -> [] + Flag NormalOptimisation -> [Nothing] + Flag MaximumOptimisation -> [Just "2"] + _ -> []) + "O" ["enable-optimization","enable-optimisation"] + "Build with optimization (n is 0--2, default is 1)", + noArg (Flag NoOptimisation) [] + ["disable-optimization","disable-optimisation"] + "Build without optimization" + ] + + ,multiOption "debug-info" + configDebugInfo (\v flags -> flags { configDebugInfo = v }) + [optArg' "n" (Flag . flagToDebugInfoLevel) + (\f -> case f of + Flag NoDebugInfo -> [] + Flag MinimalDebugInfo -> [Just "1"] + Flag NormalDebugInfo -> [Nothing] + Flag MaximalDebugInfo -> [Just "3"] + _ -> []) + "" ["enable-debug-info"] + "Emit debug info (n is 0--3, default is 0)", + noArg (Flag NoDebugInfo) [] + ["disable-debug-info"] + "Don't emit debug info" + ] + + , multiOption "build-info" + configDumpBuildInfo + (\v flags -> flags { configDumpBuildInfo = v }) + [noArg (Flag DumpBuildInfo) [] + ["enable-build-info"] + "Enable build information generation during project building", + noArg (Flag NoDumpBuildInfo) [] + ["disable-build-info"] + "Disable build information generation during project building" + ] + + ,option "" ["library-for-ghci"] + "compile library for use with GHCi" + configGHCiLib (\v flags -> flags { configGHCiLib = v }) + (boolOpt [] []) + + ,option "" ["split-sections"] + "compile library code such that unneeded definitions can be dropped from the final executable (GHC 7.8+)" + configSplitSections (\v flags -> flags { configSplitSections = v }) + (boolOpt [] []) + + ,option "" ["split-objs"] + "split library into smaller objects to reduce binary sizes (GHC 6.6+)" + configSplitObjs (\v flags -> flags { configSplitObjs = v }) + (boolOpt [] []) + + ,option "" ["executable-stripping"] + "strip executables upon installation to reduce binary sizes" + configStripExes (\v flags -> flags { configStripExes = v }) + (boolOpt [] []) + + ,option "" ["library-stripping"] + "strip libraries upon installation to reduce binary sizes" + configStripLibs (\v flags -> flags { configStripLibs = v }) + (boolOpt [] []) + + ,option "" ["configure-option"] + "Extra option for configure" + configConfigureArgs (\v flags -> flags { configConfigureArgs = v }) + (reqArg' "OPT" (\x -> [x]) id) + + ,option "" ["user-install"] + "doing a per-user installation" + configUserInstall (\v flags -> flags { configUserInstall = v }) + (boolOpt' ([],["user"]) ([], ["global"])) + + ,option "" ["package-db"] + ( "Append the given package database to the list of package" + ++ " databases used (to satisfy dependencies and register into)." + ++ " May be a specific file, 'global' or 'user'. The initial list" + ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," + ++ " depending on context. Use 'clear' to reset the list to empty." + ++ " See the user guide for details.") + configPackageDBs (\v flags -> flags { configPackageDBs = v }) + (reqArg' "DB" readPackageDbList showPackageDbList) + + ,option "f" ["flags"] + "Force values for the given flags in Cabal conditionals in the .cabal file. E.g., --flags=\"debug -usebytestrings\" forces the flag \"debug\" to true and \"usebytestrings\" to false." + configConfigurationsFlags (\v flags -> flags { configConfigurationsFlags = v }) + (reqArg "FLAGS" + (parsecToReadE (\err -> "Invalid flag assignment: " ++ err) legacyParsecFlagAssignment) + legacyShowFlagAssignment') + + ,option "" ["extra-include-dirs"] + "A list of directories to search for header files" + configExtraIncludeDirs (\v flags -> flags {configExtraIncludeDirs = v}) + (reqArg' "PATH" (\x -> [x]) id) + + ,option "" ["deterministic"] + "Try to be as deterministic as possible (used by the test suite)" + configDeterministic (\v flags -> flags {configDeterministic = v}) + (boolOpt [] []) + + ,option "" ["ipid"] + "Installed package ID to compile this package as" + configIPID (\v flags -> flags {configIPID = v}) + (reqArgFlag "IPID") + + ,option "" ["cid"] + "Installed component ID to compile this component as" + (fmap prettyShow . configCID) (\v flags -> flags {configCID = fmap mkComponentId v}) + (reqArgFlag "CID") + + ,option "" ["extra-lib-dirs"] + "A list of directories to search for external libraries" + configExtraLibDirs (\v flags -> flags {configExtraLibDirs = v}) + (reqArg' "PATH" (\x -> [x]) id) + + ,option "" ["extra-lib-dirs-static"] + "A list of directories to search for external libraries when linking fully static executables" + configExtraLibDirsStatic (\v flags -> flags {configExtraLibDirsStatic = v}) + (reqArg' "PATH" (\x -> [x]) id) + + ,option "" ["extra-framework-dirs"] + "A list of directories to search for external frameworks (OS X only)" + configExtraFrameworkDirs + (\v flags -> flags {configExtraFrameworkDirs = v}) + (reqArg' "PATH" (\x -> [x]) id) + + ,option "" ["extra-prog-path"] + "A list of directories to search for required programs (in addition to the normal search locations)" + configProgramPathExtra (\v flags -> flags {configProgramPathExtra = v}) + (reqArg' "PATH" (\x -> toNubList [x]) fromNubList) + + ,option "" ["constraint"] + "A list of additional constraints on the dependencies." + configConstraints (\v flags -> flags { configConstraints = v}) + (reqArg "DEPENDENCY" + (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsec)) + (map prettyShow)) + + ,option "" ["dependency"] + "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" + configDependencies (\v flags -> flags { configDependencies = v}) + (reqArg "NAME[:COMPONENT_NAME]=CID" + (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) + (map (\(GivenComponent pn cn cid) -> + prettyShow pn + ++ case cn of LMainLibName -> "" + LSubLibName n -> ":" ++ prettyShow n + ++ "=" ++ prettyShow cid))) + + ,option "" ["instantiate-with"] + "A mapping of signature names to concrete module instantiations." + configInstantiateWith (\v flags -> flags { configInstantiateWith = v }) + (reqArg "NAME=MOD" + (parsecToReadE ("Cannot parse module substitution: " ++) (fmap (:[]) parsecModSubstEntry)) + (map (Disp.renderStyle defaultStyle . dispModSubstEntry))) + + ,option "" ["tests"] + "dependency checking and compilation for test suites listed in the package description file." + configTests (\v flags -> flags { configTests = v }) + (boolOpt [] []) + + ,option "" ["coverage"] + "build package with Haskell Program Coverage. (GHC only)" + configCoverage (\v flags -> flags { configCoverage = v }) + (boolOpt [] []) + + ,option "" ["library-coverage"] + "build package with Haskell Program Coverage. (GHC only) (DEPRECATED)" + configLibCoverage (\v flags -> flags { configLibCoverage = v }) + (boolOpt [] []) + + ,option "" ["exact-configuration"] + "All direct dependencies and flags are provided on the command line." + configExactConfiguration + (\v flags -> flags { configExactConfiguration = v }) + trueArg + + ,option "" ["benchmarks"] + "dependency checking and compilation for benchmarks listed in the package description file." + configBenchmarks (\v flags -> flags { configBenchmarks = v }) + (boolOpt [] []) + + ,option "" ["relocatable"] + "building a package that is relocatable. (GHC only)" + configRelocatable (\v flags -> flags { configRelocatable = v}) + (boolOpt [] []) + + ,option "" ["response-files"] + "enable workaround for old versions of programs like \"ar\" that do not support @file arguments" + configUseResponseFiles + (\v flags -> flags { configUseResponseFiles = v }) + (boolOpt' ([], ["disable-response-files"]) ([], [])) + + ,option "" ["allow-depending-on-private-libs"] + ( "Allow depending on private libraries. " + ++ "If set, the library visibility check MUST be done externally." ) + configAllowDependingOnPrivateLibs + (\v flags -> flags { configAllowDependingOnPrivateLibs = v }) + trueArg + ] + where + liftInstallDirs = + liftOption configInstallDirs (\v flags -> flags { configInstallDirs = v }) + + reqPathTemplateArgFlag title _sf _lf d get set = + reqArgFlag title _sf _lf d + (fmap fromPathTemplate . get) (set . fmap toPathTemplate) + +readPackageDbList :: String -> [Maybe PackageDB] +readPackageDbList str = [readPackageDb str] + +-- | Parse a PackageDB stack entry +-- +-- @since 3.7.0.0 +readPackageDb :: String -> Maybe PackageDB +readPackageDb "clear" = Nothing +readPackageDb "global" = Just GlobalPackageDB +readPackageDb "user" = Just UserPackageDB +readPackageDb other = Just (SpecificPackageDB other) + +showPackageDbList :: [Maybe PackageDB] -> [String] +showPackageDbList = map showPackageDb + +-- | Show a PackageDB stack entry +-- +-- @since 3.7.0.0 +showPackageDb :: Maybe PackageDB -> String +showPackageDb Nothing = "clear" +showPackageDb (Just GlobalPackageDB) = "global" +showPackageDb (Just UserPackageDB) = "user" +showPackageDb (Just (SpecificPackageDB db)) = db + +showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] +showProfDetailLevelFlag NoFlag = [] +showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] + +parsecGivenComponent :: ParsecParser GivenComponent +parsecGivenComponent = do + pn <- parsec + ln <- P.option LMainLibName $ do + _ <- P.char ':' + ucn <- parsec + return $ if unUnqualComponentName ucn == unPackageName pn + then LMainLibName + else LSubLibName ucn + _ <- P.char '=' + cid <- parsec + return $ GivenComponent pn ln cid + +installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] +installDirsOptions = + [ option "" ["prefix"] + "bake this prefix in preparation of installation" + prefix (\v flags -> flags { prefix = v }) + installDirArg + + , option "" ["bindir"] + "installation directory for executables" + bindir (\v flags -> flags { bindir = v }) + installDirArg + + , option "" ["libdir"] + "installation directory for libraries" + libdir (\v flags -> flags { libdir = v }) + installDirArg + + , option "" ["libsubdir"] + "subdirectory of libdir in which libs are installed" + libsubdir (\v flags -> flags { libsubdir = v }) + installDirArg + + , option "" ["dynlibdir"] + "installation directory for dynamic libraries" + dynlibdir (\v flags -> flags { dynlibdir = v }) + installDirArg + + , option "" ["libexecdir"] + "installation directory for program executables" + libexecdir (\v flags -> flags { libexecdir = v }) + installDirArg + + , option "" ["libexecsubdir"] + "subdirectory of libexecdir in which private executables are installed" + libexecsubdir (\v flags -> flags { libexecsubdir = v }) + installDirArg + + , option "" ["datadir"] + "installation directory for read-only data" + datadir (\v flags -> flags { datadir = v }) + installDirArg + + , option "" ["datasubdir"] + "subdirectory of datadir in which data files are installed" + datasubdir (\v flags -> flags { datasubdir = v }) + installDirArg + + , option "" ["docdir"] + "installation directory for documentation" + docdir (\v flags -> flags { docdir = v }) + installDirArg + + , option "" ["htmldir"] + "installation directory for HTML documentation" + htmldir (\v flags -> flags { htmldir = v }) + installDirArg + + , option "" ["haddockdir"] + "installation directory for haddock interfaces" + haddockdir (\v flags -> flags { haddockdir = v }) + installDirArg + + , option "" ["sysconfdir"] + "installation directory for configuration files" + sysconfdir (\v flags -> flags { sysconfdir = v }) + installDirArg + ] + where + installDirArg _sf _lf d get set = + reqArgFlag "DIR" _sf _lf d + (fmap fromPathTemplate . get) (set . fmap toPathTemplate) + +emptyConfigFlags :: ConfigFlags +emptyConfigFlags = mempty + +instance Monoid ConfigFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup ConfigFlags where + (<>) = gmappend + + +-- | Arguments to pass to a @configure@ script, e.g. generated by +-- @autoconf@. +configureArgs :: Bool -> ConfigFlags -> [String] +configureArgs bcHack flags + = hc_flag + ++ optFlag "with-hc-pkg" configHcPkg + ++ optFlag' "prefix" prefix + ++ optFlag' "bindir" bindir + ++ optFlag' "libdir" libdir + ++ optFlag' "libexecdir" libexecdir + ++ optFlag' "datadir" datadir + ++ optFlag' "sysconfdir" sysconfdir + ++ configConfigureArgs flags + where + hc_flag = case (configHcFlavor flags, configHcPath flags) of + (_, Flag hc_path) -> [hc_flag_name ++ hc_path] + (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] + (NoFlag,NoFlag) -> [] + hc_flag_name + --TODO kill off thic bc hack when defaultUserHooks is removed. + | bcHack = "--with-hc=" + | otherwise = "--with-compiler=" + optFlag name config_field = case config_field flags of + Flag p -> ["--" ++ name ++ "=" ++ p] + NoFlag -> [] + optFlag' name config_field = optFlag name (fmap fromPathTemplate + . config_field + . configInstallDirs) diff --git a/Cabal/src/Distribution/Simple/Setup/Copy.hs b/Cabal/src/Distribution/Simple/Setup/Copy.hs new file mode 100644 index 00000000000..0da627a734b --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Copy.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Copy +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the copy command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Copy ( + + CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.ReadE +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Copy flags +-- ------------------------------------------------------------ + +-- | Flags to @copy@: (destdir, copy-prefix (backwards compat), verbosity) +data CopyFlags = CopyFlags { + copyDest :: Flag CopyDest, + copyDistPref :: Flag FilePath, + copyVerbosity :: Flag Verbosity, + -- This is the same hack as in 'buildArgs'. But I (ezyang) don't + -- think it's a hack, it's the right way to make hooks more robust + -- TODO: Stop using this eventually when 'UserHooks' gets changed + copyArgs :: [String], + copyCabalFilePath :: Flag FilePath + } + deriving (Show, Generic) + +defaultCopyFlags :: CopyFlags +defaultCopyFlags = CopyFlags { + copyDest = Flag NoCopyDest, + copyDistPref = NoFlag, + copyVerbosity = Flag normal, + copyArgs = [], + copyCabalFilePath = mempty + } + +copyCommand :: CommandUI CopyFlags +copyCommand = CommandUI + { commandName = "copy" + , commandSynopsis = "Copy the files of all/specific components to install locations." + , commandDescription = Just $ \_ -> wrapText $ + "Components encompass executables and libraries. " + ++ "Does not call register, and allows a prefix at install time. " + ++ "Without the --destdir flag, configure determines location.\n" + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " copy " + ++ " All the components in the package\n" + ++ " " ++ pname ++ " copy foo " + ++ " A component (i.e. lib, exe, test suite)" + , commandUsage = usageAlternatives "copy" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultCopyFlags + , commandOptions = \showOrParseArgs -> case showOrParseArgs of + ShowArgs -> filter ((`notElem` ["target-package-db"]) + . optionName) $ copyOptions ShowArgs + ParseArgs -> copyOptions ParseArgs +} + +copyOptions :: ShowOrParseArgs -> [OptionField CopyFlags] +copyOptions showOrParseArgs = + [optionVerbosity copyVerbosity (\v flags -> flags { copyVerbosity = v }) + + ,optionDistPref + copyDistPref (\d flags -> flags { copyDistPref = d }) + showOrParseArgs + + ,option "" ["destdir"] + "directory to copy files to, prepended to installation directories" + copyDest (\v flags -> case copyDest flags of + Flag (CopyToDb _) -> error "Use either 'destdir' or 'target-package-db'." + _ -> flags { copyDest = v }) + (reqArg "DIR" (succeedReadE (Flag . CopyTo)) + (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])) + + ,option "" ["target-package-db"] + "package database to copy files into. Required when using ${pkgroot} prefix." + copyDest (\v flags -> case copyDest flags of + NoFlag -> flags { copyDest = v } + Flag NoCopyDest -> flags { copyDest = v } + _ -> error "Use either 'destdir' or 'target-package-db'.") + (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) + (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) + ] + +emptyCopyFlags :: CopyFlags +emptyCopyFlags = mempty + +instance Monoid CopyFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup CopyFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Global.hs b/Cabal/src/Distribution/Simple/Setup/Global.hs new file mode 100644 index 00000000000..35e7b60f842 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Global.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Global +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the global command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Global ( + GlobalFlags(..), emptyGlobalFlags, defaultGlobalFlags, globalCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Common + + +-- ------------------------------------------------------------ +-- * Global flags +-- ------------------------------------------------------------ + +-- In fact since individual flags types are monoids and these are just sets of +-- flags then they are also monoids pointwise. This turns out to be really +-- useful. The mempty is the set of empty flags and mappend allows us to +-- override specific flags. For example we can start with default flags and +-- override with the ones we get from a file or the command line, or both. + +-- | Flags that apply at the top level, not to any sub-command. +data GlobalFlags = GlobalFlags { + globalVersion :: Flag Bool, + globalNumericVersion :: Flag Bool + } deriving (Generic, Typeable) + +defaultGlobalFlags :: GlobalFlags +defaultGlobalFlags = GlobalFlags { + globalVersion = Flag False, + globalNumericVersion = Flag False + } + +globalCommand :: [Command action] -> CommandUI GlobalFlags +globalCommand commands = CommandUI + { commandName = "" + , commandSynopsis = "" + , commandUsage = \pname -> + "This Setup program uses the Haskell Cabal Infrastructure.\n" + ++ "See http://www.haskell.org/cabal/ for more information.\n" + ++ "\n" + ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n" + , commandDescription = Just $ \pname -> + let + commands' = commands ++ [commandAddAction helpCommandUI undefined] + cmdDescs = getNormalCommandDescriptions commands' + maxlen = maximum $ [length name | (name, _) <- cmdDescs] + align str = str ++ replicate (maxlen - length str) ' ' + in + "Commands:\n" + ++ unlines [ " " ++ align name ++ " " ++ descr + | (name, descr) <- cmdDescs ] + ++ "\n" + ++ "For more information about a command use\n" + ++ " " ++ pname ++ " COMMAND --help\n\n" + ++ "Typical steps for installing Cabal packages:\n" + ++ concat [ " " ++ pname ++ " " ++ x ++ "\n" + | x <- ["configure", "build", "install"]] + , commandNotes = Nothing + , commandDefaultFlags = defaultGlobalFlags + , commandOptions = \_ -> + [option ['V'] ["version"] + "Print version information" + globalVersion (\v flags -> flags { globalVersion = v }) + trueArg + ,option [] ["numeric-version"] + "Print just the version number" + globalNumericVersion (\v flags -> flags { globalNumericVersion = v }) + trueArg + ] + } + +emptyGlobalFlags :: GlobalFlags +emptyGlobalFlags = mempty + +instance Monoid GlobalFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup GlobalFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Haddock.hs b/Cabal/src/Distribution/Simple/Setup/Haddock.hs new file mode 100644 index 00000000000..0909d523edc --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Haddock.hs @@ -0,0 +1,520 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Haddock +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the haddock command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Haddock ( + + HaddockTarget(..), + HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand, + Visibility(..), + HaddockProjectFlags(..), emptyHaddockProjectFlags, defaultHaddockProjectFlags, haddockProjectCommand, + haddockOptions, haddockProjectOptions, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Parsec +import Distribution.Pretty +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Program +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Haddock flags +-- ------------------------------------------------------------ + + +-- | When we build haddock documentation, there are two cases: +-- +-- 1. We build haddocks only for the current development version, +-- intended for local use and not for distribution. In this case, +-- we store the generated documentation in @/doc/html/@. +-- +-- 2. We build haddocks for intended for uploading them to hackage. +-- In this case, we need to follow the layout that hackage expects +-- from documentation tarballs, and we might also want to use different +-- flags than for development builds, so in this case we store the generated +-- documentation in @/doc/html/-docs@. +data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic, Typeable) + +instance Binary HaddockTarget +instance Structured HaddockTarget + +instance Pretty HaddockTarget where + pretty ForHackage = Disp.text "for-hackage" + pretty ForDevelopment = Disp.text "for-development" + +instance Parsec HaddockTarget where + parsec = P.choice [ P.try $ P.string "for-hackage" >> return ForHackage + , P.string "for-development" >> return ForDevelopment] + +data HaddockFlags = HaddockFlags { + haddockProgramPaths :: [(String, FilePath)], + haddockProgramArgs :: [(String, [String])], + haddockHoogle :: Flag Bool, + haddockHtml :: Flag Bool, + haddockHtmlLocation :: Flag String, + haddockForHackage :: Flag HaddockTarget, + haddockExecutables :: Flag Bool, + haddockTestSuites :: Flag Bool, + haddockBenchmarks :: Flag Bool, + haddockForeignLibs :: Flag Bool, + haddockInternal :: Flag Bool, + haddockCss :: Flag FilePath, + haddockLinkedSource :: Flag Bool, + haddockQuickJump :: Flag Bool, + haddockHscolourCss :: Flag FilePath, + haddockContents :: Flag PathTemplate, + haddockIndex :: Flag PathTemplate, + haddockDistPref :: Flag FilePath, + haddockKeepTempFiles:: Flag Bool, + haddockVerbosity :: Flag Verbosity, + haddockCabalFilePath :: Flag FilePath, + haddockBaseUrl :: Flag String, + haddockLib :: Flag String, + haddockArgs :: [String] + } + deriving (Show, Generic, Typeable) + +defaultHaddockFlags :: HaddockFlags +defaultHaddockFlags = HaddockFlags { + haddockProgramPaths = mempty, + haddockProgramArgs = [], + haddockHoogle = Flag False, + haddockHtml = Flag False, + haddockHtmlLocation = NoFlag, + haddockForHackage = NoFlag, + haddockExecutables = Flag False, + haddockTestSuites = Flag False, + haddockBenchmarks = Flag False, + haddockForeignLibs = Flag False, + haddockInternal = Flag False, + haddockCss = NoFlag, + haddockLinkedSource = Flag False, + haddockQuickJump = Flag False, + haddockHscolourCss = NoFlag, + haddockContents = NoFlag, + haddockDistPref = NoFlag, + haddockKeepTempFiles= Flag False, + haddockVerbosity = Flag normal, + haddockCabalFilePath = mempty, + haddockIndex = NoFlag, + haddockBaseUrl = NoFlag, + haddockLib = NoFlag, + haddockArgs = mempty + } + +haddockCommand :: CommandUI HaddockFlags +haddockCommand = CommandUI + { commandName = "haddock" + , commandSynopsis = "Generate Haddock HTML documentation." + , commandDescription = Just $ \_ -> + "Requires the program haddock, version 2.x.\n" + , commandNotes = Nothing + , commandUsage = usageAlternatives "haddock" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultHaddockFlags + , commandOptions = \showOrParseArgs -> + haddockOptions showOrParseArgs + ++ programDbPaths progDb ParseArgs + haddockProgramPaths (\v flags -> flags { haddockProgramPaths = v}) + ++ programDbOption progDb showOrParseArgs + haddockProgramArgs (\v fs -> fs { haddockProgramArgs = v }) + ++ programDbOptions progDb ParseArgs + haddockProgramArgs (\v flags -> flags { haddockProgramArgs = v}) + } + where + progDb = addKnownProgram haddockProgram + $ addKnownProgram ghcProgram + $ emptyProgramDb + +haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags] +haddockOptions showOrParseArgs = + [optionVerbosity haddockVerbosity + (\v flags -> flags { haddockVerbosity = v }) + ,optionDistPref + haddockDistPref (\d flags -> flags { haddockDistPref = d }) + showOrParseArgs + + ,option "" ["keep-temp-files"] + "Keep temporary files" + haddockKeepTempFiles (\b flags -> flags { haddockKeepTempFiles = b }) + trueArg + + ,option "" ["hoogle"] + "Generate a hoogle database" + haddockHoogle (\v flags -> flags { haddockHoogle = v }) + trueArg + + ,option "" ["html"] + "Generate HTML documentation (the default)" + haddockHtml (\v flags -> flags { haddockHtml = v }) + trueArg + + ,option "" ["html-location"] + "Location of HTML documentation for pre-requisite packages" + haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v }) + (reqArgFlag "URL") + + ,option "" ["for-hackage"] + "Collection of flags to generate documentation suitable for upload to hackage" + haddockForHackage (\v flags -> flags { haddockForHackage = v }) + (noArg (Flag ForHackage)) + + ,option "" ["executables"] + "Run haddock for Executables targets" + haddockExecutables (\v flags -> flags { haddockExecutables = v }) + trueArg + + ,option "" ["tests"] + "Run haddock for Test Suite targets" + haddockTestSuites (\v flags -> flags { haddockTestSuites = v }) + trueArg + + ,option "" ["benchmarks"] + "Run haddock for Benchmark targets" + haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v }) + trueArg + + ,option "" ["foreign-libraries"] + "Run haddock for Foreign Library targets" + haddockForeignLibs (\v flags -> flags { haddockForeignLibs = v }) + trueArg + + ,option "" ["all"] + "Run haddock for all targets" + (\f -> allFlags [ haddockExecutables f + , haddockTestSuites f + , haddockBenchmarks f + , haddockForeignLibs f + ]) + (\v flags -> flags { haddockExecutables = v + , haddockTestSuites = v + , haddockBenchmarks = v + , haddockForeignLibs = v + }) + trueArg + + ,option "" ["internal"] + "Run haddock for internal modules and include all symbols" + haddockInternal (\v flags -> flags { haddockInternal = v }) + trueArg + + ,option "" ["css"] + "Use PATH as the haddock stylesheet" + haddockCss (\v flags -> flags { haddockCss = v }) + (reqArgFlag "PATH") + + ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"] + "Hyperlink the documentation to the source code" + haddockLinkedSource (\v flags -> flags { haddockLinkedSource = v }) + trueArg + + ,option "" ["quickjump"] + "Generate an index for interactive documentation navigation" + haddockQuickJump (\v flags -> flags { haddockQuickJump = v }) + trueArg + + ,option "" ["hscolour-css"] + "Use PATH as the HsColour stylesheet" + haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v }) + (reqArgFlag "PATH") + + ,option "" ["contents-location"] + "Bake URL in as the location for the contents page" + haddockContents (\v flags -> flags { haddockContents = v }) + (reqArg' "URL" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + + ,option "" ["index-location"] + "Use a separately-generated HTML index" + haddockIndex (\v flags -> flags { haddockIndex = v}) + (reqArg' "URL" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + + ,option "" ["base-url"] + "Base URL for static files." + haddockBaseUrl (\v flags -> flags { haddockBaseUrl = v}) + (reqArgFlag "URL") + + ,option "" ["lib"] + "location of Haddocks static / auxiliary files" + haddockLib (\v flags -> flags { haddockLib = v}) + (reqArgFlag "DIR") + ] + +emptyHaddockFlags :: HaddockFlags +emptyHaddockFlags = mempty + +instance Monoid HaddockFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup HaddockFlags where + (<>) = gmappend + +-- ------------------------------------------------------------ +-- * HaddocksFlags flags +-- ------------------------------------------------------------ + +-- | Governs whether modules from a given interface should be visible or +-- hidden in the Haddock generated content page. We don't expose this +-- functionality to the user, but simply use 'Visible' for only local packages. +-- Visibility of modules is available since @haddock-2.26.1@. +-- +data Visibility = Visible | Hidden + deriving (Eq, Show) + +data HaddockProjectFlags = HaddockProjectFlags { + haddockProjectHackage :: Flag Bool, + -- ^ a shortcut option which builds documentation linked to hackage. It implies: + -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs' + -- * `--quickjump` + -- * `--gen-index` + -- * `--gen-contents` + -- * `--hyperlinked-source` + haddockProjectLocal :: Flag Bool, + -- ^ a shortcut option which builds self contained directory which contains + -- all the documentation, it implies: + -- * `--quickjump` + -- * `--gen-index` + -- * `--gen-contents` + -- * `--hyperlinked-source` + -- + -- And it will also pass `--base-url` option to `haddock`. + + -- options passed to @haddock@ via 'createHaddockIndex' + haddockProjectDir :: Flag String, + -- ^ output directory of combined haddocks, the default is './haddocks' + haddockProjectPrologue :: Flag String, + haddockProjectGenIndex :: Flag Bool, + haddockProjectGenContents :: Flag Bool, + haddockProjectInterfaces :: Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)], + -- ^ 'haddocksInterfaces' is inferred by the 'haddocksAction'; currently not + -- exposed to the user. + + -- options passed to @haddock@ via 'HaddockFlags' when building + -- documentation + + haddockProjectProgramPaths :: [(String, FilePath)], + haddockProjectProgramArgs :: [(String, [String])], + haddockProjectHoogle :: Flag Bool, + -- haddockHtml is not supported + haddockProjectHtmlLocation :: Flag String, + -- haddockForHackage is not supported + haddockProjectExecutables :: Flag Bool, + haddockProjectTestSuites :: Flag Bool, + haddockProjectBenchmarks :: Flag Bool, + haddockProjectForeignLibs :: Flag Bool, + haddockProjectInternal :: Flag Bool, + haddockProjectCss :: Flag FilePath, + haddockProjectLinkedSource :: Flag Bool, + haddockProjectQuickJump :: Flag Bool, + haddockProjectHscolourCss :: Flag FilePath, + -- haddockContent is not supported, a fixed value is provided + -- haddockIndex is not supported, a fixed value is provided + -- haddockDistPerf is not supported, note: it changes location of the haddocks + haddockProjectKeepTempFiles:: Flag Bool, + haddockProjectVerbosity :: Flag Verbosity, + -- haddockBaseUrl is not supported, a fixed value is provided + haddockProjectLib :: Flag String + } + deriving (Show, Generic, Typeable) + +defaultHaddockProjectFlags :: HaddockProjectFlags +defaultHaddockProjectFlags = HaddockProjectFlags { + haddockProjectHackage = Flag False, + haddockProjectLocal = Flag False, + haddockProjectDir = Flag "./haddocks", + haddockProjectPrologue = NoFlag, + haddockProjectGenIndex = Flag False, + haddockProjectGenContents = Flag False, + haddockProjectTestSuites = Flag False, + haddockProjectProgramPaths = mempty, + haddockProjectProgramArgs = mempty, + haddockProjectHoogle = Flag False, + haddockProjectHtmlLocation = NoFlag, + haddockProjectExecutables = Flag False, + haddockProjectBenchmarks = Flag False, + haddockProjectForeignLibs = Flag False, + haddockProjectInternal = Flag False, + haddockProjectCss = NoFlag, + haddockProjectLinkedSource = Flag False, + haddockProjectQuickJump = Flag False, + haddockProjectHscolourCss = NoFlag, + haddockProjectKeepTempFiles= Flag False, + haddockProjectVerbosity = Flag normal, + haddockProjectLib = NoFlag, + haddockProjectInterfaces = NoFlag + } + +haddockProjectCommand :: CommandUI HaddockProjectFlags +haddockProjectCommand = CommandUI + { commandName = "v2-haddock-project" + , commandSynopsis = "Generate Haddocks HTML documentation for the cabal project." + , commandDescription = Just $ \_ -> + "Require the programm haddock, version 2.26.\n" + , commandNotes = Nothing + , commandUsage = usageAlternatives "haddocks" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultHaddockProjectFlags + , commandOptions = \showOrParseArgs -> + haddockProjectOptions showOrParseArgs + ++ programDbPaths progDb ParseArgs + haddockProjectProgramPaths (\v flags -> flags { haddockProjectProgramPaths = v}) + ++ programDbOption progDb showOrParseArgs + haddockProjectProgramArgs (\v fs -> fs { haddockProjectProgramArgs = v }) + ++ programDbOptions progDb ParseArgs + haddockProjectProgramArgs (\v flags -> flags { haddockProjectProgramArgs = v}) + } + where + progDb = addKnownProgram haddockProgram + $ addKnownProgram ghcProgram + $ emptyProgramDb + +haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags] +haddockProjectOptions _showOrParseArgs = + [option "" ["hackage"] + (concat ["A short-cut option to build documentation linked to hackage; " + ,"it implies --quickjump, --gen-index, --gen-contents, " + ,"--hyperlinked-source and --html-location" + ]) + haddockProjectHackage (\v flags -> flags { haddockProjectHackage = v }) + trueArg + + ,option "" ["local"] + (concat ["A short-cut option to build self contained documentation; " + ,"it implies --quickjump, --gen-index, --gen-contents " + ,"and --hyperlinked-source." + ]) + haddockProjectLocal (\v flags -> flags { haddockProjectLocal = v }) + trueArg + + ,option "" ["output"] + "Output directory" + haddockProjectDir (\v flags -> flags { haddockProjectDir = v }) + (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList)) + + ,option "" ["prologue"] + "File path to a prologue file in haddock format" + haddockProjectPrologue (\v flags -> flags { haddockProjectPrologue = v}) + (optArg' "PATH" maybeToFlag (fmap Just . flagToList)) + + ,option "" ["gen-index"] + "Generate index" + haddockProjectGenIndex (\v flags -> flags { haddockProjectGenIndex = v}) + trueArg + + ,option "" ["gen-contents"] + "Generate contents" + haddockProjectGenContents (\v flags -> flags { haddockProjectGenContents = v}) + trueArg + + ,option "" ["hoogle"] + "Generate a hoogle database" + haddockProjectHoogle (\v flags -> flags { haddockProjectHoogle = v }) + trueArg + + ,option "" ["html-location"] + "Location of HTML documentation for pre-requisite packages" + haddockProjectHtmlLocation (\v flags -> flags { haddockProjectHtmlLocation = v }) + (reqArgFlag "URL") + + ,option "" ["executables"] + "Run haddock for Executables targets" + haddockProjectExecutables (\v flags -> flags { haddockProjectExecutables = v }) + trueArg + + ,option "" ["tests"] + "Run haddock for Test Suite targets" + haddockProjectTestSuites (\v flags -> flags { haddockProjectTestSuites = v }) + trueArg + + ,option "" ["benchmarks"] + "Run haddock for Benchmark targets" + haddockProjectBenchmarks (\v flags -> flags { haddockProjectBenchmarks = v }) + trueArg + + ,option "" ["foreign-libraries"] + "Run haddock for Foreign Library targets" + haddockProjectForeignLibs (\v flags -> flags { haddockProjectForeignLibs = v }) + trueArg + + ,option "" ["internal"] + "Run haddock for internal modules and include all symbols" + haddockProjectInternal (\v flags -> flags { haddockProjectInternal = v }) + trueArg + + ,option "" ["css"] + "Use PATH as the haddock stylesheet" + haddockProjectCss (\v flags -> flags { haddockProjectCss = v }) + (reqArgFlag "PATH") + + ,option "" ["hyperlink-source","hyperlink-sources","hyperlinked-source"] + "Hyperlink the documentation to the source code" + haddockProjectLinkedSource (\v flags -> flags { haddockProjectLinkedSource = v }) + trueArg + + ,option "" ["quickjump"] + "Generate an index for interactive documentation navigation" + haddockProjectQuickJump (\v flags -> flags { haddockProjectQuickJump = v }) + trueArg + + ,option "" ["hscolour-css"] + "Use PATH as the HsColour stylesheet" + haddockProjectHscolourCss (\v flags -> flags { haddockProjectHscolourCss = v }) + (reqArgFlag "PATH") + + ,option "" ["keep-temp-files"] + "Keep temporary files" + haddockProjectKeepTempFiles (\b flags -> flags { haddockProjectKeepTempFiles = b }) + trueArg + + ,optionVerbosity haddockProjectVerbosity + (\v flags -> flags { haddockProjectVerbosity = v }) + + ,option "" ["lib"] + "location of Haddocks static / auxiliary files" + haddockProjectLib (\v flags -> flags { haddockProjectLib = v}) + (reqArgFlag "DIR") + ] + + +emptyHaddockProjectFlags :: HaddockProjectFlags +emptyHaddockProjectFlags = mempty + +instance Monoid HaddockProjectFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup HaddockProjectFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Hscolour.hs b/Cabal/src/Distribution/Simple/Setup/Hscolour.hs new file mode 100644 index 00000000000..44debdad5ca --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Hscolour.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Hscolour +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the hscolour command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Hscolour ( + + HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * HsColour flags +-- ------------------------------------------------------------ + +data HscolourFlags = HscolourFlags { + hscolourCSS :: Flag FilePath, + hscolourExecutables :: Flag Bool, + hscolourTestSuites :: Flag Bool, + hscolourBenchmarks :: Flag Bool, + hscolourForeignLibs :: Flag Bool, + hscolourDistPref :: Flag FilePath, + hscolourVerbosity :: Flag Verbosity, + hscolourCabalFilePath :: Flag FilePath + } + deriving (Show, Generic, Typeable) + +emptyHscolourFlags :: HscolourFlags +emptyHscolourFlags = mempty + +defaultHscolourFlags :: HscolourFlags +defaultHscolourFlags = HscolourFlags { + hscolourCSS = NoFlag, + hscolourExecutables = Flag False, + hscolourTestSuites = Flag False, + hscolourBenchmarks = Flag False, + hscolourDistPref = NoFlag, + hscolourForeignLibs = Flag False, + hscolourVerbosity = Flag normal, + hscolourCabalFilePath = mempty + } + +instance Monoid HscolourFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup HscolourFlags where + (<>) = gmappend + +hscolourCommand :: CommandUI HscolourFlags +hscolourCommand = CommandUI + { commandName = "hscolour" + , commandSynopsis = + "Generate HsColour colourised code, in HTML format." + , commandDescription = Just (\_ -> "Requires the hscolour program.\n") + , commandNotes = Just $ \_ -> + "Deprecated in favour of 'cabal haddock --hyperlink-source'." + , commandUsage = \pname -> + "Usage: " ++ pname ++ " hscolour [FLAGS]\n" + , commandDefaultFlags = defaultHscolourFlags + , commandOptions = \showOrParseArgs -> + [optionVerbosity hscolourVerbosity + (\v flags -> flags { hscolourVerbosity = v }) + ,optionDistPref + hscolourDistPref (\d flags -> flags { hscolourDistPref = d }) + showOrParseArgs + + ,option "" ["executables"] + "Run hscolour for Executables targets" + hscolourExecutables (\v flags -> flags { hscolourExecutables = v }) + trueArg + + ,option "" ["tests"] + "Run hscolour for Test Suite targets" + hscolourTestSuites (\v flags -> flags { hscolourTestSuites = v }) + trueArg + + ,option "" ["benchmarks"] + "Run hscolour for Benchmark targets" + hscolourBenchmarks (\v flags -> flags { hscolourBenchmarks = v }) + trueArg + + ,option "" ["foreign-libraries"] + "Run hscolour for Foreign Library targets" + hscolourForeignLibs (\v flags -> flags { hscolourForeignLibs = v }) + trueArg + + ,option "" ["all"] + "Run hscolour for all targets" + (\f -> allFlags [ hscolourExecutables f + , hscolourTestSuites f + , hscolourBenchmarks f + , hscolourForeignLibs f + ]) + (\v flags -> flags { hscolourExecutables = v + , hscolourTestSuites = v + , hscolourBenchmarks = v + , hscolourForeignLibs = v + }) + trueArg + + ,option "" ["css"] + "Use a cascading style sheet" + hscolourCSS (\v flags -> flags { hscolourCSS = v }) + (reqArgFlag "PATH") + ] + } + diff --git a/Cabal/src/Distribution/Simple/Setup/Install.hs b/Cabal/src/Distribution/Simple/Setup/Install.hs new file mode 100644 index 00000000000..5465164284f --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Install.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Install +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the install command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Install ( + InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.ReadE +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Compiler +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Install flags +-- ------------------------------------------------------------ + +-- | Flags to @install@: (package db, verbosity) +data InstallFlags = InstallFlags { + installPackageDB :: Flag PackageDB, + installDest :: Flag CopyDest, + installDistPref :: Flag FilePath, + installUseWrapper :: Flag Bool, + installInPlace :: Flag Bool, + installVerbosity :: Flag Verbosity, + -- this is only here, because we can not + -- change the hooks API. + installCabalFilePath :: Flag FilePath + } + deriving (Show, Generic) + +defaultInstallFlags :: InstallFlags +defaultInstallFlags = InstallFlags { + installPackageDB = NoFlag, + installDest = Flag NoCopyDest, + installDistPref = NoFlag, + installUseWrapper = Flag False, + installInPlace = Flag False, + installVerbosity = Flag normal, + installCabalFilePath = mempty + } + +installCommand :: CommandUI InstallFlags +installCommand = CommandUI + { commandName = "install" + , commandSynopsis = + "Copy the files into the install locations. Run register." + , commandDescription = Just $ \_ -> wrapText $ + "Unlike the copy command, install calls the register command." + ++ "If you want to install into a location that is not what was" + ++ "specified in the configure step, use the copy command.\n" + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " install [FLAGS]\n" + , commandDefaultFlags = defaultInstallFlags + , commandOptions = \showOrParseArgs -> case showOrParseArgs of + ShowArgs -> filter ((`notElem` ["target-package-db"]) + . optionName) $ installOptions ShowArgs + ParseArgs -> installOptions ParseArgs + } + +installOptions :: ShowOrParseArgs -> [OptionField InstallFlags] +installOptions showOrParseArgs = + [optionVerbosity installVerbosity (\v flags -> flags { installVerbosity = v }) + ,optionDistPref + installDistPref (\d flags -> flags { installDistPref = d }) + showOrParseArgs + + ,option "" ["inplace"] + "install the package in the install subdirectory of the dist prefix, so it can be used without being installed" + installInPlace (\v flags -> flags { installInPlace = v }) + trueArg + + ,option "" ["shell-wrappers"] + "using shell script wrappers around executables" + installUseWrapper (\v flags -> flags { installUseWrapper = v }) + (boolOpt [] []) + + ,option "" ["package-db"] "" + installPackageDB (\v flags -> flags { installPackageDB = v }) + (choiceOpt [ (Flag UserPackageDB, ([],["user"]), + "upon configuration register this package in the user's local package database") + , (Flag GlobalPackageDB, ([],["global"]), + "(default) upon configuration register this package in the system-wide package database")]) + ,option "" ["target-package-db"] + "package database to install into. Required when using ${pkgroot} prefix." + installDest (\v flags -> flags { installDest = v }) + (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb)) + (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> [])) + ] + +emptyInstallFlags :: InstallFlags +emptyInstallFlags = mempty + +instance Monoid InstallFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup InstallFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Register.hs b/Cabal/src/Distribution/Simple/Setup/Register.hs new file mode 100644 index 00000000000..2211bbc9a83 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Register.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Register +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the register command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Register ( + RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand, + unregisterCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Compiler +import Distribution.Simple.Flag +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Register flags +-- ------------------------------------------------------------ + +-- | Flags to @register@ and @unregister@: (user package, gen-script, +-- in-place, verbosity) +data RegisterFlags = RegisterFlags { + regPackageDB :: Flag PackageDB, + regGenScript :: Flag Bool, + regGenPkgConf :: Flag (Maybe FilePath), + regInPlace :: Flag Bool, + regDistPref :: Flag FilePath, + regPrintId :: Flag Bool, + regVerbosity :: Flag Verbosity, + -- Same as in 'buildArgs' and 'copyArgs' + regArgs :: [String], + regCabalFilePath :: Flag FilePath + } + deriving (Show, Generic, Typeable) + +defaultRegisterFlags :: RegisterFlags +defaultRegisterFlags = RegisterFlags { + regPackageDB = NoFlag, + regGenScript = Flag False, + regGenPkgConf = NoFlag, + regInPlace = Flag False, + regDistPref = NoFlag, + regPrintId = Flag False, + regArgs = [], + regCabalFilePath = mempty, + regVerbosity = Flag normal + } + +registerCommand :: CommandUI RegisterFlags +registerCommand = CommandUI + { commandName = "register" + , commandSynopsis = + "Register this package with the compiler." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " register [FLAGS]\n" + , commandDefaultFlags = defaultRegisterFlags + , commandOptions = \showOrParseArgs -> + [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) + ,optionDistPref + regDistPref (\d flags -> flags { regDistPref = d }) + showOrParseArgs + + ,option "" ["packageDB"] "" + regPackageDB (\v flags -> flags { regPackageDB = v }) + (choiceOpt [ (Flag UserPackageDB, ([],["user"]), + "upon registration, register this package in the user's local package database") + , (Flag GlobalPackageDB, ([],["global"]), + "(default)upon registration, register this package in the system-wide package database")]) + + ,option "" ["inplace"] + "register the package in the build location, so it can be used without being installed" + regInPlace (\v flags -> flags { regInPlace = v }) + trueArg + + ,option "" ["gen-script"] + "instead of registering, generate a script to register later" + regGenScript (\v flags -> flags { regGenScript = v }) + trueArg + + ,option "" ["gen-pkg-config"] + "instead of registering, generate a package registration file/directory" + regGenPkgConf (\v flags -> flags { regGenPkgConf = v }) + (optArg' "PKG" Flag flagToList) + + ,option "" ["print-ipid"] + "print the installed package ID calculated for this package" + regPrintId (\v flags -> flags { regPrintId = v }) + trueArg + ] + } + +unregisterCommand :: CommandUI RegisterFlags +unregisterCommand = CommandUI + { commandName = "unregister" + , commandSynopsis = + "Unregister this package with the compiler." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " unregister [FLAGS]\n" + , commandDefaultFlags = defaultRegisterFlags + , commandOptions = \showOrParseArgs -> + [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) + ,optionDistPref + regDistPref (\d flags -> flags { regDistPref = d }) + showOrParseArgs + + ,option "" ["user"] "" + regPackageDB (\v flags -> flags { regPackageDB = v }) + (choiceOpt [ (Flag UserPackageDB, ([],["user"]), + "unregister this package in the user's local package database") + , (Flag GlobalPackageDB, ([],["global"]), + "(default) unregister this package in the system-wide package database")]) + + ,option "" ["gen-script"] + "Instead of performing the unregister command, generate a script to unregister later" + regGenScript (\v flags -> flags { regGenScript = v }) + trueArg + ] + } + +emptyRegisterFlags :: RegisterFlags +emptyRegisterFlags = mempty + +instance Monoid RegisterFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup RegisterFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Repl.hs b/Cabal/src/Distribution/Simple/Setup/Repl.hs new file mode 100644 index 00000000000..2ae90e57c91 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Repl.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.Repl +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the repl command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Repl ( + + ReplFlags(..), defaultReplFlags, replCommand, + ReplOptions(..), + replOptions, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.ReadE +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.Program +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * REPL Flags +-- ------------------------------------------------------------ + +data ReplOptions = ReplOptions { + replOptionsFlags :: [String], + replOptionsNoLoad :: Flag Bool + } + deriving (Show, Generic, Typeable) + +instance Binary ReplOptions +instance Structured ReplOptions + + +instance Monoid ReplOptions where + mempty = ReplOptions mempty (Flag False) + mappend = (<>) + +instance Semigroup ReplOptions where + (<>) = gmappend + +data ReplFlags = ReplFlags { + replProgramPaths :: [(String, FilePath)], + replProgramArgs :: [(String, [String])], + replDistPref :: Flag FilePath, + replVerbosity :: Flag Verbosity, + replReload :: Flag Bool, + replReplOptions :: ReplOptions + } + deriving (Show, Generic, Typeable) + +defaultReplFlags :: ReplFlags +defaultReplFlags = ReplFlags { + replProgramPaths = mempty, + replProgramArgs = [], + replDistPref = NoFlag, + replVerbosity = Flag normal, + replReload = Flag False, + replReplOptions = mempty + } + +instance Monoid ReplFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup ReplFlags where + (<>) = gmappend + +replCommand :: ProgramDb -> CommandUI ReplFlags +replCommand progDb = CommandUI + { commandName = "repl" + , commandSynopsis = + "Open an interpreter session for the given component." + , commandDescription = Just $ \pname -> wrapText $ + "If the current directory contains no package, ignores COMPONENT " + ++ "parameters and opens an interactive interpreter session; if a " + ++ "sandbox is present, its package database will be used.\n" + ++ "\n" + ++ "Otherwise, (re)configures with the given or default flags, and " + ++ "loads the interpreter with the relevant modules. For executables, " + ++ "tests and benchmarks, loads the main module (and its " + ++ "dependencies); for libraries all exposed/other modules.\n" + ++ "\n" + ++ "The default component is the library itself, or the executable " + ++ "if that is the only component.\n" + ++ "\n" + ++ "Support for loading specific modules is planned but not " + ++ "implemented yet. For certain scenarios, `" ++ pname + ++ " exec -- ghci :l Foo` may be used instead. Note that `exec` will " + ++ "not (re)configure and you will have to specify the location of " + ++ "other modules, if required.\n" + + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " repl " + ++ " The first component in the package\n" + ++ " " ++ pname ++ " repl foo " + ++ " A named component (i.e. lib, exe, test suite)\n" + ++ " " ++ pname ++ " repl --repl-options=\"-lstdc++\"" + ++ " Specifying flags for interpreter\n" +--TODO: re-enable once we have support for module/file targets +-- ++ " " ++ pname ++ " repl Foo.Bar " +-- ++ " A module\n" +-- ++ " " ++ pname ++ " repl Foo/Bar.hs" +-- ++ " A file\n\n" +-- ++ "If a target is ambiguous it can be qualified with the component " +-- ++ "name, e.g.\n" +-- ++ " " ++ pname ++ " repl foo:Foo.Bar\n" +-- ++ " " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n" + , commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n" + , commandDefaultFlags = defaultReplFlags + , commandOptions = \showOrParseArgs -> + optionVerbosity replVerbosity (\v flags -> flags { replVerbosity = v }) + : optionDistPref + replDistPref (\d flags -> flags { replDistPref = d }) + showOrParseArgs + + : programDbPaths progDb showOrParseArgs + replProgramPaths (\v flags -> flags { replProgramPaths = v}) + + ++ programDbOption progDb showOrParseArgs + replProgramArgs (\v flags -> flags { replProgramArgs = v}) + + ++ programDbOptions progDb showOrParseArgs + replProgramArgs (\v flags -> flags { replProgramArgs = v}) + + ++ case showOrParseArgs of + ParseArgs -> + [ option "" ["reload"] + "Used from within an interpreter to update files." + replReload (\v flags -> flags { replReload = v }) + trueArg + ] + _ -> [] + ++ map liftReplOption (replOptions showOrParseArgs) + } + where + liftReplOption = liftOption replReplOptions (\v flags -> flags { replReplOptions = v }) + +replOptions :: ShowOrParseArgs -> [OptionField ReplOptions] +replOptions _ = + [ option [] ["repl-no-load"] + "Disable loading of project modules at REPL startup." + replOptionsNoLoad (\p flags -> flags { replOptionsNoLoad = p }) + trueArg + , option [] ["repl-options"] + "Use the option(s) for the repl" + replOptionsFlags (\p flags -> flags { replOptionsFlags = p }) + (reqArg "FLAG" (succeedReadE words) id) + ] + diff --git a/Cabal/src/Distribution/Simple/Setup/SDist.hs b/Cabal/src/Distribution/Simple/Setup/SDist.hs new file mode 100644 index 00000000000..214c9222ff2 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/SDist.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Setup.SDist +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the sdist command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.SDist ( + + SDistFlags(..), emptySDistFlags, defaultSDistFlags, sdistCommand, + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * SDist flags +-- ------------------------------------------------------------ + +-- | Flags to @sdist@: (snapshot, verbosity) +data SDistFlags = SDistFlags { + sDistSnapshot :: Flag Bool, + sDistDirectory :: Flag FilePath, + sDistDistPref :: Flag FilePath, + sDistListSources :: Flag FilePath, + sDistVerbosity :: Flag Verbosity + } + deriving (Show, Generic, Typeable) + +defaultSDistFlags :: SDistFlags +defaultSDistFlags = SDistFlags { + sDistSnapshot = Flag False, + sDistDirectory = mempty, + sDistDistPref = NoFlag, + sDistListSources = mempty, + sDistVerbosity = Flag normal + } + +sdistCommand :: CommandUI SDistFlags +sdistCommand = CommandUI + { commandName = "sdist" + , commandSynopsis = + "Generate a source distribution file (.tar.gz)." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " sdist [FLAGS]\n" + , commandDefaultFlags = defaultSDistFlags + , commandOptions = \showOrParseArgs -> + [optionVerbosity sDistVerbosity (\v flags -> flags { sDistVerbosity = v }) + ,optionDistPref + sDistDistPref (\d flags -> flags { sDistDistPref = d }) + showOrParseArgs + + ,option "" ["list-sources"] + "Just write a list of the package's sources to a file" + sDistListSources (\v flags -> flags { sDistListSources = v }) + (reqArgFlag "FILE") + + ,option "" ["snapshot"] + "Produce a snapshot source distribution" + sDistSnapshot (\v flags -> flags { sDistSnapshot = v }) + trueArg + + ,option "" ["output-directory"] + ("Generate a source distribution in the given directory, " + ++ "without creating a tarball") + sDistDirectory (\v flags -> flags { sDistDirectory = v }) + (reqArgFlag "DIR") + ] + } + +emptySDistFlags :: SDistFlags +emptySDistFlags = mempty + +instance Monoid SDistFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup SDistFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs new file mode 100644 index 00000000000..ec30e741840 --- /dev/null +++ b/Cabal/src/Distribution/Simple/Setup/Test.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.Test +-- Copyright : Isaac Jones 2003-2004 +-- Duncan Coutts 2007 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Definition of the testing command-line options. +-- See: @Distribution.Simple.Setup@ + +module Distribution.Simple.Setup.Test ( + + TestFlags(..), emptyTestFlags, defaultTestFlags, testCommand, + TestShowDetails(..), + testOptions' , + ) where + +import Prelude () +import Distribution.Compat.Prelude hiding (get) + +import Distribution.ReadE +import Distribution.Parsec +import Distribution.Pretty +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp +import Distribution.Simple.Command hiding (boolOpt, boolOpt') +import Distribution.Simple.Flag +import Distribution.Simple.Utils +import Distribution.Simple.InstallDirs +import Distribution.Verbosity + +import Distribution.Simple.Setup.Common + +-- ------------------------------------------------------------ +-- * Test flags +-- ------------------------------------------------------------ + +data TestShowDetails = Never | Failures | Always | Streaming | Direct + deriving (Eq, Ord, Enum, Bounded, Generic, Show, Typeable) + +instance Binary TestShowDetails +instance Structured TestShowDetails + +knownTestShowDetails :: [TestShowDetails] +knownTestShowDetails = [minBound..maxBound] + +instance Pretty TestShowDetails where + pretty = Disp.text . lowercase . show + +instance Parsec TestShowDetails where + parsec = maybe (fail "invalid TestShowDetails") return . classify =<< ident + where + ident = P.munch1 (\c -> isAlpha c || c == '_' || c == '-') + classify str = lookup (lowercase str) enumMap + enumMap :: [(String, TestShowDetails)] + enumMap = [ (prettyShow x, x) + | x <- knownTestShowDetails ] + +--TODO: do we need this instance? +instance Monoid TestShowDetails where + mempty = Never + mappend = (<>) + +instance Semigroup TestShowDetails where + a <> b = if a < b then b else a + +data TestFlags = TestFlags { + testDistPref :: Flag FilePath, + testVerbosity :: Flag Verbosity, + testHumanLog :: Flag PathTemplate, + testMachineLog :: Flag PathTemplate, + testShowDetails :: Flag TestShowDetails, + testKeepTix :: Flag Bool, + testWrapper :: Flag FilePath, + testFailWhenNoTestSuites :: Flag Bool, + -- TODO: think about if/how options are passed to test exes + testOptions :: [PathTemplate] + } deriving (Show, Generic, Typeable) + +defaultTestFlags :: TestFlags +defaultTestFlags = TestFlags { + testDistPref = NoFlag, + testVerbosity = Flag normal, + testHumanLog = toFlag $ toPathTemplate $ "$pkgid-$test-suite.log", + testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log", + testShowDetails = toFlag Failures, + testKeepTix = toFlag False, + testWrapper = NoFlag, + testFailWhenNoTestSuites = toFlag False, + testOptions = [] + } + +testCommand :: CommandUI TestFlags +testCommand = CommandUI + { commandName = "test" + , commandSynopsis = + "Run all/specific tests in the test suite." + , commandDescription = Just $ \ _pname -> wrapText $ + testOrBenchmarkHelpText "test" + , commandNotes = Nothing + , commandUsage = usageAlternatives "test" + [ "[FLAGS]" + , "TESTCOMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultTestFlags + , commandOptions = testOptions' + } + +testOptions' :: ShowOrParseArgs -> [OptionField TestFlags] +testOptions' showOrParseArgs = + [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) + , optionDistPref + testDistPref (\d flags -> flags { testDistPref = d }) + showOrParseArgs + , option [] ["log"] + ("Log all test suite results to file (name template can use " + ++ "$pkgid, $compiler, $os, $arch, $test-suite, $result)") + testHumanLog (\v flags -> flags { testHumanLog = v }) + (reqArg' "TEMPLATE" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + , option [] ["machine-log"] + ("Produce a machine-readable log file (name template can use " + ++ "$pkgid, $compiler, $os, $arch, $result)") + testMachineLog (\v flags -> flags { testMachineLog = v }) + (reqArg' "TEMPLATE" + (toFlag . toPathTemplate) + (flagToList . fmap fromPathTemplate)) + , option [] ["show-details"] + ("'always': always show results of individual test cases. " + ++ "'never': never show results of individual test cases. " + ++ "'failures': show results of failing test cases. " + ++ "'streaming': show results of test cases in real time." + ++ "'direct': send results of test cases in real time; no log file.") + testShowDetails (\v flags -> flags { testShowDetails = v }) + (reqArg "FILTER" + (parsecToReadE (\_ -> "--show-details flag expects one of " + ++ intercalate ", " + (map prettyShow knownTestShowDetails)) + (fmap toFlag parsec)) + (flagToList . fmap prettyShow)) + , option [] ["keep-tix-files"] + "keep .tix files for HPC between test runs" + testKeepTix (\v flags -> flags { testKeepTix = v}) + trueArg + , option [] ["test-wrapper"] + "Run test through a wrapper." + testWrapper (\v flags -> flags { testWrapper = v }) + (reqArg' "FILE" (toFlag :: FilePath -> Flag FilePath) + (flagToList :: Flag FilePath -> [FilePath])) + , option [] ["fail-when-no-test-suites"] + ("Exit with failure when no test suites are found.") + testFailWhenNoTestSuites (\v flags -> flags { testFailWhenNoTestSuites = v}) + trueArg + , option [] ["test-options"] + ("give extra options to test executables " + ++ "(name templates can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") + testOptions (\v flags -> flags { testOptions = v }) + (reqArg' "TEMPLATES" (map toPathTemplate . splitArgs) + (const [])) + , option [] ["test-option"] + ("give extra option to test executables " + ++ "(no need to quote options containing spaces, " + ++ "name template can use $pkgid, $compiler, " + ++ "$os, $arch, $test-suite)") + testOptions (\v flags -> flags { testOptions = v }) + (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) + (map fromPathTemplate)) + ] + +emptyTestFlags :: TestFlags +emptyTestFlags = mempty + +instance Monoid TestFlags where + mempty = gmempty + mappend = (<>) + +instance Semigroup TestFlags where + (<>) = gmappend + diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 729fb689926..6cfecd8f463 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -76,7 +76,7 @@ import Distribution.Compiler import Distribution.Verbosity import Distribution.Simple.Compiler (Compiler, showCompilerId, compilerFlavor) import Distribution.Simple.Program -import Distribution.Simple.Setup +import Distribution.Simple.Setup.Build ( BuildFlags ) import Distribution.Simple.Utils (cabalVersion) import Distribution.Utils.Json import Distribution.Types.Component diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs index 1cb2b841063..99f1bb8166c 100644 --- a/Cabal/src/Distribution/Simple/SrcDist.hs +++ b/Cabal/src/Distribution/Simple/SrcDist.hs @@ -56,7 +56,8 @@ import Distribution.Version import Distribution.Simple.Configure (findDistPrefOrDefault) import Distribution.Simple.Glob (matchDirFileGlobWithDie) import Distribution.Simple.Utils -import Distribution.Simple.Setup +import Distribution.Simple.Flag +import Distribution.Simple.Setup.SDist import Distribution.Simple.PreProcess import Distribution.Simple.BuildPaths import Distribution.Simple.Program diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs index c13790fc042..90adfb3852e 100644 --- a/Cabal/src/Distribution/Simple/Test.hs +++ b/Cabal/src/Distribution/Simple/Test.hs @@ -28,7 +28,8 @@ import Distribution.Simple.Hpc import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI import qualified Distribution.Types.LocalBuildInfo as LBI -import Distribution.Simple.Setup +import Distribution.Simple.Flag ( fromFlag ) +import Distribution.Simple.Setup.Test import Distribution.Simple.UserHooks import qualified Distribution.Simple.Test.ExeV10 as ExeV10 import qualified Distribution.Simple.Test.LibV09 as LibV09 diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs index 470d682117d..6d120bc58c5 100644 --- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs @@ -18,7 +18,8 @@ import Distribution.Simple.Hpc import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI import qualified Distribution.Types.LocalBuildInfo as LBI -import Distribution.Simple.Setup +import Distribution.Simple.Flag +import Distribution.Simple.Setup.Test import Distribution.Simple.Test.Log import Distribution.Simple.Utils import Distribution.System diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs index 1cf84a25e4f..f1cc099d691 100644 --- a/Cabal/src/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs @@ -24,7 +24,8 @@ import Distribution.Simple.Hpc import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI import qualified Distribution.Types.LocalBuildInfo as LBI -import Distribution.Simple.Setup +import Distribution.Simple.Flag ( Flag(NoFlag, Flag), fromFlag ) +import Distribution.Simple.Setup.Test import Distribution.Simple.Test.Log import Distribution.Simple.Utils import Distribution.System diff --git a/Cabal/src/Distribution/Simple/Test/Log.hs b/Cabal/src/Distribution/Simple/Test/Log.hs index 77939f20b0a..973d56f358b 100644 --- a/Cabal/src/Distribution/Simple/Test/Log.hs +++ b/Cabal/src/Distribution/Simple/Test/Log.hs @@ -23,7 +23,7 @@ import qualified Distribution.PackageDescription as PD import Distribution.Simple.Compiler import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI -import Distribution.Simple.Setup +import Distribution.Simple.Setup.Test ( TestShowDetails(Always, Never) ) import Distribution.Simple.Utils import Distribution.System import Distribution.TestSuite diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index bc9f6bc45d3..c8753d68200 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -67,7 +67,7 @@ import Distribution.Simple.Program import Distribution.PackageDescription import Distribution.Simple.Compiler import Distribution.Simple.PackageIndex -import Distribution.Simple.Setup +import Distribution.Simple.Setup.Config import Distribution.System import Distribution.Pretty diff --git a/changelog.d/pr-8130 b/changelog.d/pr-8130 new file mode 100644 index 00000000000..a89dfb8ea48 --- /dev/null +++ b/changelog.d/pr-8130 @@ -0,0 +1,13 @@ +synopsis: Split up Distribution.Simple.Setup +packages: Cabal +prs: #8130 + +description: { + +The external interface of 'Distribution.Simple.Setup' has been kept the same, but internally it has been broken up into smaller modules. +This improves build times in two ways: +1. GHC is superlinear in the size of files, meaning that splitting up a large file can reduce overall compile times. +2. Breaking up the module allows dependent modules to refine their imports to just the parts they require, allowing them to start buildling quicker +when GHC is run in parrallel make mode ('--ghc-options -j'). + +}