-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | The Haskell Common Architecture for Building Applications and
-- Libraries: a framework defining a common interface for authors to more
-- easily build their Haskell applications in a portable way. . The
-- Haskell Cabal is part of a larger infrastructure for distributing,
-- organizing, and cataloging Haskell libraries and tools.
@package Cabal
@version 3.14.0.0
module Distribution.Backpack.FullUnitId
data FullUnitId
FullUnitId :: ComponentId -> OpenModuleSubst -> FullUnitId
type FullDb = DefUnitId -> FullUnitId
expandOpenUnitId :: FullDb -> OpenUnitId -> FullUnitId
expandUnitId :: FullDb -> DefUnitId -> FullUnitId
instance GHC.Generics.Generic Distribution.Backpack.FullUnitId.FullUnitId
instance GHC.Show.Show Distribution.Backpack.FullUnitId.FullUnitId
-- | A type class ModSubst for objects which can have
-- ModuleSubst applied to them.
--
-- See also
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
module Distribution.Backpack.ModSubst
-- | Applying module substitutions to semantic objects.
class ModSubst a
modSubst :: ModSubst a => OpenModuleSubst -> a -> a
instance Distribution.Backpack.ModSubst.ModSubst Distribution.Backpack.OpenModule
instance Distribution.Backpack.ModSubst.ModSubst Distribution.Backpack.OpenUnitId
instance Distribution.Backpack.ModSubst.ModSubst (Data.Set.Internal.Set Distribution.ModuleName.ModuleName)
instance Distribution.Backpack.ModSubst.ModSubst a => Distribution.Backpack.ModSubst.ModSubst (Data.Map.Internal.Map k a)
instance Distribution.Backpack.ModSubst.ModSubst a => Distribution.Backpack.ModSubst.ModSubst [a]
instance Distribution.Backpack.ModSubst.ModSubst a => Distribution.Backpack.ModSubst.ModSubst (k, a)
-- | See
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
module Distribution.Backpack.ModuleShape
-- | A ModuleShape describes the provisions and requirements of a
-- library. We can extract a ModuleShape from an
-- InstalledPackageInfo.
data ModuleShape
ModuleShape :: OpenModuleSubst -> Set ModuleName -> ModuleShape
[modShapeProvides] :: ModuleShape -> OpenModuleSubst
[modShapeRequires] :: ModuleShape -> Set ModuleName
-- | The default module shape, with no provisions and no requirements.
emptyModuleShape :: ModuleShape
shapeInstalledPackage :: InstalledPackageInfo -> ModuleShape
instance GHC.Generics.Generic Distribution.Backpack.ModuleShape.ModuleShape
instance GHC.Show.Show Distribution.Backpack.ModuleShape.ModuleShape
instance GHC.Classes.Eq Distribution.Backpack.ModuleShape.ModuleShape
instance Data.Binary.Class.Binary Distribution.Backpack.ModuleShape.ModuleShape
instance Distribution.Utils.Structured.Structured Distribution.Backpack.ModuleShape.ModuleShape
instance Distribution.Backpack.ModSubst.ModSubst Distribution.Backpack.ModuleShape.ModuleShape
module Distribution.Backpack.PreModuleShape
data PreModuleShape
PreModuleShape :: Set ModuleName -> Set ModuleName -> PreModuleShape
[preModShapeProvides] :: PreModuleShape -> Set ModuleName
[preModShapeRequires] :: PreModuleShape -> Set ModuleName
toPreModuleShape :: ModuleShape -> PreModuleShape
renamePreModuleShape :: PreModuleShape -> IncludeRenaming -> PreModuleShape
mixLinkPreModuleShape :: [PreModuleShape] -> PreModuleShape
instance GHC.Generics.Generic Distribution.Backpack.PreModuleShape.PreModuleShape
instance GHC.Show.Show Distribution.Backpack.PreModuleShape.PreModuleShape
instance GHC.Classes.Eq Distribution.Backpack.PreModuleShape.PreModuleShape
-- | Deprecated: Use System.Process from package process directly
module Distribution.Compat.CreatePipe
-- | Create a pipe for interprocess communication and return a
-- (readEnd, writeEnd) Handle pair.
--
--
--
-- When this function is used with WinIO enabled it's the caller's
-- responsibility to register the handles with the I/O manager. If this
-- is not done the operation will deadlock. Association can be done as
-- follows:
--
--
-- #if defined(IO_MANAGER_WINIO)
-- import GHC.IO.SubSystem ((!))
-- import GHC.IO.Handle.Windows (handleToHANDLE)
-- import GHC.Event.Windows (associateHandle')
-- #endif
--
-- ...
--
-- #if defined (IO_MANAGER_WINIO)
-- return () ! (do
-- associateHandle' =handleToHANDLE <handle)
-- #endif
--
--
-- Only associate handles that you are in charge of read/writing to. Do
-- not associate handles passed to another process. It's the process's
-- reponsibility to register the handle if it supports async access.
createPipe :: IO (Handle, Handle)
module Distribution.Compat.Directory
-- | listDirectory dir returns a list of all entries
-- in dir without the special entries (. and
-- ..).
--
-- The operation may fail with:
--
--
-- - HardwareFault A physical I/O error has occurred.
-- [EIO]
-- - InvalidArgument The operand is not a valid directory
-- name. [ENAMETOOLONG, ELOOP]
-- - isDoesNotExistError The directory does not exist.
-- [ENOENT, ENOTDIR]
-- - isPermissionError The process has insufficient privileges
-- to perform the operation. [EACCES]
-- - isFullError Insufficient resources are available to perform
-- the operation. [EMFILE, ENFILE]
-- - InappropriateType The path refers to an existing
-- non-directory object. [ENOTDIR]
--
listDirectory :: FilePath -> IO [FilePath]
-- | Convert a path into an absolute path. If the given path is relative,
-- the current directory is prepended and then the combined result is
-- normalized. If the path is already absolute, the path is simply
-- normalized. The function preserves the presence or absence of the
-- trailing path separator unless the path refers to the root directory
-- /.
--
-- If the path is already absolute, the operation never fails. Otherwise,
-- the operation may fail with the same exceptions as
-- getCurrentDirectory.
makeAbsolute :: FilePath -> IO FilePath
-- | Test whether the given path points to an existing filesystem object.
-- If the user lacks necessary permissions to search the parent
-- directories, this function may return false even if the file does
-- actually exist.
doesPathExist :: FilePath -> IO Bool
module Distribution.Compat.FilePath
-- | Does the given filename have the specified extension?
--
--
-- "png" `isExtensionOf` "/directory/file.png" == True
-- ".png" `isExtensionOf` "/directory/file.png" == True
-- ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True
-- "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
-- "png" `isExtensionOf` "/directory/file.png.jpg" == False
-- "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
--
isExtensionOf :: String -> FilePath -> Bool
-- | Drop the given extension from a FilePath, and the "."
-- preceding it. Returns Nothing if the FilePath does not have the
-- given extension, or Just and the part before the extension if
-- it does.
--
-- This function can be more predictable than dropExtensions,
-- especially if the filename might itself contain . characters.
--
--
-- stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"
-- stripExtension "hi.o" "foo.x.hs.o" == Nothing
-- dropExtension x == fromJust (stripExtension (takeExtension x) x)
-- dropExtensions x == fromJust (stripExtension (takeExtensions x) x)
-- stripExtension ".c.d" "a.b.c.d" == Just "a.b"
-- stripExtension ".c.d" "a.b..c.d" == Just "a.b."
-- stripExtension "baz" "foo.bar" == Nothing
-- stripExtension "bar" "foobar" == Nothing
-- stripExtension "" x == Just x
--
stripExtension :: String -> FilePath -> Maybe FilePath
-- | This module re-exports the non-exposed
-- Distribution.Compat.Prelude module for reuse by
-- cabal-install's Distribution.Client.Compat.Prelude
-- module.
--
-- It is highly discouraged to rely on this module for Setup.hs
-- scripts since its API is not stable.
-- | Warning: This modules' API is not stable. Use at your own risk, or
-- better yet, use base-compat!
module Distribution.Compat.Prelude.Internal
module Distribution.Compat.Process
-- | proc with process jobs enabled when appropriate, and defaulting
-- delegate_ctlc to True.
proc :: FilePath -> [String] -> CreateProcess
-- | Enable process jobs to ensure accurate determination of process
-- completion in the presence of exec(3) on Windows.
--
-- Unfortunately the process job support is badly broken in
-- process releases prior to 1.6.9, so we disable it in these
-- versions, despite the fact that this means we may see sporadic build
-- failures without jobs.
--
-- On Windows 7 or before the jobs are disabled due to the fact that
-- processes on these systems can only have one job. This prevents
-- spawned process from assigning jobs to its own children. Suppose
-- process A spawns process B. The B process has a job assigned (call it
-- J1) and when it tries to spawn a new process C the C automatically
-- inherits the job. But at it also tries to assign a new job J2 to C
-- since it doesn’t have access J1. This fails on Windows 7 or before.
enableProcessJobs :: CreateProcess -> CreateProcess
module Distribution.Compat.ResponseFile
-- | The arg file / response file parser.
--
-- This is not a well-documented capability, and is a bit eccentric (try
-- cabal @foo @bar to see what that does), but is crucial for
-- allowing complex arguments to cabal and cabal-install when using
-- command prompts with strongly-limited argument length.
expandResponse :: [String] -> IO [String]
-- | Given a list of strings, concatenate them into a single string with
-- escaping of certain characters, and the addition of a newline between
-- each string. The escaping is done by adding a single backslash
-- character before any whitespace, single quote, double quote, or
-- backslash character, so this escaping character must be removed.
-- Unescaped whitespace (in this case, newline) is part of this
-- "transport" format to indicate the end of the previous string and the
-- start of a new string.
--
-- While unescapeArgs allows using quoting (i.e., convenient
-- escaping of many characters) by having matching sets of single- or
-- double-quotes,escapeArgs does not use the quoting mechanism,
-- and thus will always escape any whitespace, quotes, and backslashes.
--
--
-- escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n"
--
escapeArgs :: [String] -> String
module Distribution.Compat.Stack
type WithCallStack a = HasCallStack => a
-- | CallStacks are a lightweight method of obtaining a partial
-- call-stack at any point in the program.
--
-- A function can request its call-site with the HasCallStack
-- constraint. For example, we can define
--
--
-- putStrLnWithCallStack :: HasCallStack => String -> IO ()
--
--
-- as a variant of putStrLn that will get its call-site and
-- print it, along with the string given as argument. We can access the
-- call-stack inside putStrLnWithCallStack with
-- callStack.
--
--
-- >>> :{
-- putStrLnWithCallStack :: HasCallStack => String -> IO ()
-- putStrLnWithCallStack msg = do
-- putStrLn msg
-- putStrLn (prettyCallStack callStack)
-- :}
--
--
-- Thus, if we call putStrLnWithCallStack we will get a
-- formatted call-stack alongside our string.
--
--
-- >>> putStrLnWithCallStack "hello"
-- hello
-- CallStack (from HasCallStack):
-- putStrLnWithCallStack, called at <interactive>:... in interactive:Ghci...
--
--
-- GHC solves HasCallStack constraints in three steps:
--
--
-- - If there is a CallStack in scope -- i.e. the enclosing
-- function has a HasCallStack constraint -- GHC will append the
-- new call-site to the existing CallStack.
-- - If there is no CallStack in scope -- e.g. in the GHCi
-- session above -- and the enclosing definition does not have an
-- explicit type signature, GHC will infer a HasCallStack
-- constraint for the enclosing definition (subject to the monomorphism
-- restriction).
-- - If there is no CallStack in scope and the enclosing
-- definition has an explicit type signature, GHC will solve the
-- HasCallStack constraint for the singleton CallStack
-- containing just the current call-site.
--
--
-- CallStacks do not interact with the RTS and do not require
-- compilation with -prof. On the other hand, as they are built
-- up explicitly via the HasCallStack constraints, they will
-- generally not contain as much information as the simulated call-stacks
-- maintained by the RTS.
--
-- A CallStack is a [(String, SrcLoc)]. The
-- String is the name of function that was called, the
-- SrcLoc is the call-site. The list is ordered with the most
-- recently called function at the head.
--
-- NOTE: The intrepid user may notice that HasCallStack is just an
-- alias for an implicit parameter ?callStack :: CallStack. This
-- is an implementation detail and should not be considered part
-- of the CallStack API, we may decide to change the
-- implementation in the future.
data () => CallStack
-- | This function is for when you *really* want to add a call stack to
-- raised IO, but you don't have a Verbosity so you can't use
-- annotateIO. If you have a Verbosity, please use that
-- function instead.
annotateCallStackIO :: WithCallStack (IO a -> IO a)
-- | Perform some computation without adding new entries to the
-- CallStack.
withFrozenCallStack :: HasCallStack => (HasCallStack => a) -> a
withLexicalCallStack :: (a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b)
-- | Return the current CallStack.
--
-- Does *not* include the call-site of callStack.
callStack :: HasCallStack => CallStack
-- | Pretty print a CallStack.
prettyCallStack :: CallStack -> String
-- | Give the *parent* of the person who invoked this; so it's most
-- suitable for being called from a utility function. You probably want
-- to call this using withFrozenCallStack; otherwise it's not very
-- useful. We didn't implement this for base-4.8.1 because we cannot rely
-- on freezing to have taken place.
parentSrcLocPrefix :: WithCallStack String
-- | Simple parsing with failure
module Distribution.ReadE
-- | Parser with simple error reporting
newtype ReadE a
ReadE :: (String -> Either ErrorMsg a) -> ReadE a
[runReadE] :: ReadE a -> String -> Either ErrorMsg a
succeedReadE :: (String -> a) -> ReadE a
failReadE :: ErrorMsg -> ReadE a
parsecToReadE :: (String -> ErrorMsg) -> ParsecParser a -> ReadE a
parsecToReadEErr :: (ParseError -> ErrorMsg) -> ParsecParser a -> ReadE a
unexpectMsgString :: ParseError -> String
instance GHC.Base.Functor Distribution.ReadE.ReadE
-- | This modules provides functions for working with both the legacy
-- "build-tools" field, and its replacement, "build-tool-depends". Prefer
-- using the functions contained to access those fields directly.
module Distribution.Simple.BuildToolDepends
-- | Same as desugarBuildTool, but requires atomic informations
-- (package name, executable names) instead of a whole
-- PackageDescription.
desugarBuildToolSimple :: PackageName -> [UnqualComponentName] -> LegacyExeDependency -> Maybe ExeDependency
-- | Desugar a "build-tools" entry into a proper executable dependency if
-- possible.
--
-- An entry can be so desugared in two cases:
--
--
-- - The name in build-tools matches a locally defined executable. The
-- executable dependency produced is on that exe in the current
-- package.
-- - The name in build-tools matches a hard-coded set of known tools.
-- For now, the executable dependency produced is one an executable in a
-- package of the same, but the hard-coding could just as well be
-- per-key.
--
--
-- The first cases matches first.
desugarBuildTool :: PackageDescription -> LegacyExeDependency -> Maybe ExeDependency
-- | Get everything from "build-tool-depends", along with entries from
-- "build-tools" that we know how to desugar.
--
-- This should almost always be used instead of just accessing the
-- buildToolDepends field directly.
getAllToolDependencies :: PackageDescription -> BuildInfo -> [ExeDependency]
-- | Does the given executable dependency map to this current package?
--
-- This is a tiny function, but used in a number of places.
--
-- This function is only sound to call on BuildInfos from the
-- given package description. This is because it just filters the package
-- names of each dependency, and does not check whether version bounds in
-- fact exclude the current package, or the referenced components in fact
-- exist in the current package.
--
-- This is OK because when a package is loaded, it is checked (in
-- Check) that dependencies matching internal components do indeed
-- have version bounds accepting the current package, and any depended-on
-- component in the current package actually exists. In fact this check
-- is performed by gathering the internal tool dependencies of each
-- component of the package according to this module, and ensuring those
-- properties on each so-gathered dependency.
--
-- version bounds and components of the package are unchecked. This is
-- because we sanitize exe deps so that the matching name implies these
-- other conditions.
isInternal :: PackageDescription -> ExeDependency -> Bool
-- | Get internal "build-tool-depends", along with internal "build-tools"
--
-- This is a tiny function, but used in a number of places. The same
-- restrictions that apply to isInternal also apply to this
-- function.
getAllInternalToolDependencies :: PackageDescription -> BuildInfo -> [UnqualComponentName]
module Distribution.Simple.BuildWay
data BuildWay
StaticWay :: BuildWay
DynWay :: BuildWay
ProfWay :: BuildWay
ProfDynWay :: BuildWay
-- | Returns the object/interface extension prefix for the given build way
-- (e.g. "dyn_" for DynWay)
buildWayPrefix :: BuildWay -> String
instance GHC.Enum.Enum Distribution.Simple.BuildWay.BuildWay
instance GHC.Read.Read Distribution.Simple.BuildWay.BuildWay
instance GHC.Show.Show Distribution.Simple.BuildWay.BuildWay
instance GHC.Classes.Ord Distribution.Simple.BuildWay.BuildWay
instance GHC.Classes.Eq Distribution.Simple.BuildWay.BuildWay
-- | This simple package provides types and functions for interacting with
-- C compilers. Currently it's just a type enumerating extant C-like
-- languages, which we call dialects.
module Distribution.Simple.CCompiler
-- | Represents a dialect of C. The Monoid instance expresses backward
-- compatibility, in the sense that 'mappend a b' is the least inclusive
-- dialect which both a and b can be correctly
-- interpreted as.
data CDialect
C :: CDialect
ObjectiveC :: CDialect
CPlusPlus :: CDialect
ObjectiveCPlusPlus :: CDialect
-- | A list of all file extensions which are recognized as possibly
-- containing some dialect of C code. Note that this list is only for
-- source files, not for header files.
cSourceExtensions :: [String]
-- | Takes a dialect of C and whether code is intended to be passed through
-- the preprocessor, and returns a filename extension for containing that
-- code.
cDialectFilenameExtension :: CDialect -> Bool -> String
-- | Infers from a filename's extension the dialect of C which it contains,
-- and whether it is intended to be passed through the preprocessor.
filenameCDialect :: String -> Maybe (CDialect, Bool)
instance GHC.Show.Show Distribution.Simple.CCompiler.CDialect
instance GHC.Classes.Eq Distribution.Simple.CCompiler.CDialect
instance GHC.Base.Monoid Distribution.Simple.CCompiler.CDialect
instance GHC.Base.Semigroup Distribution.Simple.CCompiler.CDialect
-- | Defines the Flag type and it's Monoid instance, see
-- http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html
-- for an explanation.
--
-- Split off from Distribution.Simple.Setup to break import
-- cycles.
module Distribution.Simple.Flag
-- | All flags are monoids, they come in two flavours:
--
--
-- - list flags eg
--
--
--
-- --ghc-option=foo --ghc-option=bar
--
--
-- gives us all the values ["foo", "bar"]
--
--
-- - singular value flags, eg:
--
--
--
-- --enable-foo --disable-foo
--
--
-- gives us Just False
--
-- So, this Flag type is for the latter singular kind of flag. Its
-- monoid instance gives us the behaviour where it starts out as
-- NoFlag and later flags override earlier ones.
--
-- Isomorphic to Maybe a.
data Flag a
Flag :: a -> Flag a
NoFlag :: Flag a
-- | Returns True only if every Flag Bool value is
-- Flag True, else False.
allFlags :: [Flag Bool] -> Flag Bool
-- | Wraps a value in Flag.
toFlag :: a -> Flag a
-- | Extracts a value from a Flag, and throws an exception on
-- NoFlag.
fromFlag :: WithCallStack (Flag a -> a)
-- | Extracts a value from a Flag, and returns the default value on
-- NoFlag.
fromFlagOrDefault :: a -> Flag a -> a
-- | Pushes a function through a Flag value, and returns a default
-- if the Flag value is NoFlag.
flagElim :: b -> (a -> b) -> Flag a -> b
-- | Converts a Flag value to a Maybe value.
flagToMaybe :: Flag a -> Maybe a
-- | Converts a Flag value to a list.
flagToList :: Flag a -> [a]
-- | Converts a Maybe value to a Flag value.
maybeToFlag :: Maybe a -> Flag a
-- | Merge the elements of a list Flag with another list
-- Flag.
mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]
-- | Types that represent boolean flags.
class BooleanFlag a
asBool :: BooleanFlag a => a -> Bool
instance Data.Traversable.Traversable Distribution.Simple.Flag.Flag
instance Data.Foldable.Foldable Distribution.Simple.Flag.Flag
instance GHC.Read.Read a => GHC.Read.Read (Distribution.Simple.Flag.Flag a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Flag.Flag a)
instance GHC.Generics.Generic (Distribution.Simple.Flag.Flag a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.Flag.Flag a)
instance Distribution.Simple.Flag.BooleanFlag GHC.Types.Bool
instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Simple.Flag.Flag a)
instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Simple.Flag.Flag a)
instance GHC.Base.Functor Distribution.Simple.Flag.Flag
instance GHC.Base.Applicative Distribution.Simple.Flag.Flag
instance GHC.Base.Monoid (Distribution.Simple.Flag.Flag a)
instance GHC.Base.Semigroup (Distribution.Simple.Flag.Flag a)
instance GHC.Enum.Bounded a => GHC.Enum.Bounded (Distribution.Simple.Flag.Flag a)
instance GHC.Enum.Enum a => GHC.Enum.Enum (Distribution.Simple.Flag.Flag a)
-- | Internal module for simple file globbing. Please import
-- Distribution.Simple.Glob instead.
module Distribution.Simple.Glob.Internal
-- | A filepath specified by globbing.
data Glob
-- |
-- dirGlob/glob
--
GlobDir :: !GlobPieces -> !Glob -> Glob
-- | **/glob, where ** denotes recursively
-- traversing all directories and matching filenames on glob.
GlobDirRecursive :: !GlobPieces -> Glob
-- | A file glob.
GlobFile :: !GlobPieces -> Glob
-- | Trailing dir; a glob ending in /.
GlobDirTrailing :: Glob
-- | A single directory or file component of a globbed path
type GlobPieces = [GlobPiece]
-- | A piece of a globbing pattern
data GlobPiece
-- | A wildcard *
WildCard :: GlobPiece
-- | A literal string dirABC
Literal :: String -> GlobPiece
-- | A union of patterns, e.g. dir{a,*.txt,c}...
Union :: [GlobPieces] -> GlobPiece
dispGlobPieces :: GlobPieces -> Doc
isGlobEscapedChar :: Char -> Bool
instance GHC.Generics.Generic Distribution.Simple.Glob.Internal.GlobPiece
instance GHC.Show.Show Distribution.Simple.Glob.Internal.GlobPiece
instance GHC.Classes.Eq Distribution.Simple.Glob.Internal.GlobPiece
instance GHC.Generics.Generic Distribution.Simple.Glob.Internal.Glob
instance GHC.Show.Show Distribution.Simple.Glob.Internal.Glob
instance GHC.Classes.Eq Distribution.Simple.Glob.Internal.Glob
instance Data.Binary.Class.Binary Distribution.Simple.Glob.Internal.Glob
instance Distribution.Utils.Structured.Structured Distribution.Simple.Glob.Internal.Glob
instance Distribution.Pretty.Pretty Distribution.Simple.Glob.Internal.Glob
instance Distribution.Parsec.Parsec Distribution.Simple.Glob.Internal.Glob
instance Data.Binary.Class.Binary Distribution.Simple.Glob.Internal.GlobPiece
instance Distribution.Utils.Structured.Structured Distribution.Simple.Glob.Internal.GlobPiece
-- | Types for monitoring files and directories.
module Distribution.Simple.FileMonitor.Types
-- | A file path specified by globbing, relative to some root directory.
data RootedGlob
RootedGlob :: FilePathRoot -> Glob -> RootedGlob
data FilePathRoot
FilePathRelative :: FilePathRoot
-- | e.g. "/", "c:" or result of takeDrive
FilePathRoot :: FilePath -> FilePathRoot
FilePathHomeDir :: FilePathRoot
-- | A filepath specified by globbing.
data Glob
-- | A description of a file (or set of files) to monitor for changes.
--
-- Where file paths are relative they are relative to a common directory
-- (e.g. project root), not necessarily the process current directory.
data MonitorFilePath
MonitorFile :: !MonitorKindFile -> !MonitorKindDir -> !FilePath -> MonitorFilePath
[monitorKindFile] :: MonitorFilePath -> !MonitorKindFile
[monitorKindDir] :: MonitorFilePath -> !MonitorKindDir
[monitorPath] :: MonitorFilePath -> !FilePath
MonitorFileGlob :: !MonitorKindFile -> !MonitorKindDir -> !RootedGlob -> MonitorFilePath
[monitorKindFile] :: MonitorFilePath -> !MonitorKindFile
[monitorKindDir] :: MonitorFilePath -> !MonitorKindDir
[monitorPathGlob] :: MonitorFilePath -> !RootedGlob
data MonitorKindFile
FileExists :: MonitorKindFile
FileModTime :: MonitorKindFile
FileHashed :: MonitorKindFile
FileNotExists :: MonitorKindFile
data MonitorKindDir
DirExists :: MonitorKindDir
DirModTime :: MonitorKindDir
DirNotExists :: MonitorKindDir
-- | Monitor a single file for changes, based on its modification time. The
-- monitored file is considered to have changed if it no longer exists or
-- if its modification time has changed.
monitorFile :: FilePath -> MonitorFilePath
-- | Monitor a single file for changes, based on its modification time and
-- content hash. The monitored file is considered to have changed if it
-- no longer exists or if its modification time and content hash have
-- changed.
monitorFileHashed :: FilePath -> MonitorFilePath
-- | Monitor a single non-existent file for changes. The monitored file is
-- considered to have changed if it exists.
monitorNonExistentFile :: FilePath -> MonitorFilePath
-- | Monitor a single file for existence only. The monitored file is
-- considered to have changed if it no longer exists.
monitorFileExistence :: FilePath -> MonitorFilePath
-- | Monitor a single directory for changes, based on its modification
-- time. The monitored directory is considered to have changed if it no
-- longer exists or if its modification time has changed.
monitorDirectory :: FilePath -> MonitorFilePath
-- | Monitor a single non-existent directory for changes. The monitored
-- directory is considered to have changed if it exists.
monitorNonExistentDirectory :: FilePath -> MonitorFilePath
-- | Monitor a single directory for existence. The monitored directory is
-- considered to have changed only if it no longer exists.
monitorDirectoryExistence :: FilePath -> MonitorFilePath
-- | Monitor a single file or directory for changes, based on its
-- modification time. The monitored file is considered to have changed if
-- it no longer exists or if its modification time has changed.
monitorFileOrDirectory :: FilePath -> MonitorFilePath
-- | Monitor a set of files (or directories) identified by a file glob. The
-- monitored glob is considered to have changed if the set of files
-- matching the glob changes (i.e. creations or deletions), or for files
-- if the modification time and content hash of any matching file has
-- changed.
monitorFileGlob :: RootedGlob -> MonitorFilePath
-- | Monitor a set of files (or directories) identified by a file glob for
-- existence only. The monitored glob is considered to have changed if
-- the set of files matching the glob changes (i.e. creations or
-- deletions).
monitorFileGlobExistence :: RootedGlob -> MonitorFilePath
-- | Creates a list of files to monitor when you search for a file which
-- unsuccessfully looked in notFoundAtPaths before finding it at
-- foundAtPath.
monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
-- | Similar to monitorFileSearchPath, but also instructs us to
-- monitor the hash of the found file.
monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]
instance GHC.Generics.Generic Distribution.Simple.FileMonitor.Types.FilePathRoot
instance GHC.Show.Show Distribution.Simple.FileMonitor.Types.FilePathRoot
instance GHC.Classes.Eq Distribution.Simple.FileMonitor.Types.FilePathRoot
instance GHC.Generics.Generic Distribution.Simple.FileMonitor.Types.RootedGlob
instance GHC.Show.Show Distribution.Simple.FileMonitor.Types.RootedGlob
instance GHC.Classes.Eq Distribution.Simple.FileMonitor.Types.RootedGlob
instance GHC.Generics.Generic Distribution.Simple.FileMonitor.Types.MonitorKindFile
instance GHC.Show.Show Distribution.Simple.FileMonitor.Types.MonitorKindFile
instance GHC.Classes.Eq Distribution.Simple.FileMonitor.Types.MonitorKindFile
instance GHC.Generics.Generic Distribution.Simple.FileMonitor.Types.MonitorKindDir
instance GHC.Show.Show Distribution.Simple.FileMonitor.Types.MonitorKindDir
instance GHC.Classes.Eq Distribution.Simple.FileMonitor.Types.MonitorKindDir
instance GHC.Generics.Generic Distribution.Simple.FileMonitor.Types.MonitorFilePath
instance GHC.Show.Show Distribution.Simple.FileMonitor.Types.MonitorFilePath
instance GHC.Classes.Eq Distribution.Simple.FileMonitor.Types.MonitorFilePath
instance Data.Binary.Class.Binary Distribution.Simple.FileMonitor.Types.MonitorFilePath
instance Distribution.Utils.Structured.Structured Distribution.Simple.FileMonitor.Types.MonitorFilePath
instance Data.Binary.Class.Binary Distribution.Simple.FileMonitor.Types.MonitorKindDir
instance Distribution.Utils.Structured.Structured Distribution.Simple.FileMonitor.Types.MonitorKindDir
instance Data.Binary.Class.Binary Distribution.Simple.FileMonitor.Types.MonitorKindFile
instance Distribution.Utils.Structured.Structured Distribution.Simple.FileMonitor.Types.MonitorKindFile
instance Data.Binary.Class.Binary Distribution.Simple.FileMonitor.Types.RootedGlob
instance Distribution.Utils.Structured.Structured Distribution.Simple.FileMonitor.Types.RootedGlob
instance Distribution.Pretty.Pretty Distribution.Simple.FileMonitor.Types.RootedGlob
instance Distribution.Parsec.Parsec Distribution.Simple.FileMonitor.Types.RootedGlob
instance Data.Binary.Class.Binary Distribution.Simple.FileMonitor.Types.FilePathRoot
instance Distribution.Utils.Structured.Structured Distribution.Simple.FileMonitor.Types.FilePathRoot
instance Distribution.Pretty.Pretty Distribution.Simple.FileMonitor.Types.FilePathRoot
instance Distribution.Parsec.Parsec Distribution.Simple.FileMonitor.Types.FilePathRoot
module Distribution.Simple.InstallDirs.Internal
data PathComponent
Ordinary :: FilePath -> PathComponent
Variable :: PathTemplateVariable -> PathComponent
data PathTemplateVariable
-- | The $prefix path variable
PrefixVar :: PathTemplateVariable
-- | The $bindir path variable
BindirVar :: PathTemplateVariable
-- | The $libdir path variable
LibdirVar :: PathTemplateVariable
-- | The $libsubdir path variable
LibsubdirVar :: PathTemplateVariable
-- | The $dynlibdir path variable
DynlibdirVar :: PathTemplateVariable
-- | The $datadir path variable
DatadirVar :: PathTemplateVariable
-- | The $datasubdir path variable
DatasubdirVar :: PathTemplateVariable
-- | The $docdir path variable
DocdirVar :: PathTemplateVariable
-- | The $htmldir path variable
HtmldirVar :: PathTemplateVariable
-- | The $pkg package name path variable
PkgNameVar :: PathTemplateVariable
-- | The $version package version path variable
PkgVerVar :: PathTemplateVariable
-- | The $pkgid package Id path variable, eg foo-1.0
PkgIdVar :: PathTemplateVariable
-- | The $libname path variable
LibNameVar :: PathTemplateVariable
-- | The compiler name and version, eg ghc-6.6.1
CompilerVar :: PathTemplateVariable
-- | The operating system name, eg windows or linux
OSVar :: PathTemplateVariable
-- | The CPU architecture name, eg i386 or x86_64
ArchVar :: PathTemplateVariable
-- | The compiler's ABI identifier,
AbiVar :: PathTemplateVariable
-- | The optional ABI tag for the compiler
AbiTagVar :: PathTemplateVariable
-- | The executable name; used in shell wrappers
ExecutableNameVar :: PathTemplateVariable
-- | The name of the test suite being run
TestSuiteNameVar :: PathTemplateVariable
-- | The result of the test suite being run, eg pass,
-- fail, or error.
TestSuiteResultVar :: PathTemplateVariable
-- | The name of the benchmark being run
BenchmarkNameVar :: PathTemplateVariable
instance GHC.Generics.Generic Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance GHC.Classes.Ord Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance GHC.Classes.Eq Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance GHC.Generics.Generic Distribution.Simple.InstallDirs.Internal.PathComponent
instance GHC.Classes.Ord Distribution.Simple.InstallDirs.Internal.PathComponent
instance GHC.Classes.Eq Distribution.Simple.InstallDirs.Internal.PathComponent
instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.Internal.PathComponent
instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.Internal.PathComponent
instance GHC.Show.Show Distribution.Simple.InstallDirs.Internal.PathComponent
instance GHC.Read.Read Distribution.Simple.InstallDirs.Internal.PathComponent
instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance GHC.Show.Show Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
instance GHC.Read.Read Distribution.Simple.InstallDirs.Internal.PathTemplateVariable
-- | This manages everything to do with where files get installed (though
-- does not get involved with actually doing any installation). It
-- provides an InstallDirs type which is a set of directories for
-- where to install things. It also handles the fact that we use
-- templates in these install dirs. For example most install dirs are
-- relative to some $prefix and by changing the prefix all other
-- dirs still end up changed appropriately. So it provides a
-- PathTemplate type and functions for substituting for these
-- templates.
module Distribution.Simple.InstallDirs
-- | The directories where we will install files for packages.
--
-- We have several different directories for different types of files
-- since many systems have conventions whereby different types of files
-- in a package are installed in different directories. This is
-- particularly the case on Unix style systems.
data InstallDirs dir
InstallDirs :: dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> InstallDirs dir
[prefix] :: InstallDirs dir -> dir
[bindir] :: InstallDirs dir -> dir
[libdir] :: InstallDirs dir -> dir
[libsubdir] :: InstallDirs dir -> dir
[dynlibdir] :: InstallDirs dir -> dir
-- | foreign libraries
[flibdir] :: InstallDirs dir -> dir
[libexecdir] :: InstallDirs dir -> dir
[libexecsubdir] :: InstallDirs dir -> dir
[includedir] :: InstallDirs dir -> dir
[datadir] :: InstallDirs dir -> dir
[datasubdir] :: InstallDirs dir -> dir
[docdir] :: InstallDirs dir -> dir
[mandir] :: InstallDirs dir -> dir
[htmldir] :: InstallDirs dir -> dir
[haddockdir] :: InstallDirs dir -> dir
[sysconfdir] :: InstallDirs dir -> dir
-- | The installation directories in terms of PathTemplates that
-- contain variables.
--
-- The defaults for most of the directories are relative to each other,
-- in particular they are all relative to a single prefix. This makes it
-- convenient for the user to override the default installation directory
-- by only having to specify --prefix=... rather than overriding each
-- individually. This is done by allowing $-style variables in the dirs.
-- These are expanded by textual substitution (see
-- substPathTemplate).
--
-- A few of these installation directories are split into two components,
-- the dir and subdir. The full installation path is formed by combining
-- the two together with /. The reason for this is compatibility
-- with other Unix build systems which also support --libdir and
-- --datadir. We would like users to be able to configure
-- --libdir=/usr/lib64 for example but because by default we
-- want to support installing multiple versions of packages and building
-- the same package for multiple compilers we append the libsubdir to
-- get: /usr/lib64/$libname/$compiler.
--
-- An additional complication is the need to support relocatable packages
-- on systems which support such things, like Windows.
type InstallDirTemplates = InstallDirs PathTemplate
defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' :: Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
combineInstallDirs :: (a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
-- | Convert from abstract install directories to actual absolute ones by
-- substituting for all the variables in the abstract paths, to get real
-- absolute path.
absoluteInstallDirs :: PackageIdentifier -> UnitId -> CompilerInfo -> CopyDest -> Platform -> InstallDirs PathTemplate -> InstallDirs FilePath
-- | The location prefix for the copy command.
data CopyDest
NoCopyDest :: CopyDest
CopyTo :: FilePath -> CopyDest
-- | when using the ${pkgroot} as prefix. The CopyToDb will adjust the
-- paths to be relative to the provided package database when copying /
-- installing.
CopyToDb :: FilePath -> CopyDest
-- | Check which of the paths are relative to the installation $prefix.
--
-- If any of the paths are not relative, ie they are absolute paths, then
-- it prevents us from making a relocatable package (also known as a
-- "prefix independent" package).
prefixRelativeInstallDirs :: PackageIdentifier -> UnitId -> CompilerInfo -> Platform -> InstallDirTemplates -> InstallDirs (Maybe FilePath)
-- | Substitute the install dir templates into each other.
--
-- To prevent cyclic substitutions, only some variables are allowed in
-- particular dir templates. If out of scope vars are present, they are
-- not substituted for. Checking for any remaining unsubstituted vars can
-- be done as a subsequent operation.
--
-- The reason it is done this way is so that in
-- prefixRelativeInstallDirs we can replace prefix with the
-- PrefixVar and get resulting PathTemplates that still
-- have the PrefixVar in them. Doing this makes it each to check
-- which paths are relative to the $prefix.
substituteInstallDirTemplates :: PathTemplateEnv -> InstallDirTemplates -> InstallDirTemplates
-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real FilePath.
data PathTemplate
data PathTemplateVariable
-- | The $prefix path variable
PrefixVar :: PathTemplateVariable
-- | The $bindir path variable
BindirVar :: PathTemplateVariable
-- | The $libdir path variable
LibdirVar :: PathTemplateVariable
-- | The $libsubdir path variable
LibsubdirVar :: PathTemplateVariable
-- | The $dynlibdir path variable
DynlibdirVar :: PathTemplateVariable
-- | The $datadir path variable
DatadirVar :: PathTemplateVariable
-- | The $datasubdir path variable
DatasubdirVar :: PathTemplateVariable
-- | The $docdir path variable
DocdirVar :: PathTemplateVariable
-- | The $htmldir path variable
HtmldirVar :: PathTemplateVariable
-- | The $pkg package name path variable
PkgNameVar :: PathTemplateVariable
-- | The $version package version path variable
PkgVerVar :: PathTemplateVariable
-- | The $pkgid package Id path variable, eg foo-1.0
PkgIdVar :: PathTemplateVariable
-- | The $libname path variable
LibNameVar :: PathTemplateVariable
-- | The compiler name and version, eg ghc-6.6.1
CompilerVar :: PathTemplateVariable
-- | The operating system name, eg windows or linux
OSVar :: PathTemplateVariable
-- | The CPU architecture name, eg i386 or x86_64
ArchVar :: PathTemplateVariable
-- | The compiler's ABI identifier,
AbiVar :: PathTemplateVariable
-- | The optional ABI tag for the compiler
AbiTagVar :: PathTemplateVariable
-- | The executable name; used in shell wrappers
ExecutableNameVar :: PathTemplateVariable
-- | The name of the test suite being run
TestSuiteNameVar :: PathTemplateVariable
-- | The result of the test suite being run, eg pass,
-- fail, or error.
TestSuiteResultVar :: PathTemplateVariable
-- | The name of the benchmark being run
BenchmarkNameVar :: PathTemplateVariable
type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)]
-- | Convert a FilePath to a PathTemplate including any
-- template vars.
toPathTemplate :: FilePath -> PathTemplate
-- | Convert back to a path, any remaining vars are included
fromPathTemplate :: PathTemplate -> FilePath
combinePathTemplate :: PathTemplate -> PathTemplate -> PathTemplate
substPathTemplate :: PathTemplateEnv -> PathTemplate -> PathTemplate
-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv :: PackageIdentifier -> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
platformTemplateEnv :: Platform -> PathTemplateEnv
compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv
abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv
installDirsTemplateEnv :: InstallDirs PathTemplate -> PathTemplateEnv
instance GHC.Generics.Generic (Distribution.Simple.InstallDirs.InstallDirs dir)
instance GHC.Base.Functor Distribution.Simple.InstallDirs.InstallDirs
instance GHC.Show.Show dir => GHC.Show.Show (Distribution.Simple.InstallDirs.InstallDirs dir)
instance GHC.Read.Read dir => GHC.Read.Read (Distribution.Simple.InstallDirs.InstallDirs dir)
instance GHC.Classes.Eq dir => GHC.Classes.Eq (Distribution.Simple.InstallDirs.InstallDirs dir)
instance GHC.Generics.Generic Distribution.Simple.InstallDirs.CopyDest
instance GHC.Show.Show Distribution.Simple.InstallDirs.CopyDest
instance GHC.Classes.Eq Distribution.Simple.InstallDirs.CopyDest
instance GHC.Generics.Generic Distribution.Simple.InstallDirs.PathTemplate
instance GHC.Classes.Ord Distribution.Simple.InstallDirs.PathTemplate
instance GHC.Classes.Eq Distribution.Simple.InstallDirs.PathTemplate
instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.PathTemplate
instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.PathTemplate
instance GHC.Show.Show Distribution.Simple.InstallDirs.PathTemplate
instance GHC.Read.Read Distribution.Simple.InstallDirs.PathTemplate
instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.CopyDest
instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.CopyDest
instance Data.Binary.Class.Binary dir => Data.Binary.Class.Binary (Distribution.Simple.InstallDirs.InstallDirs dir)
instance Distribution.Utils.Structured.Structured dir => Distribution.Utils.Structured.Structured (Distribution.Simple.InstallDirs.InstallDirs dir)
instance (GHC.Base.Semigroup dir, GHC.Base.Monoid dir) => GHC.Base.Monoid (Distribution.Simple.InstallDirs.InstallDirs dir)
instance GHC.Base.Semigroup dir => GHC.Base.Semigroup (Distribution.Simple.InstallDirs.InstallDirs dir)
-- | Internal utilities used by Distribution.Simple.Program.*.
module Distribution.Simple.Program.Internal
-- | Extract the version number from the output of 'strip --version'.
--
-- Invoking "strip --version" gives very inconsistent results. We ignore
-- everything in parentheses (see #2497), look for the first word that
-- starts with a number, and try parsing out the first two components of
-- it. Non-GNU strip doesn't appear to have a version flag.
stripExtractVersion :: String -> String
-- | This module defines the detailed test suite interface which makes it
-- possible to expose individual tests to Cabal or other test agents.
module Distribution.TestSuite
data TestInstance
TestInstance :: IO Progress -> String -> [String] -> [OptionDescr] -> (String -> String -> Either String TestInstance) -> TestInstance
-- | Perform the test.
[run] :: TestInstance -> IO Progress
-- | A name for the test, unique within a test suite.
[name] :: TestInstance -> String
-- | Users can select groups of tests by their tags.
[tags] :: TestInstance -> [String]
-- | Descriptions of the options recognized by this test.
[options] :: TestInstance -> [OptionDescr]
-- | Try to set the named option to the given value. Returns an error
-- message if the option is not supported or the value could not be
-- correctly parsed; otherwise, a TestInstance with the option set
-- to the given value is returned.
[setOption] :: TestInstance -> String -> String -> Either String TestInstance
data OptionDescr
OptionDescr :: String -> String -> OptionType -> Maybe String -> OptionDescr
[optionName] :: OptionDescr -> String
-- | A human-readable description of the option to guide the user setting
-- it.
[optionDescription] :: OptionDescr -> String
[optionType] :: OptionDescr -> OptionType
[optionDefault] :: OptionDescr -> Maybe String
data OptionType
OptionFile :: Bool -> Bool -> [String] -> OptionType
[optionFileMustExist] :: OptionType -> Bool
[optionFileIsDir] :: OptionType -> Bool
[optionFileExtensions] :: OptionType -> [String]
OptionString :: Bool -> OptionType
[optionStringMultiline] :: OptionType -> Bool
OptionNumber :: Bool -> (Maybe String, Maybe String) -> OptionType
[optionNumberIsInt] :: OptionType -> Bool
[optionNumberBounds] :: OptionType -> (Maybe String, Maybe String)
OptionBool :: OptionType
OptionEnum :: [String] -> OptionType
OptionSet :: [String] -> OptionType
OptionRngSeed :: OptionType
data Test
Test :: TestInstance -> Test
Group :: String -> Bool -> [Test] -> Test
[groupName] :: Test -> String
-- | If true, then children of this group may be run in parallel. Note that
-- this setting is not inherited by children. In particular, consider a
-- group F with "concurrently = False" that has some children, including
-- a group T with "concurrently = True". The children of group T may be
-- run concurrently with each other, as long as none are run at the same
-- time as any of the direct children of group F.
[concurrently] :: Test -> Bool
[groupTests] :: Test -> [Test]
ExtraOptions :: [OptionDescr] -> Test -> Test
type Options = [(String, String)]
data Progress
Finished :: Result -> Progress
Progress :: String -> IO Progress -> Progress
data Result
Pass :: Result
Fail :: String -> Result
Error :: String -> Result
-- | Create a named group of tests, which are assumed to be safe to run in
-- parallel.
testGroup :: String -> [Test] -> Test
instance GHC.Show.Show Distribution.TestSuite.OptionType
instance GHC.Read.Read Distribution.TestSuite.OptionType
instance GHC.Classes.Eq Distribution.TestSuite.OptionType
instance GHC.Show.Show Distribution.TestSuite.OptionDescr
instance GHC.Read.Read Distribution.TestSuite.OptionDescr
instance GHC.Classes.Eq Distribution.TestSuite.OptionDescr
instance GHC.Show.Show Distribution.TestSuite.Result
instance GHC.Read.Read Distribution.TestSuite.Result
instance GHC.Classes.Eq Distribution.TestSuite.Result
module Distribution.Types.AnnotatedId
-- | An AnnotatedId is a ComponentId, UnitId, etc.
-- which is annotated with some other useful information that is useful
-- for printing to users, etc.
--
-- Invariant: if ann_id x == ann_id y, then ann_pid x == ann_pid y and
-- ann_cname x == ann_cname y
data AnnotatedId id
AnnotatedId :: PackageId -> ComponentName -> id -> AnnotatedId id
[ann_pid] :: AnnotatedId id -> PackageId
[ann_cname] :: AnnotatedId id -> ComponentName
[ann_id] :: AnnotatedId id -> id
instance GHC.Base.Functor Distribution.Types.AnnotatedId.AnnotatedId
instance GHC.Show.Show id => GHC.Show.Show (Distribution.Types.AnnotatedId.AnnotatedId id)
instance GHC.Classes.Eq id => GHC.Classes.Eq (Distribution.Types.AnnotatedId.AnnotatedId id)
instance GHC.Classes.Ord id => GHC.Classes.Ord (Distribution.Types.AnnotatedId.AnnotatedId id)
instance Distribution.Package.Package (Distribution.Types.AnnotatedId.AnnotatedId id)
module Distribution.Types.ComponentInclude
data ComponentInclude id rn
ComponentInclude :: AnnotatedId id -> rn -> Bool -> ComponentInclude id rn
[ci_ann_id] :: ComponentInclude id rn -> AnnotatedId id
[ci_renaming] :: ComponentInclude id rn -> rn
-- | Did this come from an entry in mixins, or was implicitly
-- generated by build-depends?
[ci_implicit] :: ComponentInclude id rn -> Bool
ci_id :: ComponentInclude id rn -> id
ci_pkgid :: ComponentInclude id rn -> PackageId
-- | This should always return CLibName or CSubLibName
ci_cname :: ComponentInclude id rn -> ComponentName
module Distribution.Types.ComponentLocalBuildInfo
-- | The first five fields are common across all algebraic variants.
data ComponentLocalBuildInfo
LibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> Bool -> [(ModuleName, OpenModule)] -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> String -> MungedPackageName -> [ExposedModule] -> Bool -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Is this an indefinite component (i.e. has unfilled holes)?
[componentIsIndefinite_] :: ComponentLocalBuildInfo -> Bool
-- | How the component was instantiated
[componentInstantiatedWith] :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | Compatibility "package key" that we pass to older versions of GHC.
[componentCompatPackageKey] :: ComponentLocalBuildInfo -> String
-- | Compatibility "package name" that we register this component as.
[componentCompatPackageName] :: ComponentLocalBuildInfo -> MungedPackageName
-- | A list of exposed modules (either defined in this component, or
-- reexported from another component.)
[componentExposedModules] :: ComponentLocalBuildInfo -> [ExposedModule]
-- | Convenience field, specifying whether or not this is the "public
-- library" that has the same name as the package.
[componentIsPublic] :: ComponentLocalBuildInfo -> Bool
FLibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
ExeComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
TestComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
BenchComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
componentIsIndefinite :: ComponentLocalBuildInfo -> Bool
maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
instance GHC.Show.Show Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
instance GHC.Read.Read Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
instance GHC.Generics.Generic Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
instance Data.Binary.Class.Binary Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
instance Distribution.Utils.Structured.Structured Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
instance Distribution.Compat.Graph.IsNode Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo
module Distribution.Types.DumpBuildInfo
data DumpBuildInfo
NoDumpBuildInfo :: DumpBuildInfo
DumpBuildInfo :: DumpBuildInfo
instance GHC.Generics.Generic Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Enum.Bounded Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Enum.Enum Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Classes.Ord Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Classes.Eq Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Show.Show Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance GHC.Read.Read Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance Data.Binary.Class.Binary Distribution.Types.DumpBuildInfo.DumpBuildInfo
instance Distribution.Utils.Structured.Structured Distribution.Types.DumpBuildInfo.DumpBuildInfo
module Distribution.Types.GivenComponent
-- | A GivenComponent represents a library depended on and
-- explicitly specified by the user/client with --dependency
--
-- It enables Cabal to know which ComponentId to associate with a
-- library
data GivenComponent
GivenComponent :: PackageName -> LibraryName -> ComponentId -> GivenComponent
[givenComponentPackage] :: GivenComponent -> PackageName
[givenComponentName] :: GivenComponent -> LibraryName
[givenComponentId] :: GivenComponent -> ComponentId
-- | A PromisedComponent represents a promised library depended on
-- and explicitly specified by the user/client with
-- --promised-dependency
--
-- It enables Cabal to know which ComponentId to associate with a
-- library
data PromisedComponent
PromisedComponent :: PackageId -> LibraryName -> ComponentId -> PromisedComponent
[promisedComponentPackage] :: PromisedComponent -> PackageId
[promisedComponentName] :: PromisedComponent -> LibraryName
[promisedComponentId] :: PromisedComponent -> ComponentId
instance GHC.Classes.Eq Distribution.Types.GivenComponent.GivenComponent
instance GHC.Show.Show Distribution.Types.GivenComponent.GivenComponent
instance GHC.Read.Read Distribution.Types.GivenComponent.GivenComponent
instance GHC.Generics.Generic Distribution.Types.GivenComponent.GivenComponent
instance GHC.Classes.Eq Distribution.Types.GivenComponent.PromisedComponent
instance GHC.Show.Show Distribution.Types.GivenComponent.PromisedComponent
instance GHC.Read.Read Distribution.Types.GivenComponent.PromisedComponent
instance GHC.Generics.Generic Distribution.Types.GivenComponent.PromisedComponent
instance Data.Binary.Class.Binary Distribution.Types.GivenComponent.PromisedComponent
instance Distribution.Utils.Structured.Structured Distribution.Types.GivenComponent.PromisedComponent
instance Data.Binary.Class.Binary Distribution.Types.GivenComponent.GivenComponent
instance Distribution.Utils.Structured.Structured Distribution.Types.GivenComponent.GivenComponent
-- | Magic PackageNames.
module Distribution.Types.PackageName.Magic
-- | Used as a placeholder in Distribution.Backpack.ReadyComponent
nonExistentPackageThisIsCabalBug :: PackageName
-- | Used by cabal new-repl, cabal new-run and cabal
-- new-build
fakePackageName :: PackageName
-- | Used by cabal new-run and cabal new-build
fakePackageCabalFileName :: FilePath
-- | fakePackageName with version0.
fakePackageId :: PackageId
module Distribution.Types.ParStrat
-- | How to control parallelism, e.g. a fixed number of jobs or by using a
-- system semaphore.
data ParStratX sem
-- | Compile in parallel with the given number of jobs (`-jN` or `-j`).
NumJobs :: Maybe Int -> ParStratX sem
-- | `--semaphore`: use a system semaphore to control parallelism.
UseSem :: sem -> ParStratX sem
-- | No parallelism (neither `-jN` nor `--semaphore`, but could be `-j1`).
Serial :: ParStratX sem
-- | Used by Cabal to indicate that we want to use this specific semaphore
-- (created by cabal-install)
type ParStrat = ParStratX String
-- | Used by cabal-install to say we want to create a semaphore with N
-- slots.
type ParStratInstall = ParStratX Int
-- | Determine if the parallelism strategy enables parallel builds.
isParallelBuild :: ParStratX n -> Bool
instance GHC.Show.Show sem => GHC.Show.Show (Distribution.Types.ParStrat.ParStratX sem)
module Distribution.Types.TargetInfo
-- | The TargetInfo contains all the information necessary to build
-- a specific target (e.g., componentmodulefile) in a package. In
-- principle, one can get the Component from a
-- ComponentLocalBuildInfo and LocalBuildInfo, but it is
-- much more convenient to have the component in hand.
data TargetInfo
TargetInfo :: ComponentLocalBuildInfo -> Component -> TargetInfo
[targetCLBI] :: TargetInfo -> ComponentLocalBuildInfo
[targetComponent] :: TargetInfo -> Component
instance GHC.Show.Show Distribution.Types.TargetInfo.TargetInfo
instance GHC.Generics.Generic Distribution.Types.TargetInfo.TargetInfo
instance Data.Binary.Class.Binary Distribution.Types.TargetInfo.TargetInfo
instance Distribution.Utils.Structured.Structured Distribution.Types.TargetInfo.TargetInfo
instance Distribution.Compat.Graph.IsNode Distribution.Types.TargetInfo.TargetInfo
module Distribution.Utils.IOData
-- | Represents either textual or binary data passed via I/O functions
-- which support binary/text mode
data IOData
-- | How Text gets encoded is usually locale-dependent.
IODataText :: String -> IOData
-- | Raw binary which gets read/written in binary mode.
IODataBinary :: ByteString -> IOData
-- | Phantom-typed GADT representation of the mode of IOData,
-- containing no other data.
data IODataMode mode
[IODataModeText] :: IODataMode String
[IODataModeBinary] :: IODataMode ByteString
class NFData mode => KnownIODataMode mode
-- | IOData Wrapper for hGetContents
--
-- Note: This operation uses lazy I/O. Use NFData to force
-- all data to be read and consequently the internal file handle to be
-- closed.
hGetIODataContents :: KnownIODataMode mode => Handle -> IO mode
toIOData :: KnownIODataMode mode => mode -> IOData
iodataMode :: KnownIODataMode mode => IODataMode mode
-- | Applies a function polymorphic over IODataMode to an
-- IOData value.
withIOData :: IOData -> (forall mode. IODataMode mode -> mode -> r) -> r
-- | Test whether IOData is empty
null :: IOData -> Bool
-- | IOData Wrapper for hPutStr and hClose
--
-- This is the dual operation ot hGetIODataContents, and
-- consequently the handle is closed with hClose.
--
-- Note: this performs lazy-IO.
hPutContents :: Handle -> IOData -> IO ()
instance (a GHC.Types.~ GHC.Types.Char) => Distribution.Utils.IOData.KnownIODataMode [a]
instance Distribution.Utils.IOData.KnownIODataMode Data.ByteString.Lazy.Internal.ByteString
instance Control.DeepSeq.NFData Distribution.Utils.IOData.IOData
-- | Extremely simple JSON helper. Don't do anything too fancy with this!
module Distribution.Utils.Json
data Json
JsonArray :: [Json] -> Json
JsonBool :: !Bool -> Json
JsonNull :: Json
JsonNumber :: !Int -> Json
JsonObject :: [(String, Json)] -> Json
JsonString :: !String -> Json
-- | A shorthand for building up JsonObjects >>> JsonObject
-- [ "a" .= JsonNumber 42, "b" .= JsonBool True ] JsonObject
-- [("a",JsonNumber 42),("b",JsonBool True)]
(.=) :: String -> Json -> (String, Json)
-- | Convert a Json into a ByteString
renderJson :: Json -> ByteString
instance GHC.Show.Show Distribution.Utils.Json.Json
module Distribution.Utils.MapAccum
-- | Monadic variant of mapAccumL.
mapAccumM :: (Monad m, Traversable t) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
instance GHC.Base.Functor m => GHC.Base.Functor (Distribution.Utils.MapAccum.StateM s m)
instance GHC.Base.Monad m => GHC.Base.Applicative (Distribution.Utils.MapAccum.StateM s m)
-- | A progress monad, which we use to report failure and logging from
-- otherwise pure code.
module Distribution.Utils.Progress
-- | A type to represent the unfolding of an expensive long running
-- calculation that may fail (or maybe not expensive, but complicated!)
-- We may get intermediate steps before the final result which may be
-- used to indicate progress and/or logging messages.
--
-- TODO: Apply Codensity to avoid left-associativity problem. See
-- http://comonad.com/reader/2011/free-monads-for-less/ and
-- http://blog.ezyang.com/2012/01/problem-set-the-codensity-transformation/
data Progress step fail done
-- | Emit a step and then continue.
stepProgress :: step -> Progress step fail ()
-- | Fail the computation.
failProgress :: fail -> Progress step fail done
-- | Consume a Progress calculation. Much like foldr for
-- lists but with two base cases, one for a final result and one for
-- failure.
--
-- Eg to convert into a simple Either result use:
--
--
-- foldProgress (flip const) Left Right
--
foldProgress :: (step -> a -> a) -> (fail -> a) -> (done -> a) -> Progress step fail done -> a
instance GHC.Base.Functor (Distribution.Utils.Progress.Progress step fail)
instance GHC.Base.Monad (Distribution.Utils.Progress.Progress step fail)
instance GHC.Base.Applicative (Distribution.Utils.Progress.Progress step fail)
instance GHC.Base.Monoid fail => GHC.Base.Alternative (Distribution.Utils.Progress.Progress step fail)
module Distribution.Verbosity.Internal
data VerbosityLevel
Silent :: VerbosityLevel
Normal :: VerbosityLevel
Verbose :: VerbosityLevel
Deafening :: VerbosityLevel
data VerbosityFlag
VCallStack :: VerbosityFlag
VCallSite :: VerbosityFlag
VNoWrap :: VerbosityFlag
VMarkOutput :: VerbosityFlag
VTimestamp :: VerbosityFlag
VStderr :: VerbosityFlag
VNoWarn :: VerbosityFlag
instance GHC.Enum.Bounded Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Enum.Enum Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Classes.Ord Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Classes.Eq Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Read.Read Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Show.Show Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Generics.Generic Distribution.Verbosity.Internal.VerbosityLevel
instance GHC.Enum.Bounded Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Enum.Enum Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Classes.Ord Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Classes.Eq Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Read.Read Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Show.Show Distribution.Verbosity.Internal.VerbosityFlag
instance GHC.Generics.Generic Distribution.Verbosity.Internal.VerbosityFlag
instance Data.Binary.Class.Binary Distribution.Verbosity.Internal.VerbosityFlag
instance Distribution.Utils.Structured.Structured Distribution.Verbosity.Internal.VerbosityFlag
instance Data.Binary.Class.Binary Distribution.Verbosity.Internal.VerbosityLevel
instance Distribution.Utils.Structured.Structured Distribution.Verbosity.Internal.VerbosityLevel
-- | A Verbosity type with associated utilities.
--
-- There are 4 standard verbosity levels from silent,
-- normal, verbose up to deafening. This is used for
-- deciding what logging messages to print.
--
-- Verbosity also is equipped with some internal settings which can be
-- used to control at a fine granularity the verbosity of specific
-- settings (e.g., so that you can trace only particular things you are
-- interested in.) It's important to note that the instances for
-- Verbosity assume that this does not exist.
module Distribution.Verbosity
data Verbosity
-- | In silent mode, we should not print anything unless an
-- error occurs.
silent :: Verbosity
-- | Print stuff we want to see by default.
normal :: Verbosity
-- | Be more verbose about what's going on.
verbose :: Verbosity
-- | Not only are we verbose ourselves (perhaps even noisier than when
-- being verbose), but we tell everything we run to be verbose
-- too.
deafening :: Verbosity
-- | Increase verbosity level, but stay silent if we are.
moreVerbose :: Verbosity -> Verbosity
-- | Decrease verbosity level, but stay deafening if we are.
lessVerbose :: Verbosity -> Verbosity
-- | Test if we had called lessVerbose on the verbosity.
isVerboseQuiet :: Verbosity -> Bool
-- | Numeric verbosity level 0..3: 0 is silent,
-- 3 is deafening.
intToVerbosity :: Int -> Maybe Verbosity
flagToVerbosity :: ReadE Verbosity
showForCabal :: Verbosity -> String
showForGHC :: Verbosity -> String
-- | Turn off all flags.
verboseNoFlags :: Verbosity -> Verbosity
verboseHasFlags :: Verbosity -> Bool
-- | Combinator for transforming verbosity level while retaining the
-- original hidden state.
--
-- For instance, the following property holds
--
--
-- isVerboseNoWrap (modifyVerbosity (max verbose) v) == isVerboseNoWrap v
--
--
-- Note: you can use modifyVerbosity (const v1) v0 to
-- overwrite v1's flags with v0's flags.
modifyVerbosity :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity
-- | Turn on verbose call-site printing when we log.
verboseCallSite :: Verbosity -> Verbosity
-- | Turn on verbose call-stack printing when we log.
verboseCallStack :: Verbosity -> Verbosity
-- | Test if we should output call sites when we log.
isVerboseCallSite :: Verbosity -> Bool
-- | Test if we should output call stacks when we log.
isVerboseCallStack :: Verbosity -> Bool
-- | Turn on -----BEGIN CABAL OUTPUT----- markers for output from
-- Cabal (as opposed to GHC, or system dependent).
verboseMarkOutput :: Verbosity -> Verbosity
-- | Test if we should output markets.
isVerboseMarkOutput :: Verbosity -> Bool
-- | Turn off marking; useful for suppressing nondeterministic output.
verboseUnmarkOutput :: Verbosity -> Verbosity
-- | Disable line-wrapping for log messages.
verboseNoWrap :: Verbosity -> Verbosity
-- | Test if line-wrapping is disabled for log messages.
isVerboseNoWrap :: Verbosity -> Bool
-- | Turn on timestamps for log messages.
verboseTimestamp :: Verbosity -> Verbosity
-- | Test if we should output timestamps when we log.
isVerboseTimestamp :: Verbosity -> Bool
-- | Turn off timestamps for log messages.
verboseNoTimestamp :: Verbosity -> Verbosity
-- | Switch logging to stderr.
verboseStderr :: Verbosity -> Verbosity
-- | Test if we should output to stderr when we log.
isVerboseStderr :: Verbosity -> Bool
-- | Switch logging to stdout.
verboseNoStderr :: Verbosity -> Verbosity
-- | Turn off warnings for log messages.
verboseNoWarn :: Verbosity -> Verbosity
-- | Test if we should output warnings when we log.
isVerboseNoWarn :: Verbosity -> Bool
instance GHC.Read.Read Distribution.Verbosity.Verbosity
instance GHC.Show.Show Distribution.Verbosity.Verbosity
instance GHC.Generics.Generic Distribution.Verbosity.Verbosity
instance GHC.Classes.Eq Distribution.Verbosity.Verbosity
instance GHC.Classes.Ord Distribution.Verbosity.Verbosity
instance GHC.Enum.Enum Distribution.Verbosity.Verbosity
instance GHC.Enum.Bounded Distribution.Verbosity.Verbosity
instance Data.Binary.Class.Binary Distribution.Verbosity.Verbosity
instance Distribution.Utils.Structured.Structured Distribution.Verbosity.Verbosity
instance Distribution.Parsec.Parsec Distribution.Verbosity.Verbosity
instance Distribution.Pretty.Pretty Distribution.Verbosity.Verbosity
-- | Internal module that defines fine-grained rules for setup hooks. Users
-- should import SetupHooks instead.
module Distribution.Simple.SetupHooks.Rule
type Rule = RuleData User
-- | A rule consists of:
--
--
-- - an action to run to execute the rule,
-- - a description of the rule inputs and outputs.
--
--
-- Use staticRule or dynamicRule to construct a rule,
-- overriding specific fields, rather than directly using the Rule
-- constructor.
data RuleData (scope :: Scope)
-- | Please use the staticRule or dynamicRule smart
-- constructors instead of this constructor, in order to avoid relying on
-- internal implementation details.
Rule :: !RuleCmds scope -> ![Dependency] -> !NonEmpty Location -> RuleData (scope :: Scope)
-- | To run this rule, which Commands should we execute?
[ruleCommands] :: RuleData (scope :: Scope) -> !RuleCmds scope
-- | Static dependencies of this rule.
[staticDependencies] :: RuleData (scope :: Scope) -> ![Dependency]
-- | Results of this rule.
[results] :: RuleData (scope :: Scope) -> !NonEmpty Location
-- | A unique identifier for a Rule.
data RuleId
RuleId :: !RulesNameSpace -> !ShortText -> RuleId
[ruleNameSpace] :: RuleId -> !RulesNameSpace
[ruleName] :: RuleId -> !ShortText
-- | A rule with static dependencies.
--
-- Prefer using this smart constructor instead of Rule whenever
-- possible.
staticRule :: forall arg. Typeable arg => Command arg (IO ()) -> [Dependency] -> NonEmpty Location -> Rule
-- | A rule with dynamic dependencies.
--
-- Prefer using this smart constructor instead of Rule whenever
-- possible.
dynamicRule :: forall depsArg depsRes arg. (Typeable depsArg, Typeable depsRes, Typeable arg) => StaticPtr (Dict (Binary depsRes, Show depsRes, Eq depsRes)) -> Command depsArg (IO ([Dependency], depsRes)) -> Command arg (depsRes -> IO ()) -> [Dependency] -> NonEmpty Location -> Rule
-- | Commands to execute a rule:
--
--
-- - for a rule with static dependencies, a single command,
-- - for a rule with dynamic dependencies, a command for computing
-- dynamic dependencies, and a command for executing the rule.
--
data RuleCommands (scope :: Scope) (deps :: Scope -> Type -> Type -> Type) (ruleCmd :: Scope -> Type -> Type -> Type)
-- | A rule with statically-known dependencies.
[StaticRuleCommand] :: forall arg deps ruleCmd scope. If (scope == System) (arg ~ ByteString) (() :: Constraint) => !ruleCmd scope arg (IO ()) -> !If (scope == System) SomeTypeRep (TypeRep arg) -> RuleCommands scope deps ruleCmd
[DynamicRuleCommands] :: forall depsArg depsRes arg deps ruleCmd scope. If (scope == System) (depsArg ~ ByteString, depsRes ~ ByteString, arg ~ ByteString) (() :: Constraint) => !Static scope (Dict (Binary depsRes, Show depsRes, Eq depsRes)) -> !deps scope depsArg depsRes -> !ruleCmd scope arg (depsRes -> IO ()) -> !If (scope == System) SomeTypeRep (TypeRep (depsArg, depsRes, arg)) -> RuleCommands scope deps ruleCmd
-- | A command consists of a statically-known action together with a
-- (possibly dynamic) argument to that action.
--
-- For example, the action can consist of running an executable (such as
-- happy or c2hs), while the argument consists of the
-- variable component of the command, e.g. the specific file to run
-- happy on.
type Command = CommandData User
-- | Internal datatype used for commands, both for the Hooks API
-- (Command) and for the build system.
data CommandData (scope :: Scope) (arg :: Type) (res :: Type)
Command :: !Static scope (arg -> res) -> !ScopedArgument scope arg -> !Static scope (Dict (Binary arg, Show arg)) -> CommandData (scope :: Scope) (arg :: Type) (res :: Type)
-- | The (statically-known) action to execute.
[actionPtr] :: CommandData (scope :: Scope) (arg :: Type) (res :: Type) -> !Static scope (arg -> res)
-- | The (possibly dynamic) argument to pass to the action.
[actionArg] :: CommandData (scope :: Scope) (arg :: Type) (res :: Type) -> !ScopedArgument scope arg
-- | Static evidence that the argument can be serialised and deserialised.
[cmdInstances] :: CommandData (scope :: Scope) (arg :: Type) (res :: Type) -> !Static scope (Dict (Binary arg, Show arg))
-- | Run a Command.
runCommand :: Command args res -> res
-- | Construct a command.
--
-- Prefer using this smart constructor instead of Command whenever
-- possible.
mkCommand :: forall arg res. StaticPtr (Dict (Binary arg, Show arg)) -> StaticPtr (arg -> res) -> arg -> Command arg res
-- | A wrapper used to pass evidence of a constraint as an explicit value.
data Dict c
[Dict] :: c => Dict c
-- | Both the rule command and the (optional) dynamic dependency command.
type RuleCmds scope = RuleCommands scope DynDepsCmd CommandData
-- | Only the (optional) dynamic dependency command.
type RuleDynDepsCmd scope = RuleCommands scope DynDepsCmd NoCmd
-- | The rule command together with the result of the (optional) dynamic
-- dependency computation.
type RuleExecCmd scope = RuleCommands scope DepsRes CommandData
-- | A dynamic dependency command.
newtype DynDepsCmd scope depsArg depsRes
DynDepsCmd :: CommandData scope depsArg (IO ([Dependency], depsRes)) -> DynDepsCmd scope depsArg depsRes
[dynDepsCmd] :: DynDepsCmd scope depsArg depsRes -> CommandData scope depsArg (IO ([Dependency], depsRes))
-- | The result of a dynamic dependency computation.
newtype DepsRes (scope :: Scope) depsArg depsRes
DepsRes :: ScopedArgument scope depsRes -> DepsRes (scope :: Scope) depsArg depsRes
[depsRes] :: DepsRes (scope :: Scope) depsArg depsRes -> ScopedArgument scope depsRes
-- | Project out the (optional) dependency computation command, so that it
-- can be serialised without serialising anything else.
ruleDepsCmd :: RuleCmds scope -> RuleDynDepsCmd scope
-- | Obtain the (optional) IO action that computes dynamic
-- dependencies.
runRuleDynDepsCmd :: RuleDynDepsCmd User -> Maybe (IO ([Dependency], ByteString))
-- | Project out the command for running the rule, passing in the result of
-- the dependency computation if there was one.
ruleExecCmd :: SScope scope -> RuleCmds scope -> Maybe ByteString -> RuleExecCmd scope
-- | Obtain the IO action that executes a rule.
runRuleExecCmd :: RuleExecCmd User -> IO ()
-- | A collection of Rules.
--
-- Use the rules smart constructor instead of directly using the
-- Rules constructor.
--
--
-- - Rules are registered using registerRule,
-- - Monitored files or directories are declared using
-- addRuleMonitors; a change in these will trigger the
-- recomputation of all rules.
--
--
-- The env type parameter represents an extra argument, which
-- usually consists of information known to Cabal such as
-- LocalBuildInfo and ComponentLocalBuildInfo.
newtype Rules env
Rules :: (env -> RulesM ()) -> Rules env
[runRules] :: Rules env -> env -> RulesM ()
-- | A dependency of a rule.
data Dependency
-- | A dependency on an output of another rule.
RuleDependency :: !RuleOutput -> Dependency
-- | A direct dependency on a file at a particular location on disk.
--
-- This should not be used for files that are generated by other rules;
-- use RuleDependency instead.
FileDependency :: !Location -> Dependency
-- | A reference to an output of another rule.
data RuleOutput
RuleOutput :: !RuleId -> !Word -> RuleOutput
-- | which rule's outputs are we referring to?
[outputOfRule] :: RuleOutput -> !RuleId
-- | which particular output of that rule?
[outputIndex] :: RuleOutput -> !Word
-- | Construct a collection of rules with a given label.
--
-- A label for the rules can be constructed using the static
-- keyword, using the StaticPointers extension. NB: separate
-- calls to rules should have different labels.
--
-- Example usage:
--
--
-- myRules :: Rules env
-- myRules = rules (static ()) $ \ env -> do { .. } -- use the monadic API here
--
rules :: StaticPtr label -> (env -> RulesM ()) -> Rules env
-- | An empty collection of rules.
noRules :: RulesM ()
-- | A (fully resolved) location of a dependency or result of a rule,
-- consisting of a base directory and of a file path relative to that
-- base directory path.
--
-- In practice, this will be something like Location dir
-- (moduleNameSymbolicPath mod . "hs"), where:
--
--
-- - for a file dependency, dir is one of the Cabal search
-- directories,
-- - for an output, dir is a directory such as
-- autogenComponentModulesDir or
-- componentBuildDir.
--
data Location
[Location] :: !SymbolicPath Pkg (Dir baseDir) -> !RelativePath baseDir File -> Location
-- | Get a (relative or absolute) un-interpreted path to a Location.
location :: Location -> SymbolicPath Pkg File
-- | A description of a file (or set of files) to monitor for changes.
--
-- Where file paths are relative they are relative to a common directory
-- (e.g. project root), not necessarily the process current directory.
data MonitorFilePath
MonitorFile :: !MonitorKindFile -> !MonitorKindDir -> !FilePath -> MonitorFilePath
[monitorKindFile] :: MonitorFilePath -> !MonitorKindFile
[monitorKindDir] :: MonitorFilePath -> !MonitorKindDir
[monitorPath] :: MonitorFilePath -> !FilePath
MonitorFileGlob :: !MonitorKindFile -> !MonitorKindDir -> !RootedGlob -> MonitorFilePath
[monitorKindFile] :: MonitorFilePath -> !MonitorKindFile
[monitorKindDir] :: MonitorFilePath -> !MonitorKindDir
[monitorPathGlob] :: MonitorFilePath -> !RootedGlob
data MonitorKindFile
FileExists :: MonitorKindFile
FileModTime :: MonitorKindFile
FileHashed :: MonitorKindFile
FileNotExists :: MonitorKindFile
data MonitorKindDir
DirExists :: MonitorKindDir
DirModTime :: MonitorKindDir
DirNotExists :: MonitorKindDir
-- | Monad for constructing rules.
type RulesM a = RulesT IO a
-- | Monad transformer for defining rules. Usually wraps the IO
-- monad, allowing IO actions to be performed using
-- liftIO.
newtype RulesT m a
RulesT :: ReaderT RulesEnv (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m)) a -> RulesT m a
[runRulesT] :: RulesT m a -> ReaderT RulesEnv (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m)) a
-- | The environment within the monadic API.
data RulesEnv
RulesEnv :: !Verbosity -> !RulesNameSpace -> RulesEnv
[rulesEnvVerbosity] :: RulesEnv -> !Verbosity
[rulesEnvNameSpace] :: RulesEnv -> !RulesNameSpace
-- | Internal function: run the monadic Rules computations in order
-- to obtain all the Rules with their RuleIds.
computeRules :: Verbosity -> env -> Rules env -> IO (Map RuleId Rule, [MonitorFilePath])
-- | Rules are defined with rich types by the package.
--
-- The build system only has a limited view of these; most data consists
-- of opaque ByteStrings.
--
-- The Scope data-type describes which side of this divide we are
-- on.
data Scope
-- | User space (with rich types).
User :: Scope
-- | Build-system space (manipulation of raw data).
System :: Scope
data SScope (scope :: Scope)
[SUser] :: SScope User
[SSystem] :: SScope System
-- | A static pointer (in user scope) or its key (in system scope).
data family Static (scope :: Scope) :: Type -> Type
type RuleBinary = RuleData System
ruleBinary :: Rule -> RuleBinary
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance GHC.Classes.Ord Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance GHC.Classes.Eq Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.RulesNameSpace
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Rule.RuleId
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Rule.RuleId
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Rule.RuleId
instance GHC.Classes.Ord Distribution.Simple.SetupHooks.Rule.RuleId
instance GHC.Classes.Eq Distribution.Simple.SetupHooks.Rule.RuleId
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.RuleId
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Rule.RuleOutput
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Rule.RuleOutput
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Rule.RuleOutput
instance GHC.Classes.Ord Distribution.Simple.SetupHooks.Rule.RuleOutput
instance GHC.Classes.Eq Distribution.Simple.SetupHooks.Rule.RuleOutput
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.RuleOutput
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Rule.Dependency
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Rule.Dependency
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Rule.Dependency
instance GHC.Classes.Ord Distribution.Simple.SetupHooks.Rule.Dependency
instance GHC.Classes.Eq Distribution.Simple.SetupHooks.Rule.Dependency
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.Dependency
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.System fnTy)
instance GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.System fnTy)
instance GHC.Classes.Ord (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.System fnTy)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.System fnTy)
instance GHC.Show.Show arg => GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.ScopedArgument scope arg)
instance GHC.Classes.Ord arg => GHC.Classes.Ord (Distribution.Simple.SetupHooks.Rule.ScopedArgument scope arg)
instance GHC.Classes.Eq arg => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.ScopedArgument scope arg)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k1 (arg :: k1) k2 (res :: k2). Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.NoCmd scope arg res)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k1 (arg :: k1) k2 (res :: k2). GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.NoCmd scope arg res)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k1 (arg :: k1) k2 (res :: k2). GHC.Classes.Ord (Distribution.Simple.SetupHooks.Rule.NoCmd scope arg res)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k1 (arg :: k1) k2 (res :: k2). GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.NoCmd scope arg res)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k1 (arg :: k1) k2 (res :: k2). GHC.Generics.Generic (Distribution.Simple.SetupHooks.Rule.NoCmd scope arg res)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k (depsArg :: k) depsRes. GHC.Classes.Ord depsRes => GHC.Classes.Ord (Distribution.Simple.SetupHooks.Rule.DepsRes scope depsArg depsRes)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k (depsArg :: k) depsRes. GHC.Classes.Eq depsRes => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.DepsRes scope depsArg depsRes)
instance forall (scope :: Distribution.Simple.SetupHooks.Rule.Scope) k (depsArg :: k) depsRes. GHC.Show.Show depsRes => GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.DepsRes scope depsArg depsRes)
instance GHC.Generics.Generic (Distribution.Simple.SetupHooks.Rule.RuleData scope)
instance Control.Monad.Fix.MonadFix m => Control.Monad.Fix.MonadFix (Distribution.Simple.SetupHooks.Rule.RulesT m)
instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Distribution.Simple.SetupHooks.Rule.RulesT m)
instance GHC.Base.Monad m => GHC.Base.Monad (Distribution.Simple.SetupHooks.Rule.RulesT m)
instance GHC.Base.Monad m => GHC.Base.Applicative (Distribution.Simple.SetupHooks.Rule.RulesT m)
instance GHC.Base.Functor m => GHC.Base.Functor (Distribution.Simple.SetupHooks.Rule.RulesT m)
instance GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.RuleData 'Distribution.Simple.SetupHooks.Rule.User)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.RuleData 'Distribution.Simple.SetupHooks.Rule.User)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.RuleData 'Distribution.Simple.SetupHooks.Rule.System)
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.RuleData 'Distribution.Simple.SetupHooks.Rule.User)
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.RuleData 'Distribution.Simple.SetupHooks.Rule.System)
instance GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.DynDepsCmd 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.DynDepsCmd 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.DynDepsCmd 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)
instance (arg GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString, depsRes GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString) => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.DynDepsCmd 'Distribution.Simple.SetupHooks.Rule.System arg depsRes)
instance (arg GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString, depsRes GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.DynDepsCmd 'Distribution.Simple.SetupHooks.Rule.System arg depsRes)
instance forall k (scope :: Distribution.Simple.SetupHooks.Rule.Scope) depsRes (depsArg :: k). Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.ScopedArgument scope depsRes) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.DepsRes scope depsArg depsRes)
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Rule.Location
instance GHC.Base.Semigroup (Distribution.Simple.SetupHooks.Rule.Rules env)
instance GHC.Base.Monoid (Distribution.Simple.SetupHooks.Rule.Rules env)
instance Control.Monad.Trans.Class.MonadTrans Distribution.Simple.SetupHooks.Rule.RulesT
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.RuleBinary
instance GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.CommandData 'Distribution.Simple.SetupHooks.Rule.User arg res)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.CommandData 'Distribution.Simple.SetupHooks.Rule.User arg res)
instance (arg GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString) => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.CommandData 'Distribution.Simple.SetupHooks.Rule.System arg res)
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.CommandData 'Distribution.Simple.SetupHooks.Rule.User arg res)
instance (arg GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.CommandData 'Distribution.Simple.SetupHooks.Rule.System arg res)
instance (forall arg res. GHC.Show.Show (ruleCmd 'Distribution.Simple.SetupHooks.Rule.User arg res), forall depsArg depsRes. GHC.Show.Show depsRes => GHC.Show.Show (deps 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)) => GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.RuleCommands 'Distribution.Simple.SetupHooks.Rule.User deps ruleCmd)
instance (forall arg res. GHC.Classes.Eq (ruleCmd 'Distribution.Simple.SetupHooks.Rule.User arg res), forall depsArg depsRes. GHC.Classes.Eq depsRes => GHC.Classes.Eq (deps 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)) => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.RuleCommands 'Distribution.Simple.SetupHooks.Rule.User deps ruleCmd)
instance (forall res. GHC.Classes.Eq (ruleCmd 'Distribution.Simple.SetupHooks.Rule.System Data.ByteString.Lazy.Internal.ByteString res), GHC.Classes.Eq (deps 'Distribution.Simple.SetupHooks.Rule.System Data.ByteString.Lazy.Internal.ByteString Data.ByteString.Lazy.Internal.ByteString)) => GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.RuleCommands 'Distribution.Simple.SetupHooks.Rule.System deps ruleCmd)
instance (forall arg res. Data.Binary.Class.Binary (ruleCmd 'Distribution.Simple.SetupHooks.Rule.User arg res), forall depsArg depsRes. Data.Binary.Class.Binary depsRes => Data.Binary.Class.Binary (deps 'Distribution.Simple.SetupHooks.Rule.User depsArg depsRes)) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.RuleCommands 'Distribution.Simple.SetupHooks.Rule.User deps ruleCmd)
instance (forall res. Data.Binary.Class.Binary (ruleCmd 'Distribution.Simple.SetupHooks.Rule.System Data.ByteString.Lazy.Internal.ByteString res), Data.Binary.Class.Binary (deps 'Distribution.Simple.SetupHooks.Rule.System Data.ByteString.Lazy.Internal.ByteString Data.ByteString.Lazy.Internal.ByteString)) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.RuleCommands 'Distribution.Simple.SetupHooks.Rule.System deps ruleCmd)
instance Data.Binary.Class.Binary arg => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.ScopedArgument 'Distribution.Simple.SetupHooks.Rule.User arg)
instance (arg GHC.Types.~ Data.ByteString.Lazy.Internal.ByteString) => Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.ScopedArgument 'Distribution.Simple.SetupHooks.Rule.System arg)
instance GHC.Show.Show (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.User fnTy)
instance GHC.Classes.Eq (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.User fnTy)
instance GHC.Classes.Ord (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.User fnTy)
instance Data.Binary.Class.Binary (Distribution.Simple.SetupHooks.Rule.Static 'Distribution.Simple.SetupHooks.Rule.User fnTy)
instance GHC.Classes.Eq Distribution.Simple.SetupHooks.Rule.Location
instance GHC.Classes.Ord Distribution.Simple.SetupHooks.Rule.Location
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Rule.Location
instance GHC.Show.Show Distribution.Simple.SetupHooks.Rule.Location
module Distribution.Simple.SetupHooks.Errors
-- | An error involving the SetupHooks module of a package with
-- Hooks build-type.
data SetupHooksException
-- | Cannot apply a diff to a component in a per-component configure hook.
CannotApplyComponentDiff :: CannotApplyComponentDiffReason -> SetupHooksException
-- | An error with pre-build rules.
RulesException :: RulesException -> SetupHooksException
data CannotApplyComponentDiffReason
MismatchedComponentTypes :: Component -> Component -> CannotApplyComponentDiffReason
IllegalComponentDiff :: Component -> NonEmpty IllegalComponentDiffReason -> CannotApplyComponentDiffReason
data IllegalComponentDiffReason
CannotChangeName :: IllegalComponentDiffReason
CannotChangeComponentField :: String -> IllegalComponentDiffReason
CannotChangeBuildInfoField :: String -> IllegalComponentDiffReason
-- | AN error involving the Rules in the SetupHooks
-- module of a package with the Hooks build-type.
data RulesException
-- | There are cycles in the dependency graph of fine-grained rules.
CyclicRuleDependencies :: NonEmpty (RuleBinary, [Tree RuleBinary]) -> RulesException
-- | When executing fine-grained rules compiled into the external hooks
-- executable, we failed to find dependencies of a rule.
CantFindSourceForRuleDependencies :: RuleBinary -> NonEmpty Location -> RulesException
-- | When executing fine-grained rules compiled into the external hooks
-- executable, a rule failed to generate the outputs it claimed it would.
MissingRuleOutputs :: RuleBinary -> NonEmpty Location -> RulesException
-- | An invalid reference to a rule output, e.g. an out-of-range index.
InvalidRuleOutputIndex :: RuleId -> RuleId -> NonEmpty Location -> Word -> RulesException
-- | A duplicate RuleId in the construction of pre-build rules.
DuplicateRuleId :: !RuleId -> !Rule -> !Rule -> RulesException
setupHooksExceptionCode :: SetupHooksException -> Int
setupHooksExceptionMessage :: SetupHooksException -> String
instance GHC.Show.Show Distribution.Simple.SetupHooks.Errors.IllegalComponentDiffReason
instance GHC.Show.Show Distribution.Simple.SetupHooks.Errors.CannotApplyComponentDiffReason
instance GHC.Show.Show Distribution.Simple.SetupHooks.Errors.SetupHooksException
instance GHC.Show.Show Distribution.Simple.SetupHooks.Errors.RulesException
-- | This provides an abstraction which deals with configuring and running
-- programs. A Program is a static notion of a known program. A
-- ConfiguredProgram is a Program that has been found on
-- the current machine and is ready to be run (possibly with some
-- user-supplied default args). Configuring a program involves finding
-- its location and if necessary finding its version. There's reasonable
-- default behavior for trying to find "foo" in PATH, being able to
-- override its location, etc.
module Distribution.Simple.Program.Types
-- | Represents a program which can be configured.
--
-- Note: rather than constructing this directly, start with
-- simpleProgram and override any extra fields.
data Program
Program :: String -> (Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))) -> (Verbosity -> FilePath -> IO (Maybe Version)) -> (Verbosity -> ConfiguredProgram -> IO ConfiguredProgram) -> (Maybe Version -> PackageDescription -> [String] -> [String]) -> Program
-- | The simple name of the program, eg. ghc
[programName] :: Program -> String
-- | A function to search for the program if its location was not specified
-- by the user. Usually this will just be a call to
-- findProgramOnSearchPath.
--
-- It is supplied with the prevailing search path which will typically
-- just be used as-is, but can be extended or ignored as needed.
--
-- For the purpose of change monitoring, in addition to the location
-- where the program was found, it returns all the other places that were
-- tried.
[programFindLocation] :: Program -> Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
-- | Try to find the version of the program. For many programs this is not
-- possible or is not necessary so it's OK to return Nothing.
[programFindVersion] :: Program -> Verbosity -> FilePath -> IO (Maybe Version)
-- | A function to do any additional configuration after we have located
-- the program (and perhaps identified its version). For example it could
-- add args, or environment vars.
[programPostConf] :: Program -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
-- | A function that filters any arguments that don't impact the output
-- from a commandline. Used to limit the volatility of dependency hashes
-- when using new-build.
[programNormaliseArgs] :: Program -> Maybe Version -> PackageDescription -> [String] -> [String]
-- | A search path to use when locating executables. This is analogous to
-- the unix $PATH or win32 %PATH% but with the ability
-- to use the system default method for finding executables
-- (findExecutable which on unix is simply looking on the
-- $PATH but on win32 is a bit more complicated).
--
-- The default to use is [ProgSearchPathDefault] but you can add
-- extra dirs either before, after or instead of the default, e.g. here
-- we add an extra dir to search after the usual ones.
--
--
-- ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
--
--
-- We also use this path to set the environment when running child
-- processes.
--
-- The ProgramDb is created with a ProgramSearchPath to
-- which we prependProgramSearchPath to add the ones that come
-- from cli flags and from configurations. Then each of the programs that
-- are configured in the db inherits the same path as part of
-- configureProgram.
type ProgramSearchPath = [ProgramSearchPathEntry]
data ProgramSearchPathEntry
-- | A specific dir
ProgramSearchPathDir :: FilePath -> ProgramSearchPathEntry
-- | The system default
ProgramSearchPathDefault :: ProgramSearchPathEntry
-- | Represents a program which has been configured and is thus ready to be
-- run.
--
-- These are usually made by configuring a Program, but if you
-- have to construct one directly then start with
-- simpleConfiguredProgram and override any extra fields.
data ConfiguredProgram
ConfiguredProgram :: String -> Maybe Version -> [String] -> [String] -> [(String, Maybe String)] -> Map String String -> ProgramLocation -> [FilePath] -> ConfiguredProgram
-- | Just the name again
[programId] :: ConfiguredProgram -> String
-- | The version of this program, if it is known.
[programVersion] :: ConfiguredProgram -> Maybe Version
-- | Default command-line args for this program. These flags will appear
-- first on the command line, so they can be overridden by subsequent
-- flags.
[programDefaultArgs] :: ConfiguredProgram -> [String]
-- | Override command-line args for this program. These flags will appear
-- last on the command line, so they override all earlier flags.
[programOverrideArgs] :: ConfiguredProgram -> [String]
-- | Override environment variables for this program. These env vars will
-- extend/override the prevailing environment of the current to form the
-- environment for the new process.
[programOverrideEnv] :: ConfiguredProgram -> [(String, Maybe String)]
-- | A key-value map listing various properties of the program, useful for
-- feature detection. Populated during the configuration step, key names
-- depend on the specific program.
[programProperties] :: ConfiguredProgram -> Map String String
-- | Location of the program. eg. /usr/bin/ghc-6.4
[programLocation] :: ConfiguredProgram -> ProgramLocation
-- | In addition to the programLocation where the program was found,
-- these are additional locations that were looked at. The combination of
-- ths found location and these not-found locations can be used to
-- monitor to detect when the re-configuring the program might give a
-- different result (e.g. found in a different location).
[programMonitorFiles] :: ConfiguredProgram -> [FilePath]
-- | The full path of a configured program.
programPath :: ConfiguredProgram -> FilePath
-- | Suppress any extra arguments added by the user.
suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram
type ProgArg = String
-- | Where a program was found. Also tells us whether it's specified by
-- user or not. This includes not just the path, but the program as well.
data ProgramLocation
-- | The user gave the path to this program, eg.
-- --ghc-path=/usr/bin/ghc-6.6
UserSpecified :: FilePath -> ProgramLocation
[locationPath] :: ProgramLocation -> FilePath
-- | The program was found automatically.
FoundOnSystem :: FilePath -> ProgramLocation
[locationPath] :: ProgramLocation -> FilePath
-- | Make a simple ConfiguredProgram.
--
--
-- simpleConfiguredProgram "foo" (FoundOnSystem path)
--
simpleConfiguredProgram :: String -> ProgramLocation -> ConfiguredProgram
instance GHC.Generics.Generic Distribution.Simple.Program.Types.ProgramSearchPathEntry
instance GHC.Classes.Eq Distribution.Simple.Program.Types.ProgramSearchPathEntry
instance GHC.Show.Show Distribution.Simple.Program.Types.ProgramSearchPathEntry
instance GHC.Show.Show Distribution.Simple.Program.Types.ProgramLocation
instance GHC.Read.Read Distribution.Simple.Program.Types.ProgramLocation
instance GHC.Generics.Generic Distribution.Simple.Program.Types.ProgramLocation
instance GHC.Classes.Eq Distribution.Simple.Program.Types.ProgramLocation
instance GHC.Show.Show Distribution.Simple.Program.Types.ConfiguredProgram
instance GHC.Read.Read Distribution.Simple.Program.Types.ConfiguredProgram
instance GHC.Generics.Generic Distribution.Simple.Program.Types.ConfiguredProgram
instance GHC.Classes.Eq Distribution.Simple.Program.Types.ConfiguredProgram
instance GHC.Show.Show Distribution.Simple.Program.Types.Program
instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ConfiguredProgram
instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Types.ConfiguredProgram
instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ProgramLocation
instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Types.ProgramLocation
instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ProgramSearchPathEntry
instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Types.ProgramSearchPathEntry
-- | This defines a PreProcessor abstraction which represents a
-- pre-processor that can transform one kind of file into another.
module Distribution.Simple.PreProcess.Types
-- | A suffix (or file extension).
--
-- Mostly used to decide which preprocessor to use, e.g. files with
-- suffix "y" are usually processed by the "happy"
-- build tool.
newtype Suffix
Suffix :: String -> Suffix
-- | The interface to a preprocessor, which may be implemented using an
-- external program, but need not be. The arguments are the name of the
-- input file, the name of the output file and a verbosity level. Here is
-- a simple example that merely prepends a comment to the given source
-- file:
--
--
-- ppTestHandler :: PreProcessor
-- ppTestHandler =
-- PreProcessor {
-- platformIndependent = True,
-- runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
-- do info verbosity (inFile++" has been preprocessed to "++outFile)
-- stuff <- readFile inFile
-- writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
-- return ExitSuccess
--
--
-- We split the input and output file names into a base directory and the
-- rest of the file name. The input base dir is the path in the list of
-- search dirs that this file was found in. The output base dir is the
-- build dir where all the generated source files are put.
--
-- The reason for splitting it up this way is that some pre-processors
-- don't simply generate one output .hs file from one input file but have
-- dependencies on other generated files (notably c2hs, where building
-- one .hs file may require reading other .chi files, and then compiling
-- the .hs file may require reading a generated .h file). In these cases
-- the generated files need to embed relative path names to each other
-- (eg the generated .hs file mentions the .h file in the FFI imports).
-- This path must be relative to the base directory where the generated
-- files are located, it cannot be relative to the top level of the build
-- tree because the compilers do not look for .h files relative to there,
-- ie we do not use "-I .", instead we use "-I dist/build" (or whatever
-- dist dir has been set by the user)
--
-- Most pre-processors do not care of course, so mkSimplePreProcessor and
-- runSimplePreProcessor functions handle the simple case.
data PreProcessor
PreProcessor :: Bool -> (Verbosity -> [SymbolicPath Pkg (Dir Source)] -> [ModuleName] -> IO [ModuleName]) -> PreProcessCommand -> PreProcessor
[platformIndependent] :: PreProcessor -> Bool
-- | This function can reorder all modules, not just those that the
-- require the preprocessor in question. As such, this function should be
-- well-behaved and not reorder modules it doesn't have dominion over!
[ppOrdering] :: PreProcessor -> Verbosity -> [SymbolicPath Pkg (Dir Source)] -> [ModuleName] -> IO [ModuleName]
[runPreProcessor] :: PreProcessor -> PreProcessCommand
-- | A command to run a given preprocessor on a single source file.
--
-- The input and output file paths are passed in as arguments, as it is
-- the build system and not the package author which chooses the location
-- of source files.
type PreProcessCommand = -- | Location of the source file relative to a base dir (FilePath, FilePath) -> -- | Output file name, relative to an output base dir (FilePath, FilePath) -> Verbosity -> IO ()
builtinHaskellSuffixes :: [Suffix]
builtinHaskellBootSuffixes :: [Suffix]
instance Data.String.IsString Distribution.Simple.PreProcess.Types.Suffix
instance GHC.Generics.Generic Distribution.Simple.PreProcess.Types.Suffix
instance GHC.Show.Show Distribution.Simple.PreProcess.Types.Suffix
instance GHC.Classes.Ord Distribution.Simple.PreProcess.Types.Suffix
instance GHC.Classes.Eq Distribution.Simple.PreProcess.Types.Suffix
instance Distribution.Pretty.Pretty Distribution.Simple.PreProcess.Types.Suffix
instance Data.Binary.Class.Binary Distribution.Simple.PreProcess.Types.Suffix
instance Distribution.Utils.Structured.Structured Distribution.Simple.PreProcess.Types.Suffix
module Distribution.Simple.Errors
data CabalException
NoBenchMarkProgram :: FilePath -> CabalException
EnableBenchMark :: CabalException
BenchMarkNameDisabled :: String -> CabalException
NoBenchMark :: String -> CabalException
-- | NoLibraryFound has been downgraded to a warning, and is
-- therefore no longer emitted.
NoLibraryFound :: CabalException
CompilerNotInstalled :: CompilerFlavor -> CabalException
CantFindIncludeFile :: String -> CabalException
UnsupportedTestSuite :: String -> CabalException
UnsupportedBenchMark :: String -> CabalException
NoIncludeFileFound :: String -> CabalException
NoModuleFound :: ModuleName -> [Suffix] -> CabalException
RegMultipleInstancePkg :: CabalException
SuppressingChecksOnFile :: CabalException
NoSupportDirStylePackageDb :: CabalException
OnlySupportSpecificPackageDb :: CabalException
FailedToParseOutputDescribe :: String -> PackageId -> CabalException
DumpFailed :: String -> String -> CabalException
FailedToParseOutputDump :: String -> CabalException
ListFailed :: String -> CabalException
FailedToParseOutputList :: String -> CabalException
ProgramNotFound :: String -> CabalException
NoSupportForHoogle :: CabalException
NoSupportForQuickJumpFlag :: CabalException
NoGHCVersionFromHaddock :: CabalException
NoGHCVersionFromCompiler :: CabalException
HaddockAndGHCVersionDoesntMatch :: Version -> Version -> CabalException
MustHaveSharedLibraries :: CabalException
HaddockPackageFlags :: [(InstalledPackageInfo, [UnitId])] -> CabalException
UnknownCompilerFlavor :: CompilerFlavor -> CabalException
FailedToDetermineTarget :: CabalException
NoMultipleTargets :: CabalException
REPLNotSupported :: CabalException
NoSupportBuildingTestSuite :: TestType -> CabalException
NoSupportBuildingBenchMark :: BenchmarkType -> CabalException
BuildingNotSupportedWithCompiler :: CabalException
ProvideHaskellSuiteTool :: String -> CabalException
CannotDetermineCompilerVersion :: CabalException
PkgDumpFailed :: CabalException
FailedToParseOutput :: CabalException
CantFindSourceModule :: ModuleName -> CabalException
VersionMismatchJS :: FilePath -> Version -> FilePath -> Version -> CabalException
VersionMismatchGHCJS :: FilePath -> Version -> FilePath -> Version -> CabalException
GlobalPackageDBLimitation :: CabalException
GlobalPackageDBSpecifiedFirst :: CabalException
MatchDirFileGlob :: String -> CabalException
MatchDirFileGlobErrors :: [String] -> CabalException
ErrorParsingFileDoesntExist :: FilePath -> CabalException
FailedParsing :: String -> CabalException
NotFoundMsg :: CabalException
UnrecognisedBuildTarget :: [String] -> CabalException
ReportBuildTargetProblems :: [(String, [String], String)] -> CabalException
UnknownBuildTarget :: [(String, [(String, String)])] -> CabalException
AmbiguousBuildTarget :: [(String, [(String, String)])] -> CabalException
CheckBuildTargets :: String -> CabalException
VersionMismatchGHC :: FilePath -> Version -> FilePath -> Version -> CabalException
CheckPackageDbStackPost76 :: CabalException
CheckPackageDbStackPre76 :: CabalException
GlobalPackageDbSpecifiedFirst :: CabalException
CantInstallForeignLib :: CabalException
NoSupportForPreProcessingTest :: TestType -> CabalException
NoSupportForPreProcessingBenchmark :: BenchmarkType -> CabalException
CantFindSourceForPreProcessFile :: String -> CabalException
NoSupportPreProcessingTestExtras :: TestType -> CabalException
NoSupportPreProcessingBenchmarkExtras :: BenchmarkType -> CabalException
UnlitException :: String -> CabalException
RunProgramInvocationException :: FilePath -> String -> CabalException
GetProgramInvocationException :: FilePath -> String -> CabalException
GetProgramInvocationLBSException :: FilePath -> String -> CabalException
CheckSemaphoreSupport :: CabalException
NoLibraryForPackage :: CabalException
SanityCheckHookedBuildInfo :: UnqualComponentName -> CabalException
ConfigureScriptNotFound :: FilePath -> CabalException
NoValidComponent :: CabalException
ConfigureEitherSingleOrAll :: CabalException
ConfigCIDValidForPreComponent :: CabalException
SanityCheckForEnableComponents :: CabalException
SanityCheckForDynamicStaticLinking :: CabalException
UnsupportedLanguages :: PackageIdentifier -> CompilerId -> [String] -> CabalException
UnsupportedLanguageExtension :: PackageIdentifier -> CompilerId -> [String] -> CabalException
CantFindForeignLibraries :: [String] -> CabalException
ExpectedAbsoluteDirectory :: FilePath -> CabalException
FlagsNotSpecified :: [FlagName] -> CabalException
EncounteredMissingDependency :: [Dependency] -> CabalException
CompilerDoesn'tSupportThinning :: CabalException
CompilerDoesn'tSupportReexports :: CabalException
CompilerDoesn'tSupportBackpack :: CabalException
LibraryWithinSamePackage :: [PackageId] -> CabalException
ReportFailedDependencies :: [FailedDependency] -> String -> CabalException
NoPackageDatabaseSpecified :: CabalException
HowToFindInstalledPackages :: CompilerFlavor -> CabalException
PkgConfigNotFound :: String -> String -> CabalException
BadVersion :: String -> String -> PkgconfigVersion -> CabalException
UnknownCompilerException :: CabalException
NoWorkingGcc :: CabalException
NoOSSupport :: OS -> String -> CabalException
NoCompilerSupport :: String -> CabalException
InstallDirsNotPrefixRelative :: InstallDirs FilePath -> CabalException
ExplainErrors :: Maybe (Either [Char] [Char]) -> [String] -> CabalException
CheckPackageProblems :: [String] -> CabalException
LibDirDepsPrefixNotRelative :: FilePath -> FilePath -> CabalException
CombinedConstraints :: Doc -> CabalException
CantParseGHCOutput :: CabalException
IncompatibleWithCabal :: String -> String -> CabalException
Couldn'tFindTestProgram :: FilePath -> CabalException
TestCoverageSupport :: CabalException
Couldn'tFindTestProgLibV09 :: FilePath -> CabalException
TestCoverageSupportLibV09 :: CabalException
RawSystemStdout :: String -> CabalException
FindFile :: FilePath -> CabalException
FindModuleFileEx :: ModuleName -> [Suffix] -> [FilePath] -> CabalException
MultipleFilesWithExtension :: String -> CabalException
NoDesc :: CabalException
MultiDesc :: [String] -> CabalException
RelocRegistrationInfo :: CabalException
CreatePackageDB :: CabalException
WithHcPkg :: String -> CabalException
RegisMultiplePkgNotSupported :: CabalException
RegisteringNotImplemented :: CabalException
NoTestSuitesEnabled :: CabalException
TestNameDisabled :: String -> CabalException
NoSuchTest :: String -> CabalException
ConfigureProgram :: String -> FilePath -> CabalException
RequireProgram :: String -> CabalException
NoProgramFound :: String -> VersionRange -> CabalException
BadVersionDb :: String -> Version -> VersionRange -> FilePath -> CabalException
UnknownVersionDb :: String -> VersionRange -> FilePath -> CabalException
MissingCoveredInstalledLibrary :: UnitId -> CabalException
SetupHooksException :: SetupHooksException -> CabalException
data FailedDependency
DependencyNotExists :: PackageName -> FailedDependency
DependencyMissingInternal :: PackageName -> LibraryName -> FailedDependency
DependencyNoVersion :: Dependency -> FailedDependency
exceptionCode :: CabalException -> Int
exceptionMessage :: CabalException -> String
instance GHC.Show.Show Distribution.Simple.Errors.FailedDependency
instance GHC.Show.Show Distribution.Simple.Errors.CabalException
-- | Remove the "literal" markups from a Haskell source file, including
-- ">", "\begin{code}", "\end{code}", and
-- "#"
module Distribution.Simple.PreProcess.Unlit
-- | unlit takes a filename (for error reports), and transforms the
-- given string, to eliminate the literate comments from the program
-- text.
unlit :: FilePath -> String -> Either String CabalException
-- | No unliteration.
plain :: String -> String -> String
-- | A large and somewhat miscellaneous collection of utility functions
-- used throughout the rest of the Cabal lib and in other tools that use
-- the Cabal lib like cabal-install. It has a very simple set of
-- logging actions. It has low level functions for running programs, a
-- bunch of wrappers for various directory and file functions that do
-- extra logging.
module Distribution.Simple.Utils
cabalVersion :: Version
dieNoVerbosity :: String -> IO a
die' :: Verbosity -> String -> IO a
dieWithException :: (HasCallStack, Show a1, Typeable a1, Exception (VerboseException a1)) => Verbosity -> a1 -> IO a
dieWithLocation' :: Verbosity -> FilePath -> Maybe Int -> String -> IO a
dieNoWrap :: Verbosity -> String -> IO a
topHandler :: IO a -> IO a
topHandlerWith :: forall a. (SomeException -> IO a) -> IO a -> IO a
-- | Non fatal conditions that may be indicative of an error or problem.
--
-- We display these at the normal verbosity level.
warn :: Verbosity -> String -> IO ()
-- | Like warn, but prepend Error: … instead of Waring:
-- … before the the message. Useful when you want to highlight the
-- condition is an error but do not want to quit the program yet.
warnError :: Verbosity -> String -> IO ()
-- | Useful status messages.
--
-- We display these at the normal verbosity level.
--
-- This is for the ordinary helpful status messages that users see. Just
-- enough information to know that things are working but not floods of
-- detail.
notice :: Verbosity -> String -> IO ()
-- | Display a message at normal verbosity level, but without
-- wrapping.
noticeNoWrap :: Verbosity -> String -> IO ()
-- | Pretty-print a Doc status message at normal verbosity
-- level. Use this if you need fancy formatting.
noticeDoc :: Verbosity -> Doc -> IO ()
-- | Display a "setup status message". Prefer using setupMessage' if
-- possible.
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
-- | More detail on the operation of some action.
--
-- We display these messages when the verbosity level is verbose
info :: Verbosity -> String -> IO ()
infoNoWrap :: Verbosity -> String -> IO ()
-- | Detailed internal debugging information
--
-- We display these messages when the verbosity level is deafening
debug :: Verbosity -> String -> IO ()
-- | A variant of debug that doesn't perform the automatic line
-- wrapping. Produces better output in some cases.
debugNoWrap :: Verbosity -> String -> IO ()
-- | Perform an IO action, catching any IO exceptions and printing an error
-- if one occurs.
chattyTry :: String -> IO () -> IO ()
-- | Given a block of IO code that may raise an exception, annotate it with
-- the metadata from the current scope. Use this as close to external
-- code that raises IO exceptions as possible, since this function
-- unconditionally wraps the error message with a trace (so it is NOT
-- idempotent.)
annotateIO :: Verbosity -> IO a -> IO a
-- | Add all necessary metadata to a logging message
exceptionWithMetadata :: CallStack -> POSIXTime -> Verbosity -> String -> String
-- | Wrap output with a marker if +markoutput verbosity flag is
-- set.
--
-- NB: Why is markoutput done with start/end markers, and not prefixes?
-- Markers are more convenient to add (if we want to add prefixes, we
-- have to lines and then map; here's it's just some
-- concatenates). Note that even in the prefix case, we can't guarantee
-- that the markers are unambiguous, because some of Cabal's output comes
-- straight from external programs, where we don't have the ability to
-- interpose on the output.
--
-- This is used by withMetadata
withOutputMarker :: Verbosity -> String -> String
-- | Run an IO computation, returning e if it raises a "file does
-- not exist" error.
handleDoesNotExist :: a -> IO a -> IO a
-- | Ignore SIGPIPE in a subcomputation.
ignoreSigPipe :: IO () -> IO ()
-- | Execute the given command with the given arguments, exiting with the
-- same exit code if the command fails.
rawSystemExit :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> FilePath -> [String] -> IO ()
-- | Execute the given command with the given arguments, returning the
-- command's exit code.
rawSystemExitCode :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> FilePath -> [String] -> Maybe [(String, String)] -> IO ExitCode
-- | Execute the given command with the given arguments, returning the
-- command's exit code.
--
-- Create the process argument with proc to ensure consistent
-- options with other rawSystem functions in this module.
rawSystemProc :: Verbosity -> CreateProcess -> IO ExitCode
-- | Execute the given command with the given arguments, returning the
-- command's exit code. action is executed while the command is
-- running, and would typically be used to communicate with the process
-- through pipes.
--
-- Create the process argument with proc to ensure consistent
-- options with other rawSystem functions in this module.
rawSystemProcAction :: Verbosity -> CreateProcess -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> IO a) -> IO (ExitCode, a)
-- | Execute the given command with the given arguments and environment,
-- exiting with the same exit code if the command fails.
rawSystemExitWithEnv :: Verbosity -> FilePath -> [String] -> [(String, String)] -> IO ()
-- | Like rawSystemExitWithEnv, but setting a working directory.
rawSystemExitWithEnvCwd :: Verbosity -> Maybe (SymbolicPath CWD to) -> FilePath -> [String] -> [(String, String)] -> IO ()
-- | Execute the given command with the given arguments, returning the
-- command's output. Exits if the command exits with error.
--
-- Provides control over the binary/text mode of the output.
rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode
-- | Execute the given command with the given arguments, returning the
-- command's output, errors and exit code.
--
-- Optional arguments allow setting working directory, environment and
-- command input.
--
-- Provides control over the binary/text mode of the input and output.
rawSystemStdInOut :: KnownIODataMode mode => Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> Maybe IOData -> IODataMode mode -> IO (mode, String, ExitCode)
-- | Execute the given command with the given arguments, returning the
-- command's exit code.
--
-- Optional arguments allow setting working directory, environment and
-- input and output handles.
rawSystemIOWithEnv :: Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ExitCode
-- | Execute the given command with the given arguments, returning the
-- command's exit code. action is executed while the command is
-- running, and would typically be used to communicate with the process
-- through pipes.
--
-- Optional arguments allow setting working directory, environment and
-- input and output handles.
rawSystemIOWithEnvAndAction :: Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> IO a -> Maybe Handle -> Maybe Handle -> Maybe Handle -> IO (ExitCode, a)
-- | fromJust for dealing with 'Maybe Handle' values as obtained via
-- CreatePipe. Creating a pipe using CreatePipe
-- guarantees a Just value for the corresponding handle.
fromCreatePipe :: Maybe Handle -> Handle
-- | Helper to use with one of the rawSystem variants, and exit
-- unless the command completes successfully.
maybeExit :: IO ExitCode -> IO ()
-- | Like the Unix xargs program. Useful for when we've got very long
-- command lines that might overflow an OS limit on command line length
-- and so you need to invoke a command multiple times to get all the args
-- in.
--
-- Use it with either of the rawSystem variants above. For example:
--
--
-- xargs (32*1024) (rawSystemExit verbosity) prog fixedArgs bigArgs
--
xargs :: Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()
-- | Look for a program and try to find it's version number. It can accept
-- either an absolute path or the name of a program binary, in which case
-- we will look for the program on the path.
findProgramVersion :: String -> (String -> String) -> Verbosity -> FilePath -> IO (Maybe Version)
-- | Represents either textual or binary data passed via I/O functions
-- which support binary/text mode
data IOData
-- | How Text gets encoded is usually locale-dependent.
IODataText :: String -> IOData
-- | Raw binary which gets read/written in binary mode.
IODataBinary :: ByteString -> IOData
class NFData mode => KnownIODataMode mode
-- | IOData Wrapper for hGetContents
--
-- Note: This operation uses lazy I/O. Use NFData to force
-- all data to be read and consequently the internal file handle to be
-- closed.
hGetIODataContents :: KnownIODataMode mode => Handle -> IO mode
toIOData :: KnownIODataMode mode => mode -> IOData
iodataMode :: KnownIODataMode mode => IODataMode mode
-- | Phantom-typed GADT representation of the mode of IOData,
-- containing no other data.
data IODataMode mode
[IODataModeText] :: IODataMode String
[IODataModeBinary] :: IODataMode ByteString
data VerboseException a
VerboseException :: CallStack -> POSIXTime -> Verbosity -> a -> VerboseException a
-- | Same as createDirectoryIfMissing but logs at higher verbosity
-- levels.
createDirectoryIfMissingVerbose :: Verbosity -> Bool -> FilePath -> IO ()
-- | Copies a file without copying file permissions. The target file is
-- created with default permissions. Any existing target file is
-- replaced.
--
-- At higher verbosity levels it logs an info message.
copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Copies a bunch of files to a target directory, preserving the
-- directory structure in the target location. The target directories are
-- created if they do not exist.
--
-- The files are identified by a pair of base directory and a path
-- relative to that base. It is only the relative part that is preserved
-- in the destination.
--
-- For example:
--
--
-- copyFiles normal "dist/src"
-- [("", "src/Foo.hs"), ("dist/build/", "src/Bar.hs")]
--
--
-- This would copy "src/Foo.hs" to "dist/src/src/Foo.hs" and copy
-- "dist/build/src/Bar.hs" to "dist/src/src/Bar.hs".
--
-- This operation is not atomic. Any IO failure during the copy
-- (including any missing source files) leaves the target in an unknown
-- state so it is best to use it with a freshly created directory so that
-- it can be simply deleted if anything goes wrong.
copyFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
-- | Given a relative path to a file, copy it to the given directory,
-- preserving the relative path and creating the parent directories if
-- needed.
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Given a relative path to a file, copy it to the given directory,
-- preserving the relative path and creating the parent directories if
-- needed.
copyFileToCwd :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir target) -> RelativePath Pkg File -> IO ()
-- | Install an ordinary file. This is like a file copy but the permissions
-- are set appropriately for an installed file. On Unix it is
-- "-rw-r--r--" while on Windows it uses the default permissions for the
-- target directory.
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Install an executable file. This is like a file copy but the
-- permissions are set appropriately for an installed file. On Unix it is
-- "-rwxr-xr-x" while on Windows it uses the default permissions for the
-- target directory.
installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Install a file that may or not be executable, preserving permissions.
installMaybeExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()
-- | This is like copyFiles but uses installOrdinaryFile.
installOrdinaryFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
-- | This is like copyFiles but uses installExecutableFile.
installExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
-- | This is like copyFiles but uses
-- installMaybeExecutableFile.
installMaybeExecutableFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
-- | This installs all the files in a directory to a target location,
-- preserving the directory layout. All the files are assumed to be
-- ordinary rather than executable files.
installDirectoryContents :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Recursively copy the contents of one directory to another path.
copyDirectoryRecursive :: Verbosity -> FilePath -> FilePath -> IO ()
-- | Like doesFileExist, but also checks that the file is
-- executable.
doesExecutableExist :: FilePath -> IO Bool
setFileOrdinary :: FilePath -> IO ()
setFileExecutable :: FilePath -> IO ()
shortRelativePath :: FilePath -> FilePath -> FilePath
-- | Drop the extension if it's one of exeExtensions, or return the
-- path unchanged.
dropExeExtension :: FilePath -> FilePath
-- | List of possible executable file extensions on the current build
-- platform.
exeExtensions :: [String]
-- | Find a file by looking in a search path. The file path must match
-- exactly.
findFileEx :: forall searchDir allowAbsolute. Verbosity -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (SymbolicPathX allowAbsolute Pkg File)
-- | Find a file by looking in a search path. The file path must match
-- exactly.
findFileCwd :: forall searchDir allowAbsolute. Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (SymbolicPathX allowAbsolute Pkg File)
findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
-- | A suffix (or file extension).
--
-- Mostly used to decide which preprocessor to use, e.g. files with
-- suffix "y" are usually processed by the "happy"
-- build tool.
newtype Suffix
Suffix :: String -> Suffix
-- | Find a file by looking in a search path with one of a list of possible
-- file extensions. The file base name should be given and it will be
-- tried with each of the extensions in each element of the search path.
findFileWithExtension :: [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (Maybe (SymbolicPathX allowAbsolute Pkg File))
-- | Find a file by looking in a search path with one of a list of possible
-- file extensions.
findFileCwdWithExtension :: forall searchDir allowAbsolute. Maybe (SymbolicPath CWD (Dir Pkg)) -> [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (Maybe (SymbolicPathX allowAbsolute Pkg File))
-- | Like findFileWithExtension but returns which element of the
-- search path the file was found in, and the file path relative to that
-- base directory.
findFileWithExtension' :: [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (Maybe (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File))
-- | Like findFileCwdWithExtension but returns which element of the
-- search path the file was found in, and the file path relative to that
-- base directory.
findFileCwdWithExtension' :: forall searchDir allowAbsolute. Maybe (SymbolicPath CWD (Dir Pkg)) -> [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO (Maybe (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File))
findAllFilesWithExtension :: [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO [SymbolicPathX allowAbsolute Pkg File]
findAllFilesCwdWithExtension :: forall searchDir allowAbsolute. Maybe (SymbolicPath CWD (Dir Pkg)) -> [Suffix] -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> RelativePath searchDir File -> IO [SymbolicPathX allowAbsolute Pkg File]
-- | Find the file corresponding to a Haskell module name.
--
-- This is similar to findFileWithExtension' but specialised to a
-- module name. The function fails if the file corresponding to the
-- module is missing.
findModuleFileEx :: forall searchDir allowAbsolute. Verbosity -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> [Suffix] -> ModuleName -> IO (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)
-- | Find the file corresponding to a Haskell module name.
--
-- This is similar to findFileCwdWithExtension' but specialised to
-- a module name. The function fails if the file corresponding to the
-- module is missing.
findModuleFileCwd :: forall searchDir allowAbsolute. Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> [Suffix] -> ModuleName -> IO (SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)
-- | Finds the files corresponding to a list of Haskell module names.
--
-- As findModuleFile but for a list of module names.
findModuleFilesEx :: forall searchDir allowAbsolute. Verbosity -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> [Suffix] -> [ModuleName] -> IO [(SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)]
-- | Finds the files corresponding to a list of Haskell module names.
--
-- As findModuleFileCwd but for a list of module names.
findModuleFilesCwd :: forall searchDir allowAbsolute. Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> [SymbolicPathX allowAbsolute Pkg (Dir searchDir)] -> [Suffix] -> [ModuleName] -> IO [(SymbolicPathX allowAbsolute Pkg (Dir searchDir), RelativePath searchDir File)]
-- | List all the files in a directory and all subdirectories.
--
-- The order places files in sub-directories after all the files in their
-- parent directories. The list is generated lazily so is not well
-- defined if the source directory structure changes before the list is
-- used.
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
-- | Is this directory in the system search path?
isInSearchPath :: FilePath -> IO Bool
addLibraryPath :: OS -> [FilePath] -> [(String, String)] -> [(String, String)]
-- | Compare the modification times of two files to see if the first is
-- newer than the second. The first file must exist but the second need
-- not. The expected use case is when the second file is generated using
-- the first. In this use case, if the result is True then the second
-- file is out of date.
moreRecentFile :: FilePath -> FilePath -> IO Bool
-- | Like moreRecentFile, but also checks that the first file
-- exists.
existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
-- | Advanced options for withTempFile and withTempDirectory.
data TempFileOptions
TempFileOptions :: Bool -> TempFileOptions
-- | Keep temporary files?
[optKeepTempFiles] :: TempFileOptions -> Bool
defaultTempFileOptions :: TempFileOptions
-- | Use a temporary filename that doesn't already exist
withTempFile :: FilePath -> String -> (FilePath -> Handle -> IO a) -> IO a
-- | Use a temporary filename that doesn't already exist.
withTempFileCwd :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir tmpDir) -> String -> (SymbolicPath Pkg File -> Handle -> IO a) -> IO a
-- | A version of withTempFile that additionally takes a
-- TempFileOptions argument.
withTempFileEx :: forall a tmpDir. TempFileOptions -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir tmpDir) -> String -> (SymbolicPath Pkg File -> Handle -> IO a) -> IO a
-- | Create and use a temporary directory.
--
-- Creates a new temporary directory inside the given directory, making
-- use of the template. The temp directory is deleted after use. For
-- example:
--
--
-- withTempDirectory verbosity "src" "sdist." $ \tmpDir -> do ...
--
--
-- The tmpDir will be a new subdirectory of the given directory,
-- e.g. src/sdist.342.
withTempDirectory :: Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO a
-- | Create and use a temporary directory.
--
-- Creates a new temporary directory inside the given directory, making
-- use of the template. The temp directory is deleted after use. For
-- example:
--
--
-- withTempDirectory verbosity "src" "sdist." $ \tmpDir -> do ...
--
--
-- The tmpDir will be a new subdirectory of the given directory,
-- e.g. src/sdist.342.
withTempDirectoryCwd :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir tmpDir1) -> String -> (SymbolicPath Pkg (Dir tmpDir2) -> IO a) -> IO a
-- | A version of withTempDirectory that additionally takes a
-- TempFileOptions argument.
withTempDirectoryEx :: Verbosity -> TempFileOptions -> FilePath -> String -> (FilePath -> IO a) -> IO a
-- | A version of withTempDirectoryCwd that additionally takes a
-- TempFileOptions argument.
withTempDirectoryCwdEx :: forall a tmpDir1 tmpDir2. Verbosity -> TempFileOptions -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir tmpDir1) -> String -> (SymbolicPath Pkg (Dir tmpDir2) -> IO a) -> IO a
createTempDirectory :: FilePath -> String -> IO FilePath
-- | Package description file (pkgname.cabal) in the
-- current working directory.
defaultPackageDescCwd :: Verbosity -> IO (RelativePath Pkg File)
-- | Find a package description file in the given directory. Looks for
-- .cabal files.
findPackageDesc :: Maybe (SymbolicPath CWD (Dir Pkg)) -> IO (Either CabalException (RelativePath Pkg File))
-- | Like findPackageDesc, but calls die in case of error.
tryFindPackageDesc :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> IO (RelativePath Pkg File)
-- | Find auxiliary package information in the given directory. Looks for
-- .buildinfo files.
findHookedPackageDesc :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Build) -> IO (Maybe (SymbolicPath Pkg File))
withFileContents :: FilePath -> (String -> IO a) -> IO a
writeFileAtomic :: FilePath -> ByteString -> IO ()
-- | Write a file but only if it would have new content. If we would be
-- writing the same as the existing content then leave the file as is so
-- that we do not update the file's modification time.
--
-- NB: Before Cabal-3.0 the file content was assumed to be
-- ASCII-representable. Since Cabal-3.0 the file is assumed to be UTF-8
-- encoded.
rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()
-- | Same as rewriteFileEx but for ByteStrings.
rewriteFileLBS :: Verbosity -> FilePath -> ByteString -> IO ()
fromUTF8BS :: ByteString -> String
fromUTF8LBS :: ByteString -> String
toUTF8BS :: String -> ByteString
toUTF8LBS :: String -> ByteString
readUTF8File :: FilePath -> IO String
withUTF8FileContents :: FilePath -> (String -> IO a) -> IO a
writeUTF8File :: FilePath -> String -> IO ()
normaliseLineEndings :: String -> String
ignoreBOM :: String -> String
dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
takeWhileEndLE :: (a -> Bool) -> [a] -> [a]
equating :: Eq a => (b -> a) -> b -> b -> Bool
-- |
-- comparing p x y = compare (p x) (p y)
--
--
-- Useful combinator for use in conjunction with the xxxBy
-- family of functions from Data.List, for example:
--
--
-- ... sortBy (comparing fst) ...
--
comparing :: Ord a => (b -> a) -> b -> b -> Ordering
-- | The isInfixOf function takes two lists and returns True
-- iff the first list is contained, wholly and intact, anywhere within
-- the second.
--
--
-- >>> isInfixOf "Haskell" "I really like Haskell."
-- True
--
-- >>> isInfixOf "Ial" "I really like Haskell."
-- False
--
--
-- For the result to be True, the first list must be finite; for
-- the result to be False, the second list must be finite:
--
--
-- >>> [20..50] `isInfixOf` [0..]
-- True
--
-- >>> [0..] `isInfixOf` [20..50]
-- False
--
-- >>> [0..] `isInfixOf` [0..]
-- * Hangs forever *
--
isInfixOf :: Eq a => [a] -> [a] -> Bool
-- | intercalate xs xss is equivalent to (concat
-- (intersperse xs xss)). It inserts the list xs in
-- between the lists in xss and concatenates the result.
--
--
-- >>> intercalate ", " ["Lorem", "ipsum", "dolor"]
-- "Lorem, ipsum, dolor"
--
intercalate :: [a] -> [[a]] -> [a]
lowercase :: String -> String
listUnion :: Ord a => [a] -> [a] -> [a]
listUnionRight :: Ord a => [a] -> [a] -> [a]
ordNub :: Ord a => [a] -> [a]
ordNubBy :: Ord b => (a -> b) -> [a] -> [a]
ordNubRight :: Ord a => [a] -> [a]
safeHead :: [a] -> Maybe a
safeTail :: [a] -> [a]
safeLast :: [a] -> Maybe a
safeInit :: [a] -> [a]
unintersperse :: Char -> String -> [String]
wrapText :: String -> String
wrapLine :: Int -> [String] -> [[String]]
isAbsoluteOnAnyPlatform :: FilePath -> Bool
isRelativeOnAnyPlatform :: FilePath -> Bool
-- | Append a call-site and/or call-stack based on Verbosity
exceptionWithCallStackPrefix :: CallStack -> Verbosity -> String -> String
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Utils.VerboseException a)
instance GHC.Classes.Eq Distribution.Simple.Utils.TraceWhen
instance GHC.Exception.Type.Exception (Distribution.Simple.Utils.VerboseException Distribution.Simple.Errors.CabalException)
module Distribution.Utils.NubList
-- | NubList : A de-duplicated list that maintains the original order.
data NubList a
-- | Smart constructor for the NubList type.
toNubList :: Ord a => [a] -> NubList a
fromNubList :: NubList a -> [a]
-- | Lift a function over lists to a function over NubLists.
overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a
-- | NubListR : A right-biased version of NubList. That is
-- toNubListR ["-XNoFoo", "-XFoo", "-XNoFoo"] will result in
-- ["-XFoo", "-XNoFoo"], unlike the normal NubList, which
-- is left-biased. Built on top of ordNubRight and
-- listUnionRight.
data NubListR a
-- | Smart constructor for the NubListR type.
toNubListR :: Ord a => [a] -> NubListR a
fromNubListR :: NubListR a -> [a]
-- | Lift a function over lists to a function over NubListRs.
overNubListR :: Ord a => ([a] -> [a]) -> NubListR a -> NubListR a
instance GHC.Generics.Generic (Distribution.Utils.NubList.NubList a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubList a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubListR a)
instance GHC.Classes.Ord a => GHC.Base.Monoid (Distribution.Utils.NubList.NubListR a)
instance GHC.Classes.Ord a => GHC.Base.Semigroup (Distribution.Utils.NubList.NubListR a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Utils.NubList.NubListR a)
instance (GHC.Classes.Ord a, GHC.Read.Read a) => GHC.Read.Read (Distribution.Utils.NubList.NubListR a)
instance GHC.Classes.Ord a => GHC.Base.Monoid (Distribution.Utils.NubList.NubList a)
instance GHC.Classes.Ord a => GHC.Base.Semigroup (Distribution.Utils.NubList.NubList a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Utils.NubList.NubList a)
instance (GHC.Classes.Ord a, GHC.Read.Read a) => GHC.Read.Read (Distribution.Utils.NubList.NubList a)
instance (GHC.Classes.Ord a, Data.Binary.Class.Binary a) => Data.Binary.Class.Binary (Distribution.Utils.NubList.NubList a)
instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Utils.NubList.NubList a)
module Distribution.Utils.LogProgress
-- | The Progress monad with specialized logging and error messages.
data LogProgress a
-- | Run LogProgress, outputting traces according to
-- Verbosity, die if there is an error.
runLogProgress :: Verbosity -> LogProgress a -> IO a
-- | Output a warning trace message in LogProgress.
warnProgress :: Doc -> LogProgress ()
-- | Output an informational trace message in LogProgress.
infoProgress :: Doc -> LogProgress ()
-- | Fail the computation with an error message.
dieProgress :: Doc -> LogProgress a
-- | Add a message to the error/warning context.
addProgressCtx :: CtxMsg -> LogProgress a -> LogProgress a
instance GHC.Base.Functor Distribution.Utils.LogProgress.LogProgress
instance GHC.Base.Applicative Distribution.Utils.LogProgress.LogProgress
instance GHC.Base.Monad Distribution.Utils.LogProgress.LogProgress
-- | This module provides a data type for program invocations and functions
-- to run them.
module Distribution.Simple.Program.Run
-- | Represents a specific invocation of a specific program.
--
-- This is used as an intermediate type between deciding how to call a
-- program and actually doing it. This provides the opportunity to the
-- caller to adjust how the program will be called. These invocations can
-- either be run directly or turned into shell or batch scripts.
data ProgramInvocation
ProgramInvocation :: FilePath -> [String] -> [(String, Maybe String)] -> Maybe FilePath -> Maybe IOData -> IOEncoding -> IOEncoding -> ProgramInvocation
[progInvokePath] :: ProgramInvocation -> FilePath
[progInvokeArgs] :: ProgramInvocation -> [String]
[progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)]
[progInvokeCwd] :: ProgramInvocation -> Maybe FilePath
[progInvokeInput] :: ProgramInvocation -> Maybe IOData
-- | TODO: remove this, make user decide when constructing
-- progInvokeInput.
[progInvokeInputEncoding] :: ProgramInvocation -> IOEncoding
[progInvokeOutputEncoding] :: ProgramInvocation -> IOEncoding
data IOEncoding
IOEncodingText :: IOEncoding
IOEncodingUTF8 :: IOEncoding
emptyProgramInvocation :: ProgramInvocation
simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation
programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation
programInvocationCwd :: forall to. Maybe (SymbolicPath CWD (Dir to)) -> ConfiguredProgram -> [String] -> ProgramInvocation
-- | Like the unix xargs program. Useful for when we've got very long
-- command lines that might overflow an OS limit on command line length
-- and so you need to invoke a command multiple times to get all the args
-- in.
--
-- It takes four template invocations corresponding to the simple,
-- initial, middle and last invocations. If the number of args given is
-- small enough that we can get away with just a single invocation then
-- the simple one is used:
--
--
-- $ simple args
--
--
-- If the number of args given means that we need to use multiple
-- invocations then the templates for the initial, middle and last
-- invocations are used:
--
--
-- $ initial args_0
-- $ middle args_1
-- $ middle args_2
-- ...
-- $ final args_n
--
multiStageProgramInvocation :: ProgramInvocation -> (ProgramInvocation, ProgramInvocation, ProgramInvocation) -> [String] -> [ProgramInvocation]
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()
getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String
getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString
getProgramInvocationOutputAndErrors :: Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationLBSAndErrors :: Verbosity -> ProgramInvocation -> IO (ByteString, String, ExitCode)
-- | Return the current environment extended with the given overrides. If
-- an entry is specified twice in overrides, the second entry
-- takes precedence.
getEffectiveEnvironment :: [(String, Maybe String)] -> IO (Maybe [(String, String)])
-- | This module provides an library interface to the hc-pkg
-- program. Currently only GHC and LHC have hc-pkg programs.
module Distribution.Simple.Program.Script
-- | Generate a system script, either POSIX shell script or Windows batch
-- file as appropriate for the given system.
invocationAsSystemScript :: OS -> ProgramInvocation -> String
-- | Generate a POSIX shell script that invokes a program.
invocationAsShellScript :: ProgramInvocation -> String
-- | Generate a Windows batch file that invokes a program.
invocationAsBatchFile :: ProgramInvocation -> String
module Distribution.Simple.Program.ResponseFile
withResponseFile :: Verbosity -> TempFileOptions -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Response) -> String -> Maybe TextEncoding -> [String] -> (FilePath -> IO a) -> IO a
-- | This module provides an library interface to the hpc program.
module Distribution.Simple.Program.Hpc
-- | Invoke hpc with the given parameters.
--
-- Prior to HPC version 0.7 (packaged with GHC 7.8), hpc did not handle
-- multiple .mix paths correctly, so we print a warning, and only pass it
-- the first path in the list. This means that e.g. test suites that
-- import their library as a dependency can still work, but those that
-- include the library modules directly (in other-modules) don't.
markup :: Maybe (SymbolicPath CWD (Dir Pkg)) -> ConfiguredProgram -> Version -> Verbosity -> SymbolicPath Pkg File -> [SymbolicPath Pkg (Dir Mix)] -> SymbolicPath Pkg (Dir Artifacts) -> [ModuleName] -> IO ()
union :: Maybe (SymbolicPath CWD (Dir Pkg)) -> ConfiguredProgram -> Verbosity -> [SymbolicPath Pkg File] -> SymbolicPath Pkg File -> [ModuleName] -> IO ()
-- | A somewhat extended notion of the normal program search path concept.
--
-- Usually when finding executables we just want to look in the usual
-- places using the OS's usual method for doing so. In Haskell the normal
-- OS-specific method is captured by findExecutable. On all common
-- OSs that makes use of a PATH environment variable, (though on
-- Windows it is not just the PATH).
--
-- However it is sometimes useful to be able to look in additional
-- locations without having to change the process-global PATH
-- environment variable. So we need an extension of the usual
-- findExecutable that can look in additional locations, either
-- before, after or instead of the normal OS locations.
module Distribution.Simple.Program.Find
-- | A search path to use when locating executables. This is analogous to
-- the unix $PATH or win32 %PATH% but with the ability
-- to use the system default method for finding executables
-- (findExecutable which on unix is simply looking on the
-- $PATH but on win32 is a bit more complicated).
--
-- The default to use is [ProgSearchPathDefault] but you can add
-- extra dirs either before, after or instead of the default, e.g. here
-- we add an extra dir to search after the usual ones.
--
--
-- ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
--
--
-- We also use this path to set the environment when running child
-- processes.
--
-- The ProgramDb is created with a ProgramSearchPath to
-- which we prependProgramSearchPath to add the ones that come
-- from cli flags and from configurations. Then each of the programs that
-- are configured in the db inherits the same path as part of
-- configureProgram.
type ProgramSearchPath = [ProgramSearchPathEntry]
data ProgramSearchPathEntry
-- | A specific dir
ProgramSearchPathDir :: FilePath -> ProgramSearchPathEntry
-- | The system default
ProgramSearchPathDefault :: ProgramSearchPathEntry
defaultProgramSearchPath :: ProgramSearchPath
findProgramOnSearchPath :: Verbosity -> ProgramSearchPath -> FilePath -> IO (Maybe (FilePath, [FilePath]))
-- | Interpret a ProgramSearchPath to construct a new $PATH
-- env var. Note that this is close but not perfect because on Windows
-- the search algorithm looks at more than just the %PATH%.
programSearchPathAsPATHVar :: ProgramSearchPath -> IO String
logExtraProgramSearchPath :: Verbosity -> [FilePath] -> IO ()
logExtraProgramOverrideEnv :: Verbosity -> [(String, Maybe String)] -> IO ()
-- | Get the system search path. On Unix systems this is just the
-- $PATH env var, but on windows it's a bit more complicated.
getSystemSearchPath :: IO [FilePath]
-- | Adds some paths to the PATH entry in the key-value environment
-- provided or if there is none, looks up $PATH in the real
-- environment.
getExtraPathEnv :: Verbosity -> [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)]
-- | Make a simple named program.
--
-- By default we'll just search for it in the path and not try to find
-- the version name. You can override these behaviours if necessary, eg:
--
--
-- (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
--
simpleProgram :: String -> Program
-- | An index of packages whose primary key is UnitId. Public
-- libraries are additionally indexed by PackageName and
-- Version. Technically, these are an index of *units* (so we
-- should eventually rename it to UnitIndex); but in the absence
-- of internal libraries or Backpack each unit is equivalent to a
-- package.
--
-- While PackageIndex is parametric over what it actually records,
-- it is in fact only ever instantiated with a single element: The
-- InstalledPackageIndex (defined here) contains a graph of
-- InstalledPackageInfos representing the packages in a package
-- database stack. It is used in a variety of ways:
--
--
-- - The primary use to let Cabal access the same installed package
-- database which is used by GHC during compilation. For example, this
-- data structure is used by 'ghc-pkg' and Cabal to do
-- consistency checks on the database (are the references closed).
-- - Given a set of dependencies, we can compute the transitive closure
-- of dependencies. This is to check if the versions of packages are
-- consistent, and also needed by multiple tools (Haddock must be
-- explicitly told about the every transitive package to do cross-package
-- linking; preprocessors must know about the include paths of all
-- transitive dependencies.)
--
--
-- This PackageIndex is NOT to be confused with
-- PackageIndex, which indexes packages only by PackageName
-- (this makes it suitable for indexing source packages, for which we
-- don't know UnitIds.)
module Distribution.Simple.PackageIndex
-- | The default package index which contains
-- InstalledPackageInfo. Normally use this.
type InstalledPackageIndex = PackageIndex InstalledPackageInfo
-- | The collection of information about packages from one or more
-- PackageDBs. These packages generally should have an instance
-- of PackageInstalled
--
-- Packages are uniquely identified in by their UnitId, they can
-- also be efficiently looked up by package name or by name and version.
data PackageIndex a
-- | Build an index out of a bunch of packages.
--
-- If there are duplicates by UnitId then later ones mask earlier
-- ones.
fromList :: [InstalledPackageInfo] -> InstalledPackageIndex
-- | Merge two indexes.
--
-- Packages from the second mask packages from the first if they have the
-- exact same UnitId.
--
-- For packages with the same source PackageId, packages from the
-- second are "preferred" over those from the first. Being preferred
-- means they are top result when we do a lookup by source
-- PackageId. This is the mechanism we use to prefer user packages
-- over global packages.
merge :: InstalledPackageIndex -> InstalledPackageIndex -> InstalledPackageIndex
-- | Inserts a single package into the index.
--
-- This is equivalent to (but slightly quicker than) using mappend
-- or merge with a singleton index.
insert :: InstalledPackageInfo -> InstalledPackageIndex -> InstalledPackageIndex
-- | Removes a single installed package from the index.
deleteUnitId :: UnitId -> InstalledPackageIndex -> InstalledPackageIndex
-- | Removes all packages with this source PackageId from the index.
deleteSourcePackageId :: PackageId -> InstalledPackageIndex -> InstalledPackageIndex
-- | Removes all packages with this (case-sensitive) name from the index.
--
-- NB: Does NOT delete internal libraries from this package.
deletePackageName :: PackageName -> InstalledPackageIndex -> InstalledPackageIndex
-- | Does a lookup by unit identifier.
--
-- Since multiple package DBs mask each other by UnitId, then we
-- get back at most one package.
lookupUnitId :: PackageIndex a -> UnitId -> Maybe a
-- | Does a lookup by component identifier. In the absence of Backpack,
-- this is just a lookupUnitId.
lookupComponentId :: PackageIndex a -> ComponentId -> Maybe a
-- | Does a lookup by source package id (name & version).
--
-- There can be multiple installed packages with the same source
-- PackageId but different UnitId. They are returned in
-- order of preference, with the most preferred first.
lookupSourcePackageId :: PackageIndex a -> PackageId -> [a]
-- | Convenient alias of lookupSourcePackageId, but assuming only
-- one package per package ID.
lookupPackageId :: PackageIndex a -> PackageId -> Maybe a
-- | Does a lookup by source package name.
lookupPackageName :: PackageIndex a -> PackageName -> [(Version, [a])]
-- | Does a lookup by source package name and a range of versions.
--
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
-- This does NOT work for internal dependencies, DO NOT use this function
-- on those; use lookupInternalDependency instead.
--
-- INVARIANT: List of eligible InstalledPackageInfo is non-empty.
lookupDependency :: InstalledPackageIndex -> PackageName -> VersionRange -> [(Version, [InstalledPackageInfo])]
-- | Does a lookup by source package name and a range of versions.
--
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
-- INVARIANT: List of eligible InstalledPackageInfo is non-empty.
lookupInternalDependency :: InstalledPackageIndex -> PackageName -> VersionRange -> LibraryName -> [(Version, [InstalledPackageInfo])]
-- | Does a case-insensitive search by package name.
--
-- If there is only one package that compares case-insensitively to this
-- name then the search is unambiguous and we get back all versions of
-- that package. If several match case-insensitively but one matches
-- exactly then it is also unambiguous.
--
-- If however several match case-insensitively and none match exactly
-- then we have an ambiguous result, and we get back all the versions of
-- all the packages. The list of ambiguous results is split by exact
-- package name. So it is a non-empty list of non-empty lists.
searchByName :: PackageIndex a -> String -> SearchResult [a]
data SearchResult a
None :: SearchResult a
Unambiguous :: a -> SearchResult a
Ambiguous :: [a] -> SearchResult a
-- | Does a case-insensitive substring search by package name.
--
-- That is, all packages that contain the given string in their name.
searchByNameSubstring :: PackageIndex a -> String -> [a]
searchWithPredicate :: PackageIndex a -> (String -> Bool) -> [a]
-- | Get all the packages from the index.
allPackages :: PackageIndex a -> [a]
-- | Get all the packages from the index.
--
-- They are grouped by package name (case-sensitively).
--
-- (Doesn't include private libraries.)
allPackagesByName :: PackageIndex a -> [(PackageName, [a])]
-- | Get all the packages from the index.
--
-- They are grouped by source package id (package name and version).
--
-- (Doesn't include private libraries)
allPackagesBySourcePackageId :: HasUnitId a => PackageIndex a -> [(PackageId, [a])]
-- | Get all the packages from the index.
--
-- They are grouped by source package id and library name.
--
-- This DOES include internal libraries.
allPackagesBySourcePackageIdAndLibName :: HasUnitId a => PackageIndex a -> [((PackageId, LibraryName), [a])]
-- | All packages that have immediate dependencies that are not in the
-- index.
--
-- Returns such packages along with the dependencies that they're
-- missing.
brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [UnitId])]
-- | Tries to take the transitive closure of the package dependencies.
--
-- If the transitive closure is complete then it returns that subset of
-- the index. Otherwise it returns the broken packages as in
-- brokenPackages.
--
--
-- - Note that if the result is Right [] it is because at
-- least one of the original given PackageIds do not occur in the
-- index.
--
dependencyClosure :: InstalledPackageIndex -> [UnitId] -> Either InstalledPackageIndex [(InstalledPackageInfo, [UnitId])]
-- | Takes the transitive closure of the packages reverse dependencies.
--
--
-- - The given PackageIds must be in the index.
--
reverseDependencyClosure :: PackageInstalled a => PackageIndex a -> [UnitId] -> [a]
topologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
reverseTopologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
-- | Given a package index where we assume we want to use all the packages
-- (use dependencyClosure if you need to get such a index subset)
-- find out if the dependencies within it use consistent versions of each
-- package. Return all cases where multiple packages depend on different
-- versions of some other package.
--
-- Each element in the result is a package name along with the packages
-- that depend on it and the versions they require. These are guaranteed
-- to be distinct.
dependencyInconsistencies :: InstalledPackageIndex -> [(DepUniqueKey, [(UnitId, [InstalledPackageInfo])])]
-- | Find if there are any cycles in the dependency graph. If there are no
-- cycles the result is [].
--
-- This actually computes the strongly connected components. So it gives
-- us a list of groups of packages where within each group they all
-- depend on each other, directly or indirectly.
dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
-- | Builds a graph of the package dependencies.
--
-- Dependencies on other packages that are not in the index are
-- discarded. You can check if there are any such dependencies with
-- brokenPackages.
dependencyGraph :: PackageInstalled a => PackageIndex a -> (Graph, Vertex -> a, UnitId -> Maybe Vertex)
-- | A rough approximation of GHC's module finder, takes a
-- InstalledPackageIndex and turns it into a map from module names
-- to their source packages. It's used to initialize the
-- build-deps field in cabal init.
moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo]
instance GHC.Read.Read a => GHC.Read.Read (Distribution.Simple.PackageIndex.PackageIndex a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.PackageIndex.PackageIndex a)
instance GHC.Generics.Generic (Distribution.Simple.PackageIndex.PackageIndex a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.PackageIndex.PackageIndex a)
instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Simple.PackageIndex.PackageIndex a)
instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Simple.PackageIndex.PackageIndex a)
instance GHC.Base.Monoid (Distribution.Simple.PackageIndex.PackageIndex Distribution.Types.InstalledPackageInfo.InstalledPackageInfo)
instance GHC.Base.Semigroup (Distribution.Simple.PackageIndex.PackageIndex Distribution.Types.InstalledPackageInfo.InstalledPackageInfo)
-- | This defines parsers for the .cabal format
module Distribution.Simple.PackageDescription
readGenericPackageDescription :: HasCallStack => Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -> IO GenericPackageDescription
readHookedBuildInfo :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -> IO HookedBuildInfo
parseString :: (ByteString -> ParseResult a) -> Verbosity -> String -> ByteString -> IO a
-- | Simple file globbing.
module Distribution.Simple.Glob
-- | A filepath specified by globbing.
data Glob
data GlobResult a
-- | The glob matched the value supplied.
GlobMatch :: a -> GlobResult a
-- | The glob did not match the value supplied because the cabal-version is
-- too low and the extensions on the file did not precisely match the
-- glob's extensions, but rather the glob was a proper suffix of the
-- file's extensions; i.e., if not for the low cabal-version, it would
-- have matched.
GlobWarnMultiDot :: a -> GlobResult a
-- | The glob couldn't match because the directory named doesn't exist. The
-- directory will be as it appears in the glob (i.e., relative to the
-- directory passed to matchDirFileGlob, and, for 'data-files',
-- relative to 'data-dir').
GlobMissingDirectory :: a -> GlobResult a
-- | The glob matched a directory when we were looking for files only. It
-- didn't match a file!
GlobMatchesDirectory :: a -> GlobResult a
-- | Extract the matches from a list of GlobResults.
--
-- Note: throws away the GlobMissingDirectory results; chances are
-- that you want to check for these and error out if any are present.
globMatches :: [GlobResult a] -> [a]
-- | How/does the glob match the given filepath, according to the cabal
-- version? Since this is pure, we don't make a distinction between
-- matching on directories or files (i.e. this function won't return
-- GlobMatchesDirectory)
fileGlobMatches :: CabalSpecVersion -> Glob -> FilePath -> Maybe (GlobResult ())
-- | Match a Glob against the file system, starting from a given
-- root directory. The results are all relative to the given root.
matchGlob :: FilePath -> Glob -> IO [FilePath]
-- | Match a globbing pattern against a file path component
matchGlobPieces :: GlobPieces -> String -> Bool
-- | This will die' when the glob matches no files, or if the glob
-- refers to a missing directory, or if the glob fails to parse.
--
-- The Version argument must be the spec version of the package
-- description being processed, as globs behave slightly differently in
-- different spec versions.
--
-- The first FilePath argument is the directory that the glob is
-- relative to. It must be a valid directory (and hence it can't be the
-- empty string). The returned values will not include this prefix.
--
-- The second FilePath is the glob itself.
matchDirFileGlob :: Verbosity -> CabalSpecVersion -> Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPathX allowAbs dir file -> IO [SymbolicPathX allowAbs dir file]
-- | Like matchDirFileGlob but with customizable die
matchDirFileGlobWithDie :: Verbosity -> (forall res. Verbosity -> CabalException -> IO [res]) -> CabalSpecVersion -> Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPathX allowAbs dir file -> IO [SymbolicPathX allowAbs dir file]
-- | Match files against a pre-parsed glob, starting in a directory.
--
-- The Version argument must be the spec version of the package
-- description being processed, as globs behave slightly differently in
-- different spec versions.
--
-- The FilePath argument is the directory that the glob is
-- relative to. It must be a valid directory (and hence it can't be the
-- empty string). The returned values will not include this prefix.
runDirFileGlob :: Verbosity -> Maybe CabalSpecVersion -> FilePath -> Glob -> IO [GlobResult FilePath]
parseFileGlob :: CabalSpecVersion -> FilePath -> Either GlobSyntaxError Glob
data GlobSyntaxError
StarInDirectory :: GlobSyntaxError
StarInFileName :: GlobSyntaxError
StarInExtension :: GlobSyntaxError
NoExtensionOnStar :: GlobSyntaxError
EmptyGlob :: GlobSyntaxError
LiteralFileNameGlobStar :: GlobSyntaxError
VersionDoesNotSupportGlobStar :: GlobSyntaxError
VersionDoesNotSupportGlob :: GlobSyntaxError
explainGlobSyntaxError :: FilePath -> GlobSyntaxError -> String
-- | Is the root of this relative glob path a directory-recursive wildcard,
-- e.g. **/*.txt ?
isRecursiveInRoot :: Glob -> Bool
instance GHC.Show.Show Distribution.Simple.Glob.GlobSyntaxError
instance GHC.Classes.Eq Distribution.Simple.Glob.GlobSyntaxError
instance GHC.Base.Functor Distribution.Simple.Glob.GlobResult
instance GHC.Classes.Ord a => GHC.Classes.Ord (Distribution.Simple.Glob.GlobResult a)
instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.Glob.GlobResult a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Glob.GlobResult a)
-- | This should be a much more sophisticated abstraction than it is.
-- Currently it's just a bit of data about the compiler, like its flavour
-- and name and version. The reason it's just data is because currently
-- it has to be in Read and Show so it can be saved along
-- with the LocalBuildInfo. The only interesting bit of info it
-- contains is a mapping between language extensions and compiler command
-- line flags. This module also defines a PackageDB type which is
-- used to refer to package databases. Most compilers only know about a
-- single global package collection but GHC has a global and per-user one
-- and it lets you create arbitrary other package databases. We do not
-- yet fully support this latter feature.
module Distribution.Simple.Compiler
data Compiler
Compiler :: CompilerId -> AbiTag -> [CompilerId] -> [(Language, CompilerFlag)] -> [(Extension, Maybe CompilerFlag)] -> Map String String -> Compiler
-- | Compiler flavour and version.
[compilerId] :: Compiler -> CompilerId
-- | Tag for distinguishing incompatible ABI's on the same architecture/os.
[compilerAbiTag] :: Compiler -> AbiTag
-- | Other implementations that this compiler claims to be compatible with.
[compilerCompat] :: Compiler -> [CompilerId]
-- | Supported language standards.
[compilerLanguages] :: Compiler -> [(Language, CompilerFlag)]
-- | Supported extensions.
[compilerExtensions] :: Compiler -> [(Extension, Maybe CompilerFlag)]
-- | A key-value map for properties not covered by the above fields.
[compilerProperties] :: Compiler -> Map String String
showCompilerId :: Compiler -> String
showCompilerIdWithAbi :: Compiler -> String
compilerFlavor :: Compiler -> CompilerFlavor
compilerVersion :: Compiler -> Version
-- | Is this compiler compatible with the compiler flavour we're interested
-- in?
--
-- For example this checks if the compiler is actually GHC or is another
-- compiler that claims to be compatible with some version of GHC, e.g.
-- GHCJS.
--
--
-- if compilerCompatFlavor GHC compiler then ... else ...
--
compilerCompatFlavor :: CompilerFlavor -> Compiler -> Bool
-- | Is this compiler compatible with the compiler flavour we're interested
-- in, and if so what version does it claim to be compatible with.
--
-- For example this checks if the compiler is actually GHC-7.x or is
-- another compiler that claims to be compatible with some GHC-7.x
-- version.
--
--
-- case compilerCompatVersion GHC compiler of
-- Just (Version (7:_)) -> ...
-- _ -> ...
--
compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
compilerInfo :: Compiler -> CompilerInfo
type PackageDB = PackageDBX (SymbolicPath Pkg (Dir PkgDB))
type PackageDBStack = PackageDBStackX (SymbolicPath Pkg (Dir PkgDB))
type PackageDBCWD = PackageDBX FilePath
type PackageDBStackCWD = PackageDBStackX FilePath
-- | Some compilers have a notion of a database of available packages. For
-- some there is just one global db of packages, other compilers support
-- a per-user or an arbitrary db specified at some location in the file
-- system. This can be used to build isolated environments of packages,
-- for example to build a collection of related packages without
-- installing them globally.
--
-- Abstracted over
data PackageDBX fp
GlobalPackageDB :: PackageDBX fp
UserPackageDB :: PackageDBX fp
-- | NB: the path might be relative or it might be absolute
SpecificPackageDB :: fp -> PackageDBX fp
-- | We typically get packages from several databases, and stack them
-- together. This type lets us be explicit about that stacking. For
-- example typical stacks include:
--
--
-- [GlobalPackageDB]
-- [GlobalPackageDB, UserPackageDB]
-- [GlobalPackageDB, SpecificPackageDB "package.conf.inplace"]
--
--
-- Note that the GlobalPackageDB is invariably at the bottom since
-- it contains the rts, base and other special compiler-specific
-- packages.
--
-- We are not restricted to using just the above combinations. In
-- particular we can use several custom package dbs and the user package
-- db together.
--
-- When it comes to writing, the top most (last) package is used.
type PackageDBStackX from = [PackageDBX from]
type PackageDBS from = PackageDBX (SymbolicPath from (Dir PkgDB))
type PackageDBStackS from = PackageDBStackX (SymbolicPath from (Dir PkgDB))
-- | Return the package that we should register into. This is the package
-- db at the top of the stack.
registrationPackageDB :: PackageDBStackX from -> PackageDBX from
-- | Make package paths absolute
absolutePackageDBPaths :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> IO PackageDBStack
absolutePackageDBPath :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> IO PackageDB
interpretPackageDB :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageDBCWD
interpretPackageDBStack :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> PackageDBStackCWD
-- | Transform a package db using a FilePath into one using symbolic paths.
coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD (Dir PkgDB))
coercePackageDBStack :: [PackageDBCWD] -> [PackageDBX (SymbolicPath CWD (Dir PkgDB))]
-- | Some compilers support optimising. Some have different levels. For
-- compilers that do not the level is just capped to the level they do
-- support.
data OptimisationLevel
NoOptimisation :: OptimisationLevel
NormalOptimisation :: OptimisationLevel
MaximumOptimisation :: OptimisationLevel
flagToOptimisationLevel :: Maybe String -> OptimisationLevel
-- | Some compilers support emitting debug info. Some have different
-- levels. For compilers that do not the level is just capped to the
-- level they do support.
data DebugInfoLevel
NoDebugInfo :: DebugInfoLevel
MinimalDebugInfo :: DebugInfoLevel
NormalDebugInfo :: DebugInfoLevel
MaximalDebugInfo :: DebugInfoLevel
flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
type CompilerFlag = String
languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag]
unsupportedLanguages :: Compiler -> [Language] -> [Language]
-- | For the given compiler, return the flags for the supported extensions.
extensionsToFlags :: Compiler -> [Extension] -> [CompilerFlag]
-- | For the given compiler, return the extensions it does not support.
unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
-- | Does this compiler support parallel --make mode?
parmakeSupported :: Compiler -> Bool
-- | Does this compiler support reexported-modules?
reexportedModulesSupported :: Compiler -> Bool
-- | Does this compiler support thinning/renaming on package flags?
renamingPackageFlagsSupported :: Compiler -> Bool
-- | Does this compiler have unified IPIDs (so no package keys)
unifiedIPIDRequired :: Compiler -> Bool
-- | Does this compiler support package keys?
packageKeySupported :: Compiler -> Bool
-- | Does this compiler support unit IDs?
unitIdSupported :: Compiler -> Bool
-- | Does this compiler support Haskell program coverage?
coverageSupported :: Compiler -> Bool
-- | Does this compiler support profiling?
profilingSupported :: Compiler -> Bool
-- | Is the compiler distributed with profiling dynamic libraries
profilingDynamicSupported :: Compiler -> Maybe Bool
-- | Either profiling dynamic is definitely supported or we don't know (so
-- assume it is)
profilingDynamicSupportedOrUnknown :: Compiler -> Bool
-- | Is the compiler distributed with profiling libraries
profilingVanillaSupported :: Compiler -> Maybe Bool
-- | Either profiling is definitely supported or we don't know (so assume
-- it is)
profilingVanillaSupportedOrUnknown :: Compiler -> Bool
-- | Is the compiler distributed with dynamic libraries
dynamicSupported :: Compiler -> Maybe Bool
-- | Does this compiler support Backpack?
backpackSupported :: Compiler -> Bool
-- | Does this compiler's "ar" command supports response file arguments
-- (i.e. @file-style arguments).
arResponseFilesSupported :: Compiler -> Bool
-- | Does this compiler's "ar" command support llvm-ar's -L flag, which
-- compels the archiver to add an input archive's members rather than
-- adding the archive itself.
arDashLSupported :: Compiler -> Bool
-- | Does this compiler support a package database entry with:
-- "dynamic-library-dirs"?
libraryDynDirSupported :: Compiler -> Bool
-- | Does this compiler support a package database entry with:
-- "visibility"?
libraryVisibilitySupported :: Compiler -> Bool
-- | Does this compiler support the -jsem option?
jsemSupported :: Compiler -> Bool
-- | Some compilers (notably GHC) support profiling and can instrument
-- programs so the system can account costs to different functions. There
-- are different levels of detail that can be used for this accounting.
-- For compilers that do not support this notion or the particular detail
-- levels, this is either ignored or just capped to some similar level
-- they do support.
data ProfDetailLevel
ProfDetailNone :: ProfDetailLevel
ProfDetailDefault :: ProfDetailLevel
ProfDetailExportedFunctions :: ProfDetailLevel
ProfDetailToplevelFunctions :: ProfDetailLevel
ProfDetailAllFunctions :: ProfDetailLevel
ProfDetailTopLate :: ProfDetailLevel
ProfDetailOther :: String -> ProfDetailLevel
knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
flagToProfDetailLevel :: String -> ProfDetailLevel
showProfDetailLevel :: ProfDetailLevel -> String
instance Data.Traversable.Traversable Distribution.Simple.Compiler.PackageDBX
instance Data.Foldable.Foldable Distribution.Simple.Compiler.PackageDBX
instance GHC.Base.Functor Distribution.Simple.Compiler.PackageDBX
instance GHC.Read.Read fp => GHC.Read.Read (Distribution.Simple.Compiler.PackageDBX fp)
instance GHC.Show.Show fp => GHC.Show.Show (Distribution.Simple.Compiler.PackageDBX fp)
instance GHC.Classes.Ord fp => GHC.Classes.Ord (Distribution.Simple.Compiler.PackageDBX fp)
instance GHC.Generics.Generic (Distribution.Simple.Compiler.PackageDBX fp)
instance GHC.Classes.Eq fp => GHC.Classes.Eq (Distribution.Simple.Compiler.PackageDBX fp)
instance GHC.Show.Show Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Read.Read Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Generics.Generic Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Classes.Eq Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Enum.Enum Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Enum.Bounded Distribution.Simple.Compiler.OptimisationLevel
instance GHC.Show.Show Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Read.Read Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Generics.Generic Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Classes.Eq Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Enum.Enum Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Enum.Bounded Distribution.Simple.Compiler.DebugInfoLevel
instance GHC.Read.Read Distribution.Simple.Compiler.Compiler
instance GHC.Show.Show Distribution.Simple.Compiler.Compiler
instance GHC.Generics.Generic Distribution.Simple.Compiler.Compiler
instance GHC.Classes.Eq Distribution.Simple.Compiler.Compiler
instance GHC.Show.Show Distribution.Simple.Compiler.ProfDetailLevel
instance GHC.Read.Read Distribution.Simple.Compiler.ProfDetailLevel
instance GHC.Generics.Generic Distribution.Simple.Compiler.ProfDetailLevel
instance GHC.Classes.Eq Distribution.Simple.Compiler.ProfDetailLevel
instance Data.Binary.Class.Binary Distribution.Simple.Compiler.ProfDetailLevel
instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.ProfDetailLevel
instance Data.Binary.Class.Binary Distribution.Simple.Compiler.Compiler
instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.Compiler
instance Data.Binary.Class.Binary Distribution.Simple.Compiler.DebugInfoLevel
instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.DebugInfoLevel
instance Data.Binary.Class.Binary Distribution.Simple.Compiler.OptimisationLevel
instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.OptimisationLevel
instance Data.Binary.Class.Binary fp => Data.Binary.Class.Binary (Distribution.Simple.Compiler.PackageDBX fp)
instance Distribution.Utils.Structured.Structured fp => Distribution.Utils.Structured.Structured (Distribution.Simple.Compiler.PackageDBX fp)
-- | This module provides an library interface to the hc-pkg
-- program. Currently only GHC and GHCJS have hc-pkg programs.
module Distribution.Simple.Program.HcPkg
-- | Information about the features and capabilities of an hc-pkg
-- program.
data HcPkgInfo
HcPkgInfo :: ConfiguredProgram -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> HcPkgInfo
[hcPkgProgram] :: HcPkgInfo -> ConfiguredProgram
-- | no package DB stack supported
[noPkgDbStack] :: HcPkgInfo -> Bool
-- | hc-pkg does not support verbosity flags
[noVerboseFlag] :: HcPkgInfo -> Bool
-- | use package-conf option instead of package-db
[flagPackageConf] :: HcPkgInfo -> Bool
-- | supports directory style package databases
[supportsDirDbs] :: HcPkgInfo -> Bool
-- | requires directory style package databases
[requiresDirDbs] :: HcPkgInfo -> Bool
-- | supports --enable-multi-instance flag
[nativeMultiInstance] :: HcPkgInfo -> Bool
-- | supports multi-instance via recache
[recacheMultiInstance] :: HcPkgInfo -> Bool
-- | supports --force-files or equivalent
[suppressFilesCheck] :: HcPkgInfo -> Bool
-- | Additional variations in the behaviour for register.
data RegisterOptions
RegisterOptions :: Bool -> Bool -> Bool -> RegisterOptions
-- | Allows re-registering / overwriting an existing package
[registerAllowOverwrite] :: RegisterOptions -> Bool
-- | Insist on the ability to register multiple instances of a single
-- version of a single package. This will fail if the hc-pkg
-- does not support it, see nativeMultiInstance and
-- recacheMultiInstance.
[registerMultiInstance] :: RegisterOptions -> Bool
-- | Require that no checks are performed on the existence of package files
-- mentioned in the registration info. This must be used if registering
-- prior to putting the files in their final place. This will fail if the
-- hc-pkg does not support it, see suppressFilesCheck.
[registerSuppressFilesCheck] :: RegisterOptions -> Bool
-- | Defaults are True, False and False
defaultRegisterOptions :: RegisterOptions
-- | Call hc-pkg to initialise a package database at the location
-- {path}.
--
--
-- hc-pkg init {path}
--
init :: HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
-- | Run hc-pkg using a given package DB stack, directly
-- forwarding the provided command-line arguments to it.
invoke :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> [String] -> IO ()
-- | Call hc-pkg to register a package.
--
--
-- hc-pkg register {filename | -} [--user | --global | --package-db]
--
register :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackS from -> InstalledPackageInfo -> RegisterOptions -> IO ()
-- | Call hc-pkg to unregister a package
--
--
-- hc-pkg unregister [pkgid] [--user | --global | --package-db]
--
unregister :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> IO ()
-- | Call hc-pkg to recache the registered packages.
--
--
-- hc-pkg recache [--user | --global | --package-db]
--
recache :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBS from -> IO ()
-- | Call hc-pkg to expose a package.
--
--
-- hc-pkg expose [pkgid] [--user | --global | --package-db]
--
expose :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> IO ()
-- | Call hc-pkg to hide a package.
--
--
-- hc-pkg hide [pkgid] [--user | --global | --package-db]
--
hide :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> IO ()
-- | Call hc-pkg to get all the details of all the packages in the
-- given package database.
dump :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBX (SymbolicPath from (Dir PkgDB)) -> IO [InstalledPackageInfo]
-- | Call hc-pkg to retrieve a specific package
--
--
-- hc-pkg describe [pkgid] [--user | --global | --package-db]
--
describe :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> PackageId -> IO [InstalledPackageInfo]
-- | Call hc-pkg to get the source package Id of all the packages
-- in the given package database.
--
-- This is much less information than with dump, but also rather
-- quicker. Note in particular that it does not include the
-- UnitId, just the source PackageId which is not
-- necessarily unique in any package db.
list :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> IO [PackageId]
initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
registerInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackS from -> InstalledPackageInfo -> RegisterOptions -> ProgramInvocation
unregisterInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> ProgramInvocation
recacheInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBS from -> ProgramInvocation
exposeInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> ProgramInvocation
hideInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> ProgramInvocation
dumpInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBX (SymbolicPath from (Dir PkgDB)) -> ProgramInvocation
describeInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> PackageId -> ProgramInvocation
listInvocation :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> ProgramInvocation
module Distribution.Simple.Program.GHC
-- | A structured set of GHC options/flags
--
-- Note that options containing lists fall into two categories:
--
--
-- - options that can be safely deduplicated, e.g. input modules or
-- enabled extensions;
-- - options that cannot be deduplicated in general without changing
-- semantics, e.g. extra ghc options or linking options.
--
data GhcOptions
GhcOptions :: Flag GhcMode -> [String] -> [String] -> NubListR (SymbolicPath Pkg File) -> NubListR (SymbolicPath Pkg File) -> NubListR ModuleName -> Flag (SymbolicPath Pkg File) -> Flag FilePath -> Flag Bool -> NubListR (SymbolicPath Pkg (Dir Source)) -> Flag String -> Flag ComponentId -> [(ModuleName, OpenModule)] -> Flag Bool -> PackageDBStack -> NubListR (OpenUnitId, ModuleRenaming) -> Flag Bool -> Flag Bool -> Flag Bool -> [FilePath] -> NubListR (SymbolicPath Pkg (Dir Lib)) -> [String] -> NubListR String -> NubListR (SymbolicPath Pkg (Dir Framework)) -> Flag Bool -> Flag Bool -> Flag Bool -> NubListR FilePath -> [String] -> [String] -> [String] -> [String] -> NubListR (SymbolicPath Pkg (Dir Include)) -> NubListR (SymbolicPath Pkg File) -> NubListR FilePath -> Flag FilePath -> Flag Language -> NubListR Extension -> Map Extension (Maybe CompilerFlag) -> Flag GhcOptimisation -> Flag DebugInfoLevel -> Flag Bool -> Flag GhcProfAuto -> Flag Bool -> Flag Bool -> Flag ParStrat -> Flag (SymbolicPath Pkg (Dir Mix)) -> [FilePath] -> Flag String -> Flag String -> Flag String -> Flag String -> Flag (SymbolicPath Pkg (Dir Artifacts)) -> Flag (SymbolicPath Pkg (Dir Artifacts)) -> Flag (SymbolicPath Pkg (Dir Artifacts)) -> Flag (SymbolicPath Pkg (Dir Artifacts)) -> Flag (SymbolicPath Pkg (Dir Artifacts)) -> Flag GhcDynLinkMode -> Flag Bool -> Flag Bool -> Flag Bool -> Flag String -> NubListR FilePath -> Flag Verbosity -> NubListR (SymbolicPath Pkg (Dir Build)) -> Flag Bool -> GhcOptions
-- | The major mode for the ghc invocation.
[ghcOptMode] :: GhcOptions -> Flag GhcMode
-- | Any extra options to pass directly to ghc. These go at the end and
-- hence override other stuff.
[ghcOptExtra] :: GhcOptions -> [String]
-- | Extra default flags to pass directly to ghc. These go at the beginning
-- and so can be overridden by other stuff.
[ghcOptExtraDefault] :: GhcOptions -> [String]
-- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
[ghcOptInputFiles] :: GhcOptions -> NubListR (SymbolicPath Pkg File)
-- | Script files with irregular extensions that need -x hs.
[ghcOptInputScripts] :: GhcOptions -> NubListR (SymbolicPath Pkg File)
-- | The names of input Haskell modules, mainly for --make mode.
[ghcOptInputModules] :: GhcOptions -> NubListR ModuleName
-- | Location for output file; the ghc -o flag.
[ghcOptOutputFile] :: GhcOptions -> Flag (SymbolicPath Pkg File)
-- | Location for dynamic output file in GhcStaticAndDynamic mode;
-- the ghc -dyno flag.
[ghcOptOutputDynFile] :: GhcOptions -> Flag FilePath
-- | Start with an empty search path for Haskell source files; the ghc
-- -i flag (-i on its own with no path argument).
[ghcOptSourcePathClear] :: GhcOptions -> Flag Bool
-- | Search path for Haskell source files; the ghc -i flag.
[ghcOptSourcePath] :: GhcOptions -> NubListR (SymbolicPath Pkg (Dir Source))
-- | The unit ID the modules will belong to; the ghc -this-unit-id
-- flag (or -this-package-key or -package-name on older
-- versions of GHC). This is a String because we assume you've
-- already figured out what the correct format for this string is (we
-- need to handle backwards compatibility.)
[ghcOptThisUnitId] :: GhcOptions -> Flag String
-- | GHC doesn't make any assumptions about the format of definite unit
-- ids, so when we are instantiating a package it needs to be told
-- explicitly what the component being instantiated is. This only gets
-- set when ghcOptInstantiatedWith is non-empty
[ghcOptThisComponentId] :: GhcOptions -> Flag ComponentId
-- | How the requirements of the package being compiled are to be filled.
-- When typechecking an indefinite package, the OpenModule is
-- always a OpenModuleVar; otherwise, it specifies the installed
-- module that instantiates a package.
[ghcOptInstantiatedWith] :: GhcOptions -> [(ModuleName, OpenModule)]
-- | No code? (But we turn on interface writing
[ghcOptNoCode] :: GhcOptions -> Flag Bool
-- | GHC package databases to use, the ghc -package-conf flag.
[ghcOptPackageDBs] :: GhcOptions -> PackageDBStack
-- | The GHC packages to bring into scope when compiling, the ghc
-- -package-id flags.
[ghcOptPackages] :: GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
-- | Start with a clean package set; the ghc -hide-all-packages
-- flag
[ghcOptHideAllPackages] :: GhcOptions -> Flag Bool
-- | Warn about modules, not listed in command line
[ghcOptWarnMissingHomeModules] :: GhcOptions -> Flag Bool
-- | Don't automatically link in Haskell98 etc; the ghc
-- -no-auto-link-packages flag.
[ghcOptNoAutoLinkPackages] :: GhcOptions -> Flag Bool
-- | Names of libraries to link in; the ghc -l flag.
[ghcOptLinkLibs] :: GhcOptions -> [FilePath]
-- | Search path for libraries to link in; the ghc -L flag.
[ghcOptLinkLibPath] :: GhcOptions -> NubListR (SymbolicPath Pkg (Dir Lib))
-- | Options to pass through to the linker; the ghc -optl flag.
[ghcOptLinkOptions] :: GhcOptions -> [String]
-- | OSX only: frameworks to link in; the ghc -framework flag.
[ghcOptLinkFrameworks] :: GhcOptions -> NubListR String
-- | OSX only: Search path for frameworks to link in; the ghc
-- -framework-path flag.
[ghcOptLinkFrameworkDirs] :: GhcOptions -> NubListR (SymbolicPath Pkg (Dir Framework))
-- | Instruct GHC to link against libHSrts when producing a shared
-- library.
[ghcOptLinkRts] :: GhcOptions -> Flag Bool
-- | Don't do the link step, useful in make mode; the ghc -no-link
-- flag.
[ghcOptNoLink] :: GhcOptions -> Flag Bool
-- | Don't link in the normal RTS main entry point; the ghc
-- -no-hs-main flag.
[ghcOptLinkNoHsMain] :: GhcOptions -> Flag Bool
-- | Module definition files (Windows specific)
[ghcOptLinkModDefFiles] :: GhcOptions -> NubListR FilePath
-- | Options to pass through to the C compiler; the ghc -optc
-- flag.
[ghcOptCcOptions] :: GhcOptions -> [String]
-- | Options to pass through to the C++ compiler.
[ghcOptCxxOptions] :: GhcOptions -> [String]
-- | Options to pass through to the Assembler.
[ghcOptAsmOptions] :: GhcOptions -> [String]
-- | Options to pass through to CPP; the ghc -optP flag.
[ghcOptCppOptions] :: GhcOptions -> [String]
-- | Search path for CPP includes like header files; the ghc -I
-- flag.
[ghcOptCppIncludePath] :: GhcOptions -> NubListR (SymbolicPath Pkg (Dir Include))
-- | Extra header files to include at CPP stage; the ghc
-- -optP-include flag.
[ghcOptCppIncludes] :: GhcOptions -> NubListR (SymbolicPath Pkg File)
-- | Extra header files to include for old-style FFI; the ghc
-- -#include flag.
[ghcOptFfiIncludes] :: GhcOptions -> NubListR FilePath
-- | Program to use for the C and C++ compiler; the ghc -pgmc
-- flag.
[ghcOptCcProgram] :: GhcOptions -> Flag FilePath
-- | The base language; the ghc -XHaskell98 or
-- -XHaskell2010 flag.
[ghcOptLanguage] :: GhcOptions -> Flag Language
-- | The language extensions; the ghc -X flag.
[ghcOptExtensions] :: GhcOptions -> NubListR Extension
-- | A GHC version-dependent mapping of extensions to flags. This must be
-- set to be able to make use of the ghcOptExtensions.
[ghcOptExtensionMap] :: GhcOptions -> Map Extension (Maybe CompilerFlag)
-- | What optimisation level to use; the ghc -O flag.
[ghcOptOptimisation] :: GhcOptions -> Flag GhcOptimisation
-- | Emit debug info; the ghc -g flag.
[ghcOptDebugInfo] :: GhcOptions -> Flag DebugInfoLevel
-- | Compile in profiling mode; the ghc -prof flag.
[ghcOptProfilingMode] :: GhcOptions -> Flag Bool
-- | Automatically add profiling cost centers; the ghc
-- -fprof-auto* flags.
[ghcOptProfilingAuto] :: GhcOptions -> Flag GhcProfAuto
-- | Use the "split sections" feature; the ghc -split-sections
-- flag.
[ghcOptSplitSections] :: GhcOptions -> Flag Bool
-- | Use the "split object files" feature; the ghc -split-objs
-- flag.
[ghcOptSplitObjs] :: GhcOptions -> Flag Bool
-- | Run N jobs simultaneously (if possible).
[ghcOptNumJobs] :: GhcOptions -> Flag ParStrat
-- | Enable coverage analysis; the ghc -fhpc -hpcdir flags.
[ghcOptHPCDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Mix))
-- | Extra GHCi startup scripts; the -ghci-script flag
[ghcOptGHCiScripts] :: GhcOptions -> [FilePath]
[ghcOptHiSuffix] :: GhcOptions -> Flag String
[ghcOptObjSuffix] :: GhcOptions -> Flag String
-- | only in GhcStaticAndDynamic mode
[ghcOptDynHiSuffix] :: GhcOptions -> Flag String
-- | only in GhcStaticAndDynamic mode
[ghcOptDynObjSuffix] :: GhcOptions -> Flag String
[ghcOptHiDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Artifacts))
[ghcOptHieDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Artifacts))
[ghcOptObjDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Artifacts))
[ghcOptOutputDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Artifacts))
[ghcOptStubDir] :: GhcOptions -> Flag (SymbolicPath Pkg (Dir Artifacts))
[ghcOptDynLinkMode] :: GhcOptions -> Flag GhcDynLinkMode
[ghcOptStaticLib] :: GhcOptions -> Flag Bool
[ghcOptShared] :: GhcOptions -> Flag Bool
[ghcOptFPic] :: GhcOptions -> Flag Bool
[ghcOptDylibName] :: GhcOptions -> Flag String
[ghcOptRPaths] :: GhcOptions -> NubListR FilePath
-- | Get GHC to be quiet or verbose with what it's doing; the ghc
-- -v flag.
[ghcOptVerbosity] :: GhcOptions -> Flag Verbosity
-- | Put the extra folders in the PATH environment variable we invoke GHC
-- with
[ghcOptExtraPath] :: GhcOptions -> NubListR (SymbolicPath Pkg (Dir Build))
-- | Let GHC know that it is Cabal that's calling it. Modifies some of the
-- GHC error messages.
[ghcOptCabal] :: GhcOptions -> Flag Bool
data GhcMode
-- |
-- ghc -c
--
GhcModeCompile :: GhcMode
-- |
-- ghc
--
GhcModeLink :: GhcMode
-- |
-- ghc --make
--
GhcModeMake :: GhcMode
-- | ghci / ghc --interactive
GhcModeInteractive :: GhcMode
-- | ghc --abi-hash | GhcModeDepAnalysis -- ^ ghc -M |
-- GhcModeEvaluate -- ^ ghc -e
GhcModeAbiHash :: GhcMode
data GhcOptimisation
-- |
-- -O0
--
GhcNoOptimisation :: GhcOptimisation
-- |
-- -O
--
GhcNormalOptimisation :: GhcOptimisation
-- |
-- -O2
--
GhcMaximumOptimisation :: GhcOptimisation
-- | e.g. -Odph
GhcSpecialOptimisation :: String -> GhcOptimisation
data GhcDynLinkMode
-- |
-- -static
--
GhcStaticOnly :: GhcDynLinkMode
-- |
-- -dynamic
--
GhcDynamicOnly :: GhcDynLinkMode
-- |
-- -static -dynamic-too
--
GhcStaticAndDynamic :: GhcDynLinkMode
data GhcProfAuto
-- |
-- -fprof-auto
--
GhcProfAutoAll :: GhcProfAuto
-- |
-- -fprof-auto-top
--
GhcProfAutoToplevel :: GhcProfAuto
-- |
-- -fprof-auto-exported
--
GhcProfAutoExported :: GhcProfAuto
-- | @-fprof-late
GhcProfLate :: GhcProfAuto
ghcInvocation :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> Maybe (SymbolicPath CWD (Dir Pkg)) -> GhcOptions -> IO ProgramInvocation
renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String]
runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> Maybe (SymbolicPath CWD (Dir Pkg)) -> GhcOptions -> IO ()
-- | GHC >= 7.6 uses the '-package-db' flag. See
-- https://gitlab.haskell.org/ghc/ghc/-/issues/5977.
packageDbArgsDb :: PackageDBStackCWD -> [String]
normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String]
instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcMode
instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcMode
instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcOptimisation
instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptimisation
instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcDynLinkMode
instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcDynLinkMode
instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcProfAuto
instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcProfAuto
instance GHC.Generics.Generic Distribution.Simple.Program.GHC.GhcOptions
instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptions
instance GHC.Base.Monoid Distribution.Simple.Program.GHC.GhcOptions
instance GHC.Base.Semigroup Distribution.Simple.Program.GHC.GhcOptions
-- | The module defines all the known built-in Programs.
--
-- Where possible we try to find their version numbers.
module Distribution.Simple.Program.Builtin
-- | The default list of programs. These programs are typically used
-- internally to Cabal.
builtinPrograms :: [Program]
ghcProgram :: Program
ghcPkgProgram :: Program
runghcProgram :: Program
ghcjsProgram :: Program
ghcjsPkgProgram :: Program
hmakeProgram :: Program
jhcProgram :: Program
haskellSuiteProgram :: Program
haskellSuitePkgProgram :: Program
uhcProgram :: Program
gccProgram :: Program
arProgram :: Program
stripProgram :: Program
happyProgram :: Program
alexProgram :: Program
hsc2hsProgram :: Program
c2hsProgram :: Program
cpphsProgram :: Program
hscolourProgram :: Program
doctestProgram :: Program
haddockProgram :: Program
greencardProgram :: Program
ldProgram :: Program
tarProgram :: Program
cppProgram :: Program
pkgConfigProgram :: Program
hpcProgram :: Program
-- | This provides a ProgramDb type which holds configured and
-- not-yet configured programs. It is the parameter to lots of actions
-- elsewhere in Cabal that need to look up and run programs. If we had a
-- Cabal monad, the ProgramDb would probably be a reader or state
-- component of it.
--
-- One nice thing about using it is that any program that is registered
-- with Cabal will get some "configure" and ".cabal" helpers like
-- --with-foo-args --foo-path= and extra-foo-args.
--
-- There's also a hook for adding programs in a Setup.lhs script. See
-- hookedPrograms in UserHooks. This gives a hook user the ability
-- to get the above flags and such so that they don't have to write all
-- the PATH logic inside Setup.lhs.
module Distribution.Simple.Program.Db
-- | The configuration is a collection of information about programs. It
-- contains information both about configured programs and also about
-- programs that we are yet to configure.
--
-- The idea is that we start from a collection of unconfigured programs
-- and one by one we try to configure them at which point we move them
-- into the configured collection. For unconfigured programs we record
-- not just the Program but also any user-provided arguments and
-- location for the program.
data ProgramDb
ProgramDb :: UnconfiguredProgs -> ProgramSearchPath -> [(String, Maybe String)] -> ConfiguredProgs -> ProgramDb
[unconfiguredProgs] :: ProgramDb -> UnconfiguredProgs
[progSearchPath] :: ProgramDb -> ProgramSearchPath
[progOverrideEnv] :: ProgramDb -> [(String, Maybe String)]
[configuredProgs] :: ProgramDb -> ConfiguredProgs
emptyProgramDb :: ProgramDb
defaultProgramDb :: ProgramDb
-- | The Read/Show and Binary instances do not
-- preserve all the unconfigured Programs because Program
-- is not in Read/Show because it contains functions. So to
-- fully restore a deserialised ProgramDb use this function to add
-- back all the known Programs.
--
--
-- - It does not add the default programs, but you probably want them,
-- use builtinPrograms in addition to any extra you might
-- need.
--
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
-- | Add a known program that we may configure later
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
-- | Modify the current ProgramSearchPath used by the
-- ProgramDb by prepending the provided extra paths.
--
--
-- - Logs the added paths in info verbosity.
-- - Prepends environment variable overrides.
--
prependProgramSearchPath :: Verbosity -> [FilePath] -> [(String, Maybe FilePath)] -> ProgramDb -> IO ProgramDb
prependProgramSearchPathNoLogging :: [FilePath] -> [(String, Maybe String)] -> ProgramDb -> ProgramDb
lookupKnownProgram :: String -> ProgramDb -> Maybe Program
knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)]
-- | Get the current ProgramSearchPath used by the ProgramDb.
-- This is the default list of locations where programs are looked for
-- when configuring them. This can be overridden for specific programs
-- (with userSpecifyPath), and specific known programs can modify
-- or ignore this search path in their own configuration code.
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
-- | Change the current ProgramSearchPath used by the
-- ProgramDb. This will affect programs that are configured from
-- here on, so you should usually set it before configuring any programs.
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
-- | Modify the current ProgramSearchPath used by the
-- ProgramDb. This will affect programs that are configured from
-- here on, so you should usually modify it before configuring any
-- programs.
modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
-- | User-specify this path. Basically override any path information for
-- this program in the configuration. If it's not a known program ignore
-- it.
userSpecifyPath :: String -> FilePath -> ProgramDb -> ProgramDb
-- | Like userSpecifyPath but for a list of progs and their paths.
userSpecifyPaths :: [(String, FilePath)] -> ProgramDb -> ProgramDb
userMaybeSpecifyPath :: String -> Maybe FilePath -> ProgramDb -> ProgramDb
-- | User-specify the arguments for this program. Basically override any
-- args information for this program in the configuration. If it's not a
-- known program, ignore it..
userSpecifyArgs :: String -> [ProgArg] -> ProgramDb -> ProgramDb
-- | Like userSpecifyPath but for a list of progs and their args.
userSpecifyArgss :: [(String, [ProgArg])] -> ProgramDb -> ProgramDb
-- | Get any extra args that have been previously specified for a program.
userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]
-- | Try to find a configured program
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
-- | Try to find a configured program
lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram
-- | Update a configured program in the database.
updateProgram :: ConfiguredProgram -> ProgramDb -> ProgramDb
-- | List all configured programs.
configuredPrograms :: ProgramDb -> [ConfiguredProgram]
-- | Try to configure a specific program and add it to the program
-- database.
--
-- If the program is already included in the collection of unconfigured
-- programs, then we use any user-supplied location and arguments. If the
-- program gets configured successfully, it gets added to the configured
-- collection.
--
-- Note that it is not a failure if the program cannot be configured.
-- It's only a failure if the user supplied a location and the program
-- could not be found at that location.
--
-- The reason for it not being a failure at this stage is that we don't
-- know up front all the programs we will need, so we try to configure
-- them all. To verify that a program was actually successfully
-- configured use requireProgram.
configureProgram :: Verbosity -> Program -> ProgramDb -> IO ProgramDb
-- | Try to configure a specific program. If the program is already
-- included in the collection of unconfigured programs then we use any
-- user-supplied location and arguments.
configureUnconfiguredProgram :: Verbosity -> Program -> ProgramDb -> IO (Maybe ConfiguredProgram)
-- | Try to configure all the known programs that have not yet been
-- configured.
configureAllKnownPrograms :: Verbosity -> ProgramDb -> IO ProgramDb
-- | Unconfigure a program. This is basically a hack and you shouldn't use
-- it, but it can be handy for making sure a requireProgram
-- actually reconfigures.
unconfigureProgram :: String -> ProgramDb -> ProgramDb
-- | Check that a program is configured and available to be run.
--
-- Additionally check that the program version number is suitable and
-- return it. For example you could require AnyVersion or
-- orLaterVersion (Version [1,0] [])
--
-- It returns the configured program, its version number and a possibly
-- updated ProgramDb. If the program could not be configured or
-- the version is unsuitable, it returns an error value.
lookupProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (Either CabalException (ConfiguredProgram, Version, ProgramDb))
-- | reconfigure a bunch of programs given new user-specified args. It
-- takes the same inputs as userSpecifyPath and
-- userSpecifyArgs and for all progs with a new path it calls
-- configureProgram.
reconfigurePrograms :: Verbosity -> [(String, FilePath)] -> [(String, [ProgArg])] -> ProgramDb -> IO ProgramDb
-- | Check that a program is configured and available to be run.
--
-- It raises an exception if the program could not be configured,
-- otherwise it returns the configured program.
requireProgram :: Verbosity -> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
-- | Like lookupProgramVersion, but raises an exception in case of
-- error instead of returning 'Left errMsg'.
requireProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (ConfiguredProgram, Version, ProgramDb)
-- | Check that a program is configured and available to be run.
--
-- It returns Nothing if the program couldn't be configured, or is
-- not found.
needProgram :: Verbosity -> Program -> ProgramDb -> IO (Maybe (ConfiguredProgram, ProgramDb))
type UnconfiguredProgs = Map String UnconfiguredProgram
type ConfiguredProgs = Map String ConfiguredProgram
updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs) -> ProgramDb -> ProgramDb
updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs) -> ProgramDb -> ProgramDb
instance GHC.Show.Show Distribution.Simple.Program.Db.ProgramDb
instance GHC.Read.Read Distribution.Simple.Program.Db.ProgramDb
instance Data.Binary.Class.Binary Distribution.Simple.Program.Db.ProgramDb
instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Db.ProgramDb
-- | This provides an abstraction which deals with configuring and running
-- programs. A Program is a static notion of a known program. A
-- ConfiguredProgram is a Program that has been found on
-- the current machine and is ready to be run (possibly with some
-- user-supplied default args). Configuring a program involves finding
-- its location and if necessary finding its version. There is also a
-- ProgramDb type which holds configured and not-yet configured
-- programs. It is the parameter to lots of actions elsewhere in Cabal
-- that need to look up and run programs. If we had a Cabal monad, the
-- ProgramDb would probably be a reader or state component of it.
--
-- The module also defines all the known built-in Programs and the
-- defaultProgramDb which contains them all.
--
-- One nice thing about using it is that any program that is registered
-- with Cabal will get some "configure" and ".cabal" helpers like
-- --with-foo-args --foo-path= and extra-foo-args.
--
-- There's also good default behavior for trying to find "foo" in PATH,
-- being able to override its location, etc.
--
-- There's also a hook for adding programs in a Setup.lhs script. See
-- hookedPrograms in UserHooks. This gives a hook user the ability
-- to get the above flags and such so that they don't have to write all
-- the PATH logic inside Setup.lhs.
module Distribution.Simple.Program
-- | Represents a program which can be configured.
--
-- Note: rather than constructing this directly, start with
-- simpleProgram and override any extra fields.
data Program
Program :: String -> (Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))) -> (Verbosity -> FilePath -> IO (Maybe Version)) -> (Verbosity -> ConfiguredProgram -> IO ConfiguredProgram) -> (Maybe Version -> PackageDescription -> [String] -> [String]) -> Program
-- | The simple name of the program, eg. ghc
[programName] :: Program -> String
-- | A function to search for the program if its location was not specified
-- by the user. Usually this will just be a call to
-- findProgramOnSearchPath.
--
-- It is supplied with the prevailing search path which will typically
-- just be used as-is, but can be extended or ignored as needed.
--
-- For the purpose of change monitoring, in addition to the location
-- where the program was found, it returns all the other places that were
-- tried.
[programFindLocation] :: Program -> Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
-- | Try to find the version of the program. For many programs this is not
-- possible or is not necessary so it's OK to return Nothing.
[programFindVersion] :: Program -> Verbosity -> FilePath -> IO (Maybe Version)
-- | A function to do any additional configuration after we have located
-- the program (and perhaps identified its version). For example it could
-- add args, or environment vars.
[programPostConf] :: Program -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
-- | A function that filters any arguments that don't impact the output
-- from a commandline. Used to limit the volatility of dependency hashes
-- when using new-build.
[programNormaliseArgs] :: Program -> Maybe Version -> PackageDescription -> [String] -> [String]
-- | A search path to use when locating executables. This is analogous to
-- the unix $PATH or win32 %PATH% but with the ability
-- to use the system default method for finding executables
-- (findExecutable which on unix is simply looking on the
-- $PATH but on win32 is a bit more complicated).
--
-- The default to use is [ProgSearchPathDefault] but you can add
-- extra dirs either before, after or instead of the default, e.g. here
-- we add an extra dir to search after the usual ones.
--
--
-- ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
--
--
-- We also use this path to set the environment when running child
-- processes.
--
-- The ProgramDb is created with a ProgramSearchPath to
-- which we prependProgramSearchPath to add the ones that come
-- from cli flags and from configurations. Then each of the programs that
-- are configured in the db inherits the same path as part of
-- configureProgram.
type ProgramSearchPath = [ProgramSearchPathEntry]
data ProgramSearchPathEntry
-- | A specific dir
ProgramSearchPathDir :: FilePath -> ProgramSearchPathEntry
-- | The system default
ProgramSearchPathDefault :: ProgramSearchPathEntry
-- | Make a simple named program.
--
-- By default we'll just search for it in the path and not try to find
-- the version name. You can override these behaviours if necessary, eg:
--
--
-- (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
--
simpleProgram :: String -> Program
findProgramOnSearchPath :: Verbosity -> ProgramSearchPath -> FilePath -> IO (Maybe (FilePath, [FilePath]))
defaultProgramSearchPath :: ProgramSearchPath
-- | Look for a program and try to find it's version number. It can accept
-- either an absolute path or the name of a program binary, in which case
-- we will look for the program on the path.
findProgramVersion :: String -> (String -> String) -> Verbosity -> FilePath -> IO (Maybe Version)
-- | Represents a program which has been configured and is thus ready to be
-- run.
--
-- These are usually made by configuring a Program, but if you
-- have to construct one directly then start with
-- simpleConfiguredProgram and override any extra fields.
data ConfiguredProgram
ConfiguredProgram :: String -> Maybe Version -> [String] -> [String] -> [(String, Maybe String)] -> Map String String -> ProgramLocation -> [FilePath] -> ConfiguredProgram
-- | Just the name again
[programId] :: ConfiguredProgram -> String
-- | The version of this program, if it is known.
[programVersion] :: ConfiguredProgram -> Maybe Version
-- | Default command-line args for this program. These flags will appear
-- first on the command line, so they can be overridden by subsequent
-- flags.
[programDefaultArgs] :: ConfiguredProgram -> [String]
-- | Override command-line args for this program. These flags will appear
-- last on the command line, so they override all earlier flags.
[programOverrideArgs] :: ConfiguredProgram -> [String]
-- | Override environment variables for this program. These env vars will
-- extend/override the prevailing environment of the current to form the
-- environment for the new process.
[programOverrideEnv] :: ConfiguredProgram -> [(String, Maybe String)]
-- | A key-value map listing various properties of the program, useful for
-- feature detection. Populated during the configuration step, key names
-- depend on the specific program.
[programProperties] :: ConfiguredProgram -> Map String String
-- | Location of the program. eg. /usr/bin/ghc-6.4
[programLocation] :: ConfiguredProgram -> ProgramLocation
-- | In addition to the programLocation where the program was found,
-- these are additional locations that were looked at. The combination of
-- ths found location and these not-found locations can be used to
-- monitor to detect when the re-configuring the program might give a
-- different result (e.g. found in a different location).
[programMonitorFiles] :: ConfiguredProgram -> [FilePath]
-- | The full path of a configured program.
programPath :: ConfiguredProgram -> FilePath
type ProgArg = String
-- | Where a program was found. Also tells us whether it's specified by
-- user or not. This includes not just the path, but the program as well.
data ProgramLocation
-- | The user gave the path to this program, eg.
-- --ghc-path=/usr/bin/ghc-6.6
UserSpecified :: FilePath -> ProgramLocation
[locationPath] :: ProgramLocation -> FilePath
-- | The program was found automatically.
FoundOnSystem :: FilePath -> ProgramLocation
[locationPath] :: ProgramLocation -> FilePath
-- | Runs the given configured program.
runProgram :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()
-- | Runs the given configured program.
runProgramCwd :: Verbosity -> Maybe (SymbolicPath CWD (Dir to)) -> ConfiguredProgram -> [ProgArg] -> IO ()
-- | Runs the given configured program and gets the output.
getProgramOutput :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO String
-- | Suppress any extra arguments added by the user.
suppressOverrideArgs :: ConfiguredProgram -> ConfiguredProgram
-- | Represents a specific invocation of a specific program.
--
-- This is used as an intermediate type between deciding how to call a
-- program and actually doing it. This provides the opportunity to the
-- caller to adjust how the program will be called. These invocations can
-- either be run directly or turned into shell or batch scripts.
data ProgramInvocation
ProgramInvocation :: FilePath -> [String] -> [(String, Maybe String)] -> Maybe FilePath -> Maybe IOData -> IOEncoding -> IOEncoding -> ProgramInvocation
[progInvokePath] :: ProgramInvocation -> FilePath
[progInvokeArgs] :: ProgramInvocation -> [String]
[progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)]
[progInvokeCwd] :: ProgramInvocation -> Maybe FilePath
[progInvokeInput] :: ProgramInvocation -> Maybe IOData
-- | TODO: remove this, make user decide when constructing
-- progInvokeInput.
[progInvokeInputEncoding] :: ProgramInvocation -> IOEncoding
[progInvokeOutputEncoding] :: ProgramInvocation -> IOEncoding
emptyProgramInvocation :: ProgramInvocation
simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation
programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()
getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String
getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString
-- | The default list of programs. These programs are typically used
-- internally to Cabal.
builtinPrograms :: [Program]
-- | The configuration is a collection of information about programs. It
-- contains information both about configured programs and also about
-- programs that we are yet to configure.
--
-- The idea is that we start from a collection of unconfigured programs
-- and one by one we try to configure them at which point we move them
-- into the configured collection. For unconfigured programs we record
-- not just the Program but also any user-provided arguments and
-- location for the program.
data ProgramDb
defaultProgramDb :: ProgramDb
emptyProgramDb :: ProgramDb
-- | The Read/Show and Binary instances do not
-- preserve all the unconfigured Programs because Program
-- is not in Read/Show because it contains functions. So to
-- fully restore a deserialised ProgramDb use this function to add
-- back all the known Programs.
--
--
-- - It does not add the default programs, but you probably want them,
-- use builtinPrograms in addition to any extra you might
-- need.
--
restoreProgramDb :: [Program] -> ProgramDb -> ProgramDb
-- | Add a known program that we may configure later
addKnownProgram :: Program -> ProgramDb -> ProgramDb
addKnownPrograms :: [Program] -> ProgramDb -> ProgramDb
lookupKnownProgram :: String -> ProgramDb -> Maybe Program
knownPrograms :: ProgramDb -> [(Program, Maybe ConfiguredProgram)]
-- | Get the current ProgramSearchPath used by the ProgramDb.
-- This is the default list of locations where programs are looked for
-- when configuring them. This can be overridden for specific programs
-- (with userSpecifyPath), and specific known programs can modify
-- or ignore this search path in their own configuration code.
getProgramSearchPath :: ProgramDb -> ProgramSearchPath
-- | Change the current ProgramSearchPath used by the
-- ProgramDb. This will affect programs that are configured from
-- here on, so you should usually set it before configuring any programs.
setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
-- | User-specify this path. Basically override any path information for
-- this program in the configuration. If it's not a known program ignore
-- it.
userSpecifyPath :: String -> FilePath -> ProgramDb -> ProgramDb
-- | Like userSpecifyPath but for a list of progs and their paths.
userSpecifyPaths :: [(String, FilePath)] -> ProgramDb -> ProgramDb
userMaybeSpecifyPath :: String -> Maybe FilePath -> ProgramDb -> ProgramDb
-- | User-specify the arguments for this program. Basically override any
-- args information for this program in the configuration. If it's not a
-- known program, ignore it..
userSpecifyArgs :: String -> [ProgArg] -> ProgramDb -> ProgramDb
-- | Like userSpecifyPath but for a list of progs and their args.
userSpecifyArgss :: [(String, [ProgArg])] -> ProgramDb -> ProgramDb
-- | Get any extra args that have been previously specified for a program.
userSpecifiedArgs :: Program -> ProgramDb -> [ProgArg]
-- | Try to find a configured program
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
-- | Check that a program is configured and available to be run.
--
-- Additionally check that the program version number is suitable and
-- return it. For example you could require AnyVersion or
-- orLaterVersion (Version [1,0] [])
--
-- It returns the configured program, its version number and a possibly
-- updated ProgramDb. If the program could not be configured or
-- the version is unsuitable, it returns an error value.
lookupProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (Either CabalException (ConfiguredProgram, Version, ProgramDb))
-- | Update a configured program in the database.
updateProgram :: ConfiguredProgram -> ProgramDb -> ProgramDb
-- | Try to configure a specific program and add it to the program
-- database.
--
-- If the program is already included in the collection of unconfigured
-- programs, then we use any user-supplied location and arguments. If the
-- program gets configured successfully, it gets added to the configured
-- collection.
--
-- Note that it is not a failure if the program cannot be configured.
-- It's only a failure if the user supplied a location and the program
-- could not be found at that location.
--
-- The reason for it not being a failure at this stage is that we don't
-- know up front all the programs we will need, so we try to configure
-- them all. To verify that a program was actually successfully
-- configured use requireProgram.
configureProgram :: Verbosity -> Program -> ProgramDb -> IO ProgramDb
-- | Try to configure all the known programs that have not yet been
-- configured.
configureAllKnownPrograms :: Verbosity -> ProgramDb -> IO ProgramDb
-- | reconfigure a bunch of programs given new user-specified args. It
-- takes the same inputs as userSpecifyPath and
-- userSpecifyArgs and for all progs with a new path it calls
-- configureProgram.
reconfigurePrograms :: Verbosity -> [(String, FilePath)] -> [(String, [ProgArg])] -> ProgramDb -> IO ProgramDb
-- | Check that a program is configured and available to be run.
--
-- It raises an exception if the program could not be configured,
-- otherwise it returns the configured program.
requireProgram :: Verbosity -> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
-- | Like lookupProgramVersion, but raises an exception in case of
-- error instead of returning 'Left errMsg'.
requireProgramVersion :: Verbosity -> Program -> VersionRange -> ProgramDb -> IO (ConfiguredProgram, Version, ProgramDb)
-- | Check that a program is configured and available to be run.
--
-- It returns Nothing if the program couldn't be configured, or is
-- not found.
needProgram :: Verbosity -> Program -> ProgramDb -> IO (Maybe (ConfiguredProgram, ProgramDb))
-- | Looks up the given program in the program database and runs it.
runDbProgram :: Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO ()
-- | Looks up the given program in the program database and runs it.
runDbProgramCwd :: Verbosity -> Maybe (SymbolicPath CWD (Dir to)) -> Program -> ProgramDb -> [ProgArg] -> IO ()
-- | Looks up the given program in the program database and runs it.
getDbProgramOutput :: Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO String
-- | Looks up the given program in the program database and runs it.
getDbProgramOutputCwd :: Verbosity -> Maybe (SymbolicPath CWD (Dir to)) -> Program -> ProgramDb -> [ProgArg] -> IO String
ghcProgram :: Program
ghcPkgProgram :: Program
ghcjsProgram :: Program
ghcjsPkgProgram :: Program
hmakeProgram :: Program
jhcProgram :: Program
uhcProgram :: Program
gccProgram :: Program
arProgram :: Program
stripProgram :: Program
happyProgram :: Program
alexProgram :: Program
hsc2hsProgram :: Program
c2hsProgram :: Program
cpphsProgram :: Program
hscolourProgram :: Program
doctestProgram :: Program
haddockProgram :: Program
greencardProgram :: Program
ldProgram :: Program
tarProgram :: Program
cppProgram :: Program
pkgConfigProgram :: Program
hpcProgram :: Program
-- | This module provides an library interface to the strip
-- program.
module Distribution.Simple.Program.Strip
stripLib :: Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
stripExe :: Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
-- | This is to do with command line handling. The Cabal command line is
-- organised into a number of named sub-commands (much like darcs). The
-- CommandUI abstraction represents one of these sub-commands,
-- with a name, description, a set of flags. Commands can be associated
-- with actions and run. It handles some common stuff automatically, like
-- the --help and command line completion flags. It is designed
-- to allow other tools make derived commands. This feature is used
-- heavily in cabal-install.
module Distribution.Simple.Command
data CommandUI flags
CommandUI :: String -> String -> (String -> String) -> Maybe (String -> String) -> Maybe (String -> String) -> flags -> (ShowOrParseArgs -> [OptionField flags]) -> CommandUI flags
-- | The name of the command as it would be entered on the command line.
-- For example "build".
[commandName] :: CommandUI flags -> String
-- | A short, one line description of the command to use in help texts.
[commandSynopsis] :: CommandUI flags -> String
-- | A function that maps a program name to a usage summary for this
-- command.
[commandUsage] :: CommandUI flags -> String -> String
-- | Additional explanation of the command to use in help texts.
[commandDescription] :: CommandUI flags -> Maybe (String -> String)
-- | Post-Usage notes and examples in help texts
[commandNotes] :: CommandUI flags -> Maybe (String -> String)
-- | Initial / empty flags
[commandDefaultFlags] :: CommandUI flags -> flags
-- | All the Option fields for this command
[commandOptions] :: CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
-- | Show flags in the standard long option command line format
commandShowOptions :: CommandUI flags -> flags -> [String]
data CommandParse flags
CommandHelp :: (String -> String) -> CommandParse flags
CommandList :: [String] -> CommandParse flags
CommandErrors :: [String] -> CommandParse flags
CommandReadyToGo :: flags -> CommandParse flags
-- | Parse a bunch of command line arguments
commandParseArgs :: CommandUI flags -> Bool -> [String] -> CommandParse (flags -> flags, [String])
-- | Helper function for creating globalCommand description
getNormalCommandDescriptions :: [Command action] -> [(String, String)]
helpCommandUI :: CommandUI ()
data ShowOrParseArgs
ShowArgs :: ShowOrParseArgs
ParseArgs :: ShowOrParseArgs
-- | Default "usage" documentation text for commands.
usageDefault :: String -> String -> String
-- | Create "usage" documentation from a list of parameter configurations.
usageAlternatives :: String -> [String] -> String -> String
-- | Make a Command from standard GetOpt options.
mkCommandUI :: String -> String -> [String] -> flags -> (ShowOrParseArgs -> [OptionField flags]) -> CommandUI flags
-- | Mark command as hidden. Hidden commands don't show up in the 'progname
-- help' or 'progname --help' output.
hiddenCommand :: Command action -> Command action
data Command action
commandAddAction :: CommandUI flags -> (flags -> [String] -> action) -> Command action
-- | Utility function, many commands do not accept additional flags. This
-- action fails with a helpful error message if the user supplies any
-- extra.
noExtraFlags :: [String] -> IO ()
data CommandType
NormalCommand :: CommandType
HiddenCommand :: CommandType
-- | wraps a CommandUI together with a function that turns it into
-- a Command. By hiding the type of flags for the UI allows
-- construction of a list of all UIs at the top level of the program.
-- That list can then be used for generation of manual page as well as
-- for executing the selected command.
data CommandSpec action
CommandSpec :: CommandUI flags -> (CommandUI flags -> Command action) -> CommandType -> CommandSpec action
commandFromSpec :: CommandSpec a -> Command a
commandsRun :: CommandUI a -> [Command action] -> [String] -> IO (CommandParse (a, CommandParse action))
commandsRunWithFallback :: CommandUI a -> [Command action] -> ([Command action] -> String -> [String] -> IO (CommandParse action)) -> [String] -> IO (CommandParse (a, CommandParse action))
defaultCommandFallback :: [Command action] -> String -> [String] -> IO (CommandParse action)
-- | We usually have a data type for storing configuration values, where
-- every field stores a configuration option, and the user sets the value
-- either via command line flags or a configuration file. An individual
-- OptionField models such a field, and we usually build a list of
-- options associated to a configuration data type.
data OptionField a
OptionField :: Name -> [OptDescr a] -> OptionField a
[optionName] :: OptionField a -> Name
[optionDescr] :: OptionField a -> [OptDescr a]
type Name = String
-- | Create an option taking a single OptDescr. No explicit Name is given
-- for the Option, the name is the first LFlag given.
--
-- Example: option sf lf d get set * sf: Short
-- option name, for example: ['d']. No hyphen permitted. *
-- lf: Long option name, for example: ["debug"]. No
-- hyphens permitted. * d: Description of the option, shown to
-- the user in help messages. * get: Get the current value of
-- the flag. * set: Set the value of the flag. Gets the current
-- value of the flag as a parameter.
option :: SFlags -> LFlags -> Description -> get -> set -> MkOptDescr get set a -> OptionField a
-- | Create an option taking several OptDescrs. You will have to give the
-- flags and description individually to the OptDescr constructor.
multiOption :: Name -> get -> set -> [get -> set -> OptDescr a] -> OptionField a
liftOption :: (b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
liftOptionL :: ALens' b a -> OptionField a -> OptionField b
-- | An OptionField takes one or more OptDescrs, describing the command
-- line interface for the field.
data OptDescr a
ReqArg :: Description -> OptFlags -> ArgPlaceHolder -> ReadE (a -> a) -> (a -> [String]) -> OptDescr a
OptArg :: Description -> OptFlags -> ArgPlaceHolder -> ReadE (a -> a) -> (String, a -> a) -> (a -> [Maybe String]) -> OptDescr a
ChoiceOpt :: [(Description, OptFlags, a -> a, a -> Bool)] -> OptDescr a
BoolOpt :: Description -> OptFlags -> OptFlags -> (Bool -> a -> a) -> (a -> Maybe Bool) -> OptDescr a
fmapOptDescr :: forall a b. (b -> a) -> (a -> b -> b) -> OptDescr a -> OptDescr b
type Description = String
-- | Short command line option strings
type SFlags = [Char]
-- | Long command line option strings
type LFlags = [String]
type OptFlags = (SFlags, LFlags)
type ArgPlaceHolder = String
type MkOptDescr get set a = SFlags -> LFlags -> Description -> get -> set -> OptDescr a
-- | Create a string-valued command line interface. Usually called in the
-- context of option or multiOption.
--
-- Example: reqArg ad mkflag showflag
--
--
-- - ad: Placeholder shown to the user, e.g.
-- FILES if files are expected parameters.
-- - mkflag: How to parse the argument into the option.
-- - showflag: If parsing goes wrong, display a useful error
-- message to the user.
--
reqArg :: Monoid b => ArgPlaceHolder -> ReadE b -> (b -> [String]) -> MkOptDescr (a -> b) (b -> a -> a) a
-- | (String -> a) variant of "reqArg"
reqArg' :: Monoid b => ArgPlaceHolder -> (String -> b) -> (b -> [String]) -> MkOptDescr (a -> b) (b -> a -> a) a
-- | Create a string-valued command line interface with a default value.
optArg :: Monoid b => ArgPlaceHolder -> ReadE b -> (String, b) -> (b -> [Maybe String]) -> MkOptDescr (a -> b) (b -> a -> a) a
-- | (String -> a) variant of "optArg"
optArg' :: Monoid b => ArgPlaceHolder -> (Maybe String -> b) -> (b -> [Maybe String]) -> MkOptDescr (a -> b) (b -> a -> a) a
optArgDef' :: Monoid b => ArgPlaceHolder -> (String, Maybe String -> b) -> (b -> [Maybe String]) -> MkOptDescr (a -> b) (b -> a -> a) a
noArg :: Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt :: (b -> Maybe Bool) -> (Bool -> b) -> SFlags -> SFlags -> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt' :: (b -> Maybe Bool) -> (Bool -> b) -> OptFlags -> OptFlags -> MkOptDescr (a -> b) (b -> a -> a) a
-- | create a Choice option
choiceOpt :: Eq b => [(b, OptFlags, Description)] -> MkOptDescr (a -> b) (b -> a -> a) a
-- | create a Choice option out of an enumeration type. As long flags, the
-- Show output is used. As short flags, the first character which does
-- not conflict with a previous one is used.
choiceOptFromEnum :: (Bounded b, Enum b, Show b, Eq b) => MkOptDescr (a -> b) (b -> a -> a) a
instance GHC.Base.Functor Distribution.Simple.Command.CommandParse
module Distribution.Types.LocalBuildConfig
-- | PackageBuildDescr contains the information Cabal determines
-- after performing package-wide configuration of a package, before doing
-- any per-component configuration.
data PackageBuildDescr
PackageBuildDescr :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> Compiler -> Platform -> Maybe (SymbolicPath Pkg File) -> PackageDescription -> InstallDirTemplates -> PackageDBStack -> [UnitId] -> PackageBuildDescr
-- | Options passed to the configuration step. Needed to re-run
-- configuration when .cabal is out of date
[$sel:configFlags:PackageBuildDescr] :: PackageBuildDescr -> ConfigFlags
-- | The final set of flags which were picked for this package
[$sel:flagAssignment:PackageBuildDescr] :: PackageBuildDescr -> FlagAssignment
-- | What components were enabled during configuration, and why.
[$sel:componentEnabledSpec:PackageBuildDescr] :: PackageBuildDescr -> ComponentRequestedSpec
-- | The compiler we're building with
[$sel:compiler:PackageBuildDescr] :: PackageBuildDescr -> Compiler
-- | The platform we're building for
[$sel:hostPlatform:PackageBuildDescr] :: PackageBuildDescr -> Platform
-- | the filename containing the .cabal file, if available
[$sel:pkgDescrFile:PackageBuildDescr] :: PackageBuildDescr -> Maybe (SymbolicPath Pkg File)
-- | WARNING WARNING WARNING Be VERY careful about using this function; we
-- haven't deprecated it but using it could introduce subtle bugs related
-- to HookedBuildInfo.
--
-- In principle, this is supposed to contain the resolved package
-- description, that does not contain any conditionals. However, it MAY
-- NOT contain the description with a HookedBuildInfo applied to
-- it; see HookedBuildInfo for the whole sordid saga. As much as
-- possible, Cabal library should avoid using this parameter.
[$sel:localPkgDescr:PackageBuildDescr] :: PackageBuildDescr -> PackageDescription
-- | The installation directories for the various different kinds of files
-- TODO: inplaceDirTemplates :: InstallDirs FilePath
[$sel:installDirTemplates:PackageBuildDescr] :: PackageBuildDescr -> InstallDirTemplates
-- | What package database to use, global/user
[$sel:withPackageDB:PackageBuildDescr] :: PackageBuildDescr -> PackageDBStack
-- | For per-package builds-only: an extra list of libraries to be included
-- in the hpc coverage report for testsuites run with
-- --enable-coverage. Notably, this list must exclude indefinite
-- libraries and instantiations because HPC does not support backpack
-- (Nov. 2023).
[$sel:extraCoverageFor:PackageBuildDescr] :: PackageBuildDescr -> [UnitId]
-- | Information about individual components in a package, determined after
-- the configure step.
data ComponentBuildDescr
ComponentBuildDescr :: Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> Map (PackageName, ComponentName) PromisedComponent -> InstalledPackageIndex -> ComponentBuildDescr
-- | All the components to build, ordered by topological sort, and with
-- their INTERNAL dependencies over the intrapackage dependency graph.
-- TODO: this is assumed to be short; otherwise we want some sort of
-- ordered map.
[$sel:componentGraph:ComponentBuildDescr] :: ComponentBuildDescr -> Graph ComponentLocalBuildInfo
-- | A map from component name to all matching components. These coincide
-- with $sel:componentGraph:ComponentBuildDescr There may be more
-- than one matching component because of backpack instantiations
[$sel:componentNameMap:ComponentBuildDescr] :: ComponentBuildDescr -> Map ComponentName [ComponentLocalBuildInfo]
-- | The packages we were promised, but aren't already installed. MP:
-- Perhaps this just needs to be a Set UnitId at this stage.
[$sel:promisedPkgs:ComponentBuildDescr] :: ComponentBuildDescr -> Map (PackageName, ComponentName) PromisedComponent
-- | All the info about the installed packages that the current package
-- depends on (directly or indirectly). The copy saved on disk does NOT
-- include internal dependencies (because we just don't have enough
-- information at this point to have an InstalledPackageInfo for
-- an internal dep), but we will often update it with the internal
-- dependencies; see for example build. (This admonition doesn't
-- apply for per-component builds.)
[$sel:installedPkgs:ComponentBuildDescr] :: ComponentBuildDescr -> InstalledPackageIndex
-- | 'LocalBuildDescr ' contains the information Cabal determines after
-- performing package-wide and per-component configuration of a package.
--
-- This information can no longer be changed after that point.
data LocalBuildDescr
LocalBuildDescr :: PackageBuildDescr -> ComponentBuildDescr -> LocalBuildDescr
-- | Information that is available after configuring the package itself,
-- before looking at individual components.
[$sel:packageBuildDescr:LocalBuildDescr] :: LocalBuildDescr -> PackageBuildDescr
-- | Information about individual components in the package determined
-- after the configure step.
[$sel:componentBuildDescr:LocalBuildDescr] :: LocalBuildDescr -> ComponentBuildDescr
-- | LocalBuildConfig contains options that can be controlled by the
-- user and serve as inputs to the configuration of a package.
data LocalBuildConfig
LocalBuildConfig :: [String] -> ProgramDb -> BuildOptions -> LocalBuildConfig
-- | Extra args on the command line for the configuration step. Needed to
-- re-run configuration when .cabal is out of date
[$sel:extraConfigArgs:LocalBuildConfig] :: LocalBuildConfig -> [String]
-- | Location and args for all programs
[$sel:withPrograms:LocalBuildConfig] :: LocalBuildConfig -> ProgramDb
-- | Options to control the build, e.g. whether to enable profiling or to
-- enable program coverage.
[$sel:withBuildOptions:LocalBuildConfig] :: LocalBuildConfig -> BuildOptions
-- | BuildOptions contains configuration options that can be
-- controlled by the user.
data BuildOptions
BuildOptions :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> BuildOptions
-- | Whether to build normal libs.
[$sel:withVanillaLib:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build normal libs.
[$sel:withProfLib:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build profiling versions of libs.
[$sel:withProfLibShared:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build shared versions of libs.
[$sel:withSharedLib:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build static versions of libs (with all other libs rolled
-- in)
[$sel:withStaticLib:BuildOptions] :: BuildOptions -> Bool
-- | Whether to link executables dynamically
[$sel:withDynExe:BuildOptions] :: BuildOptions -> Bool
-- | Whether to link executables fully statically
[$sel:withFullyStaticExe:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build executables for profiling.
[$sel:withProfExe:BuildOptions] :: BuildOptions -> Bool
-- | Level of automatic profile detail.
[$sel:withProfLibDetail:BuildOptions] :: BuildOptions -> ProfDetailLevel
-- | Level of automatic profile detail.
[$sel:withProfExeDetail:BuildOptions] :: BuildOptions -> ProfDetailLevel
-- | Whether to build with optimization (if available).
[$sel:withOptimization:BuildOptions] :: BuildOptions -> OptimisationLevel
-- | Whether to emit debug info (if available).
[$sel:withDebugInfo:BuildOptions] :: BuildOptions -> DebugInfoLevel
-- | Whether to build libs suitable for use with GHCi.
[$sel:withGHCiLib:BuildOptions] :: BuildOptions -> Bool
-- | Use -split-sections with GHC, if available
[$sel:splitSections:BuildOptions] :: BuildOptions -> Bool
-- | Use -split-objs with GHC, if available
[$sel:splitObjs:BuildOptions] :: BuildOptions -> Bool
-- | Whether to strip executables during install
[$sel:stripExes:BuildOptions] :: BuildOptions -> Bool
-- | Whether to strip libraries during install
[$sel:stripLibs:BuildOptions] :: BuildOptions -> Bool
-- | Whether to enable executable program coverage
[$sel:exeCoverage:BuildOptions] :: BuildOptions -> Bool
-- | Whether to enable library program coverage
[$sel:libCoverage:BuildOptions] :: BuildOptions -> Bool
-- | Whether to build a relocatable package
[$sel:relocatable:BuildOptions] :: BuildOptions -> Bool
buildOptionsConfigFlags :: BuildOptions -> ConfigFlags
instance GHC.Show.Show Distribution.Types.LocalBuildConfig.PackageBuildDescr
instance GHC.Read.Read Distribution.Types.LocalBuildConfig.PackageBuildDescr
instance GHC.Generics.Generic Distribution.Types.LocalBuildConfig.PackageBuildDescr
instance GHC.Show.Show Distribution.Types.LocalBuildConfig.ComponentBuildDescr
instance GHC.Read.Read Distribution.Types.LocalBuildConfig.ComponentBuildDescr
instance GHC.Generics.Generic Distribution.Types.LocalBuildConfig.ComponentBuildDescr
instance GHC.Show.Show Distribution.Types.LocalBuildConfig.LocalBuildDescr
instance GHC.Read.Read Distribution.Types.LocalBuildConfig.LocalBuildDescr
instance GHC.Generics.Generic Distribution.Types.LocalBuildConfig.LocalBuildDescr
instance GHC.Show.Show Distribution.Types.LocalBuildConfig.BuildOptions
instance GHC.Read.Read Distribution.Types.LocalBuildConfig.BuildOptions
instance GHC.Generics.Generic Distribution.Types.LocalBuildConfig.BuildOptions
instance GHC.Classes.Eq Distribution.Types.LocalBuildConfig.BuildOptions
instance GHC.Show.Show Distribution.Types.LocalBuildConfig.LocalBuildConfig
instance GHC.Read.Read Distribution.Types.LocalBuildConfig.LocalBuildConfig
instance GHC.Generics.Generic Distribution.Types.LocalBuildConfig.LocalBuildConfig
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildConfig.LocalBuildConfig
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildConfig.LocalBuildConfig
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildConfig.BuildOptions
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildConfig.BuildOptions
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildConfig.LocalBuildDescr
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildConfig.LocalBuildDescr
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildConfig.ComponentBuildDescr
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildConfig.ComponentBuildDescr
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildConfig.PackageBuildDescr
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildConfig.PackageBuildDescr
module Distribution.Types.LocalBuildInfo
-- | Data cached after configuration step. See also ConfigFlags.
data LocalBuildInfo
NewLocalBuildInfo :: LocalBuildDescr -> LocalBuildConfig -> LocalBuildInfo
-- | Information about a package determined by Cabal after the
-- configuration step.
[$sel:localBuildDescr:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildDescr
-- | Information about a package configuration that can be modified by the
-- user at configuration time.
[$sel:localBuildConfig:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildConfig
-- | This pattern synonym is for backwards compatibility, to adapt to
-- LocalBuildInfo being split into LocalBuildDescr and
-- LocalBuildConfig.
pattern LocalBuildInfo :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> [String] -> InstallDirTemplates -> Compiler -> Platform -> Maybe (SymbolicPath Pkg File) -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> Map (PackageName, ComponentName) PromisedComponent -> InstalledPackageIndex -> PackageDescription -> ProgramDb -> PackageDBStack -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> [UnitId] -> Bool -> LocalBuildInfo
-- | Extract the ComponentId from the public library component of a
-- LocalBuildInfo if it exists, or make a fake component ID based
-- on the package ID.
localComponentId :: LocalBuildInfo -> ComponentId
-- | Extract the UnitId from the library component of a
-- LocalBuildInfo if it exists, or make a fake unit ID based on
-- the package ID.
localUnitId :: LocalBuildInfo -> UnitId
-- | Extract the compatibility package key from the public library
-- component of a LocalBuildInfo if it exists, or make a fake
-- package key based on the package ID.
localCompatPackageKey :: LocalBuildInfo -> String
-- | Extract the PackageIdentifier of a LocalBuildInfo. This
-- is a "safe" use of $sel:localPkgDescr:LocalBuildInfo
localPackage :: LocalBuildInfo -> PackageId
buildDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Build)
buildDirPBD :: PackageBuildDescr -> SymbolicPath Pkg (Dir Build)
setupFlagsBuildDir :: CommonSetupFlags -> SymbolicPath Pkg (Dir Build)
distPrefLBI :: LocalBuildInfo -> SymbolicPath Pkg (Dir Dist)
-- | The (relative or absolute) path to the package root, based on
--
--
-- - the working directory flag
-- - the .cabal path
--
packageRoot :: CommonSetupFlags -> FilePath
progPrefix :: LocalBuildInfo -> PathTemplate
progSuffix :: LocalBuildInfo -> PathTemplate
-- | Return all ComponentLocalBuildInfos associated with
-- ComponentName. In the presence of Backpack there may be more
-- than one!
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
-- | Return all TargetInfos associated with ComponentName. In
-- the presence of Backpack there may be more than one! Has a prime
-- because it takes a PackageDescription argument which may
-- disagree with $sel:localPkgDescr:LocalBuildInfo in
-- LocalBuildInfo.
componentNameTargets' :: PackageDescription -> LocalBuildInfo -> ComponentName -> [TargetInfo]
unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
-- | Return the list of default TargetInfos associated with a
-- configured package, in the order they need to be built. Has a prime
-- because it takes a PackageDescription argument which may
-- disagree with $sel:localPkgDescr:LocalBuildInfo in
-- LocalBuildInfo.
allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
-- | Execute f for every TargetInfo in the package,
-- respecting the build dependency order. (TODO: We should use Shake!)
-- Has a prime because it takes a PackageDescription argument
-- which may disagree with $sel:localPkgDescr:LocalBuildInfo in
-- LocalBuildInfo.
withAllTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
-- | Return the list of all targets needed to build the uids, in
-- the order they need to be built. Has a prime because it takes a
-- PackageDescription argument which may disagree with
-- $sel:localPkgDescr:LocalBuildInfo in LocalBuildInfo.
neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
-- | Execute f for every TargetInfo needed to build
-- uids, respecting the build dependency order. Has a prime
-- because it takes a PackageDescription argument which may
-- disagree with $sel:localPkgDescr:LocalBuildInfo in
-- LocalBuildInfo.
withNeededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
-- | Is coverage enabled for test suites? In practice, this requires
-- library and executable profiling to be enabled.
testCoverage :: LocalBuildInfo -> Bool
-- | Returns a list of ways, in the order which they should be built, and
-- the way we build executable and foreign library components.
--
-- Ideally all this info should be fixed at configure time and not
-- dependent on additional info but LocalBuildInfo is per package
-- (not per component) so it's currently not possible to configure
-- components to be built in certain ways.
buildWays :: LocalBuildInfo -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
-- | Warning: By using this function, you may be introducing a bug where
-- you retrieve a Component which does not have
-- HookedBuildInfo applied to it. See the documentation for
-- HookedBuildInfo for an explanation of the issue. If you have a
-- PackageDescription handy (NOT from the LocalBuildInfo),
-- try using the primed version of the function, which takes it as an
-- extra argument.
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
instance GHC.Show.Show Distribution.Types.LocalBuildInfo.LocalBuildInfo
instance GHC.Read.Read Distribution.Types.LocalBuildInfo.LocalBuildInfo
instance GHC.Generics.Generic Distribution.Types.LocalBuildInfo.LocalBuildInfo
instance Data.Binary.Class.Binary Distribution.Types.LocalBuildInfo.LocalBuildInfo
instance Distribution.Utils.Structured.Structured Distribution.Types.LocalBuildInfo.LocalBuildInfo
-- | Once a package has been configured we have resolved conditionals and
-- dependencies, configured the compiler and other needed external
-- programs. The LocalBuildInfo is used to hold all this
-- information. It holds the install dirs, the compiler, the exact
-- package dependencies, the configured programs, the package database to
-- use and a bunch of miscellaneous configure flags. It gets saved and
-- reloaded from a file (dist/setup-config). It gets passed in
-- to very many subsequent build actions.
module Distribution.Simple.LocalBuildInfo
-- | Data cached after configuration step. See also ConfigFlags.
data LocalBuildInfo
NewLocalBuildInfo :: LocalBuildDescr -> LocalBuildConfig -> LocalBuildInfo
-- | Information about a package determined by Cabal after the
-- configuration step.
[$sel:localBuildDescr:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildDescr
-- | Information about a package configuration that can be modified by the
-- user at configuration time.
[$sel:localBuildConfig:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildConfig
-- | This pattern synonym is for backwards compatibility, to adapt to
-- LocalBuildInfo being split into LocalBuildDescr and
-- LocalBuildConfig.
pattern LocalBuildInfo :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> [String] -> InstallDirTemplates -> Compiler -> Platform -> Maybe (SymbolicPath Pkg File) -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> Map (PackageName, ComponentName) PromisedComponent -> InstalledPackageIndex -> PackageDescription -> ProgramDb -> PackageDBStack -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> [UnitId] -> Bool -> LocalBuildInfo
-- | Extract the ComponentId from the public library component of a
-- LocalBuildInfo if it exists, or make a fake component ID based
-- on the package ID.
localComponentId :: LocalBuildInfo -> ComponentId
-- | Extract the UnitId from the library component of a
-- LocalBuildInfo if it exists, or make a fake unit ID based on
-- the package ID.
localUnitId :: LocalBuildInfo -> UnitId
-- | Extract the compatibility package key from the public library
-- component of a LocalBuildInfo if it exists, or make a fake
-- package key based on the package ID.
localCompatPackageKey :: LocalBuildInfo -> String
buildDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Build)
-- | The (relative or absolute) path to the package root, based on
--
--
-- - the working directory flag
-- - the .cabal path
--
packageRoot :: CommonSetupFlags -> FilePath
progPrefix :: LocalBuildInfo -> PathTemplate
progSuffix :: LocalBuildInfo -> PathTemplate
-- | Interpret a symbolic path with respect to the working directory stored
-- in LocalBuildInfo.
--
-- Use this before directly interacting with the file system.
--
-- NB: when invoking external programs (such as GHC), it is
-- preferable to set the working directory of the process rather than
-- calling this function, as this function will turn relative paths into
-- absolute paths if the working directory is an absolute path. This can
-- degrade error messages, or worse, break the behaviour entirely
-- (because the program might expect certain paths to be relative).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path
interpretSymbolicPathLBI :: LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
-- | Retrieve an optional working directory from LocalBuildInfo.
mbWorkDirLBI :: LocalBuildInfo -> Maybe (SymbolicPath CWD (Dir Pkg))
-- | Absolute path to the current working directory.
absoluteWorkingDirLBI :: LocalBuildInfo -> IO (AbsolutePath (Dir Pkg))
-- | Returns a list of ways, in the order which they should be built, and
-- the way we build executable and foreign library components.
--
-- Ideally all this info should be fixed at configure time and not
-- dependent on additional info but LocalBuildInfo is per package
-- (not per component) so it's currently not possible to configure
-- components to be built in certain ways.
buildWays :: LocalBuildInfo -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
data () => Component
CLib :: Library -> Component
CFLib :: ForeignLib -> Component
CExe :: Executable -> Component
CTest :: TestSuite -> Component
CBench :: Benchmark -> Component
data () => ComponentName
CLibName :: LibraryName -> ComponentName
CNotLibName :: NotLibComponentName -> ComponentName
pattern CBenchName :: UnqualComponentName -> ComponentName
pattern CExeName :: UnqualComponentName -> ComponentName
pattern CFLibName :: UnqualComponentName -> ComponentName
pattern CTestName :: UnqualComponentName -> ComponentName
data () => LibraryName
LMainLibName :: LibraryName
LSubLibName :: UnqualComponentName -> LibraryName
defaultLibName :: LibraryName
showComponentName :: ComponentName -> String
componentNameString :: ComponentName -> Maybe UnqualComponentName
-- | The first five fields are common across all algebraic variants.
data ComponentLocalBuildInfo
LibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> Bool -> [(ModuleName, OpenModule)] -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> String -> MungedPackageName -> [ExposedModule] -> Bool -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Is this an indefinite component (i.e. has unfilled holes)?
[componentIsIndefinite_] :: ComponentLocalBuildInfo -> Bool
-- | How the component was instantiated
[componentInstantiatedWith] :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | Compatibility "package key" that we pass to older versions of GHC.
[componentCompatPackageKey] :: ComponentLocalBuildInfo -> String
-- | Compatibility "package name" that we register this component as.
[componentCompatPackageName] :: ComponentLocalBuildInfo -> MungedPackageName
-- | A list of exposed modules (either defined in this component, or
-- reexported from another component.)
[componentExposedModules] :: ComponentLocalBuildInfo -> [ExposedModule]
-- | Convenience field, specifying whether or not this is the "public
-- library" that has the same name as the package.
[componentIsPublic] :: ComponentLocalBuildInfo -> Bool
FLibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
ExeComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
TestComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
BenchComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo
-- | It would be very convenient to store the literal Library here, but if
-- we do that, it will get serialized (via the Binary) instance twice. So
-- instead we just provide the ComponentName, which can be used to find
-- the Component in the PackageDescription. NB: eventually, this will NOT
-- uniquely identify the ComponentLocalBuildInfo.
[componentLocalName] :: ComponentLocalBuildInfo -> ComponentName
-- | The computed ComponentId of this component.
[componentComponentId] :: ComponentLocalBuildInfo -> ComponentId
-- | The computed UnitId which uniquely identifies this component.
-- Might be hashed.
[componentUnitId] :: ComponentLocalBuildInfo -> UnitId
-- | Resolved internal and external package dependencies for this
-- component. The BuildInfo specifies a set of build
-- dependencies that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions available on
-- this machine for this compiler.
[componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
-- | The set of packages that are brought into scope during compilation,
-- including a ModuleRenaming which may used to hide or rename
-- modules. This is what gets translated into -package-id
-- arguments. This is a modernized version of
-- componentPackageDeps, which is kept around for BC purposes.
[componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
[componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId]
-- | The internal dependencies which induce a graph on the
-- ComponentLocalBuildInfo of this package. This does NOT coincide
-- with componentPackageDeps because it ALSO records 'build-tool'
-- dependencies on executables. Maybe one day cabal-install will
-- also handle these correctly too!
[componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId]
componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Build)
foldComponent :: (Library -> a) -> (ForeignLib -> a) -> (Executable -> a) -> (TestSuite -> a) -> (Benchmark -> a) -> Component -> a
componentName :: Component -> ComponentName
componentBuildInfo :: Component -> BuildInfo
componentBuildable :: Component -> Bool
pkgComponents :: PackageDescription -> [Component]
pkgBuildableComponents :: PackageDescription -> [Component]
lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
getComponent :: PackageDescription -> ComponentName -> Component
allComponentsInBuildOrder :: LocalBuildInfo -> [ComponentLocalBuildInfo]
-- | Determine the directories containing the dynamic libraries of the
-- transitive dependencies of the component we are building.
--
-- When wanted, and possible, returns paths relative to the installDirs
-- prefix
depLibraryPaths :: Bool -> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [FilePath]
-- | Get all module names that needed to be built by GHC; i.e., all of
-- these ModuleNames have interface files associated with them
-- that need to be installed.
allLibModules :: Library -> ComponentLocalBuildInfo -> [ModuleName]
-- | Perform the action on each buildable Library or
-- Executable (Component) in the PackageDescription, subject to
-- the build order specified by the compBuildOrder field of the
-- given LocalBuildInfo
withAllComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo -> (Component -> ComponentLocalBuildInfo -> IO ()) -> IO ()
-- | Perform the action on each enabled library in the package
-- description with the ComponentLocalBuildInfo.
withLibLBI :: PackageDescription -> LocalBuildInfo -> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
-- | Perform the action on each enabled Executable in the package
-- description. Extended version of withExe that also gives
-- corresponding build info.
withExeLBI :: PackageDescription -> LocalBuildInfo -> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
-- | Perform the action on each enabled Benchmark in the package
-- description.
withBenchLBI :: PackageDescription -> LocalBuildInfo -> (Benchmark -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withTestLBI :: PackageDescription -> LocalBuildInfo -> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO ()
enabledTestLBIs :: PackageDescription -> LocalBuildInfo -> [(TestSuite, ComponentLocalBuildInfo)]
enabledBenchLBIs :: PackageDescription -> LocalBuildInfo -> [(Benchmark, ComponentLocalBuildInfo)]
-- | The directories where we will install files for packages.
--
-- We have several different directories for different types of files
-- since many systems have conventions whereby different types of files
-- in a package are installed in different directories. This is
-- particularly the case on Unix style systems.
data InstallDirs dir
InstallDirs :: dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> dir -> InstallDirs dir
[prefix] :: InstallDirs dir -> dir
[bindir] :: InstallDirs dir -> dir
[libdir] :: InstallDirs dir -> dir
[libsubdir] :: InstallDirs dir -> dir
[dynlibdir] :: InstallDirs dir -> dir
-- | foreign libraries
[flibdir] :: InstallDirs dir -> dir
[libexecdir] :: InstallDirs dir -> dir
[libexecsubdir] :: InstallDirs dir -> dir
[includedir] :: InstallDirs dir -> dir
[datadir] :: InstallDirs dir -> dir
[datasubdir] :: InstallDirs dir -> dir
[docdir] :: InstallDirs dir -> dir
[mandir] :: InstallDirs dir -> dir
[htmldir] :: InstallDirs dir -> dir
[haddockdir] :: InstallDirs dir -> dir
[sysconfdir] :: InstallDirs dir -> dir
-- | The installation directories in terms of PathTemplates that
-- contain variables.
--
-- The defaults for most of the directories are relative to each other,
-- in particular they are all relative to a single prefix. This makes it
-- convenient for the user to override the default installation directory
-- by only having to specify --prefix=... rather than overriding each
-- individually. This is done by allowing $-style variables in the dirs.
-- These are expanded by textual substitution (see
-- substPathTemplate).
--
-- A few of these installation directories are split into two components,
-- the dir and subdir. The full installation path is formed by combining
-- the two together with /. The reason for this is compatibility
-- with other Unix build systems which also support --libdir and
-- --datadir. We would like users to be able to configure
-- --libdir=/usr/lib64 for example but because by default we
-- want to support installing multiple versions of packages and building
-- the same package for multiple compilers we append the libsubdir to
-- get: /usr/lib64/$libname/$compiler.
--
-- An additional complication is the need to support relocatable packages
-- on systems which support such things, like Windows.
type InstallDirTemplates = InstallDirs PathTemplate
-- | The location prefix for the copy command.
data CopyDest
NoCopyDest :: CopyDest
CopyTo :: FilePath -> CopyDest
-- | when using the ${pkgroot} as prefix. The CopyToDb will adjust the
-- paths to be relative to the provided package database when copying /
-- installing.
CopyToDb :: FilePath -> CopyDest
-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real FilePath.
data PathTemplate
data PathTemplateVariable
-- | The $prefix path variable
PrefixVar :: PathTemplateVariable
-- | The $bindir path variable
BindirVar :: PathTemplateVariable
-- | The $libdir path variable
LibdirVar :: PathTemplateVariable
-- | The $libsubdir path variable
LibsubdirVar :: PathTemplateVariable
-- | The $dynlibdir path variable
DynlibdirVar :: PathTemplateVariable
-- | The $datadir path variable
DatadirVar :: PathTemplateVariable
-- | The $datasubdir path variable
DatasubdirVar :: PathTemplateVariable
-- | The $docdir path variable
DocdirVar :: PathTemplateVariable
-- | The $htmldir path variable
HtmldirVar :: PathTemplateVariable
-- | The $pkg package name path variable
PkgNameVar :: PathTemplateVariable
-- | The $version package version path variable
PkgVerVar :: PathTemplateVariable
-- | The $pkgid package Id path variable, eg foo-1.0
PkgIdVar :: PathTemplateVariable
-- | The $libname path variable
LibNameVar :: PathTemplateVariable
-- | The compiler name and version, eg ghc-6.6.1
CompilerVar :: PathTemplateVariable
-- | The operating system name, eg windows or linux
OSVar :: PathTemplateVariable
-- | The CPU architecture name, eg i386 or x86_64
ArchVar :: PathTemplateVariable
-- | The compiler's ABI identifier,
AbiVar :: PathTemplateVariable
-- | The optional ABI tag for the compiler
AbiTagVar :: PathTemplateVariable
-- | The executable name; used in shell wrappers
ExecutableNameVar :: PathTemplateVariable
-- | The name of the test suite being run
TestSuiteNameVar :: PathTemplateVariable
-- | The result of the test suite being run, eg pass,
-- fail, or error.
TestSuiteResultVar :: PathTemplateVariable
-- | The name of the benchmark being run
BenchmarkNameVar :: PathTemplateVariable
type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)]
defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' :: Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
combineInstallDirs :: (a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
-- | Substitute the install dir templates into each other.
--
-- To prevent cyclic substitutions, only some variables are allowed in
-- particular dir templates. If out of scope vars are present, they are
-- not substituted for. Checking for any remaining unsubstituted vars can
-- be done as a subsequent operation.
--
-- The reason it is done this way is so that in
-- prefixRelativeInstallDirs we can replace prefix with the
-- PrefixVar and get resulting PathTemplates that still
-- have the PrefixVar in them. Doing this makes it each to check
-- which paths are relative to the $prefix.
substituteInstallDirTemplates :: PathTemplateEnv -> InstallDirTemplates -> InstallDirTemplates
-- | Convert a FilePath to a PathTemplate including any
-- template vars.
toPathTemplate :: FilePath -> PathTemplate
-- | Convert back to a path, any remaining vars are included
fromPathTemplate :: PathTemplate -> FilePath
combinePathTemplate :: PathTemplate -> PathTemplate -> PathTemplate
-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv :: PackageIdentifier -> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
platformTemplateEnv :: Platform -> PathTemplateEnv
compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv
packageTemplateEnv :: PackageIdentifier -> UnitId -> PathTemplateEnv
abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv
installDirsTemplateEnv :: InstallDirs PathTemplate -> PathTemplateEnv
-- | Backwards compatibility function which computes the InstallDirs
-- assuming that $libname points to the public library (or some
-- fake package identifier if there is no public library.) IF AT ALL
-- POSSIBLE, please use absoluteComponentInstallDirs instead.
absoluteInstallDirs :: PackageDescription -> LocalBuildInfo -> CopyDest -> InstallDirs FilePath
-- | Backwards compatibility function which computes the InstallDirs
-- assuming that $libname points to the public library (or some
-- fake package identifier if there is no public library.) IF AT ALL
-- POSSIBLE, please use prefixRelativeComponentInstallDirs
-- instead.
prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo -> InstallDirs (Maybe FilePath)
absoluteInstallCommandDirs :: PackageDescription -> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
-- | See absoluteInstallDirs.
absoluteComponentInstallDirs :: PackageDescription -> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
-- | See prefixRelativeInstallDirs
prefixRelativeComponentInstallDirs :: PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe FilePath)
substPathTemplate :: PackageId -> LocalBuildInfo -> UnitId -> PathTemplate -> FilePath
module Distribution.Simple.Test.Log
-- | Logs all test results for a package, broken down first by test suite
-- and then by test case.
data PackageLog
PackageLog :: PackageId -> CompilerId -> Platform -> [TestSuiteLog] -> PackageLog
[package] :: PackageLog -> PackageId
[compiler] :: PackageLog -> CompilerId
[platform] :: PackageLog -> Platform
[testSuites] :: PackageLog -> [TestSuiteLog]
data TestLogs
TestLog :: String -> Options -> Result -> TestLogs
[testName] :: TestLogs -> String
[testOptionsReturned] :: TestLogs -> Options
[testResult] :: TestLogs -> Result
GroupLogs :: String -> [TestLogs] -> TestLogs
-- | Logs test suite results, itemized by test case.
data TestSuiteLog
TestSuiteLog :: UnqualComponentName -> TestLogs -> FilePath -> TestSuiteLog
[testSuiteName] :: TestSuiteLog -> UnqualComponentName
[testLogs] :: TestSuiteLog -> TestLogs
[logFile] :: TestSuiteLog -> FilePath
-- | Count the number of pass, fail, and error test results in a
-- TestLogs tree.
countTestResults :: TestLogs -> (Int, Int, Int)
-- | A PackageLog with package and platform information specified.
localPackageLog :: PackageDescription -> LocalBuildInfo -> PackageLog
-- | Print a summary to the console after all test suites have been run
-- indicating the number of successful test suites and cases. Returns
-- True if all test suites passed and False otherwise.
summarizePackage :: Verbosity -> PackageLog -> IO Bool
-- | Print a summary of the test suite's results on the console,
-- suppressing output for certain verbosity or test filter levels.
summarizeSuiteFinish :: TestSuiteLog -> String
summarizeSuiteStart :: String -> String
-- | Print a summary of a single test case's result to the console,
-- suppressing output for certain verbosity or test filter levels.
summarizeTest :: Verbosity -> TestShowDetails -> TestLogs -> IO ()
-- | From a TestSuiteLog, determine if the test suite encountered
-- errors.
suiteError :: TestLogs -> Bool
-- | From a TestSuiteLog, determine if the test suite failed.
suiteFailed :: TestLogs -> Bool
-- | From a TestSuiteLog, determine if the test suite passed.
suitePassed :: TestLogs -> Bool
testSuiteLogPath :: PathTemplate -> PackageDescription -> LocalBuildInfo -> String -> TestLogs -> FilePath
instance GHC.Classes.Eq Distribution.Simple.Test.Log.TestLogs
instance GHC.Show.Show Distribution.Simple.Test.Log.TestLogs
instance GHC.Read.Read Distribution.Simple.Test.Log.TestLogs
instance GHC.Classes.Eq Distribution.Simple.Test.Log.TestSuiteLog
instance GHC.Show.Show Distribution.Simple.Test.Log.TestSuiteLog
instance GHC.Read.Read Distribution.Simple.Test.Log.TestSuiteLog
instance GHC.Classes.Eq Distribution.Simple.Test.Log.PackageLog
instance GHC.Show.Show Distribution.Simple.Test.Log.PackageLog
instance GHC.Read.Read Distribution.Simple.Test.Log.PackageLog
-- | This module provides an library interface to the ld linker
-- program.
module Distribution.Simple.Program.Ld
-- | Call ld -r to link a bunch of object files together.
combineObjectFiles :: Verbosity -> LocalBuildInfo -> ConfiguredProgram -> SymbolicPath Pkg File -> [SymbolicPath Pkg File] -> IO ()
-- | This module provides an library interface to the ar program.
module Distribution.Simple.Program.Ar
-- | Call ar to create a library archive from a bunch of object
-- files.
createArLibArchive :: Verbosity -> LocalBuildInfo -> SymbolicPath Pkg File -> [SymbolicPath Pkg File] -> IO ()
-- | Like the unix xargs program. Useful for when we've got very long
-- command lines that might overflow an OS limit on command line length
-- and so you need to invoke a command multiple times to get all the args
-- in.
--
-- It takes four template invocations corresponding to the simple,
-- initial, middle and last invocations. If the number of args given is
-- small enough that we can get away with just a single invocation then
-- the simple one is used:
--
--
-- $ simple args
--
--
-- If the number of args given means that we need to use multiple
-- invocations then the templates for the initial, middle and last
-- invocations are used:
--
--
-- $ initial args_0
-- $ middle args_1
-- $ middle args_2
-- ...
-- $ final args_n
--
multiStageProgramInvocation :: ProgramInvocation -> (ProgramInvocation, ProgramInvocation, ProgramInvocation) -> [String] -> [ProgramInvocation]
-- | This module provides functions for locating various HPC-related paths
-- and a function for adding the necessary options to a
-- PackageDescription to build test suites with HPC enabled.
module Distribution.Simple.Hpc
data Way
Vanilla :: Way
Prof :: Way
Dyn :: Way
ProfDyn :: Way
-- | Attempt to guess the way the test suites in this package were compiled
-- and linked with the library so the correct module interfaces are
-- found.
guessWay :: LocalBuildInfo -> Way
htmlDir :: SymbolicPath Pkg (Dir Dist) -> Way -> SymbolicPath Pkg (Dir Artifacts)
mixDir :: SymbolicPath Pkg (Dir Dist) -> Way -> SymbolicPath Pkg (Dir Mix)
tixDir :: SymbolicPath Pkg (Dir Dist) -> Way -> SymbolicPath Pkg (Dir Tix)
-- | Path to the .tix file containing a test suite's sum statistics.
tixFilePath :: SymbolicPath Pkg (Dir Dist) -> Way -> FilePath -> SymbolicPath Pkg File
-- | Haskell Program Coverage information required to produce a valid HPC
-- report through the `hpc markup` call for the package libraries.
data HPCMarkupInfo
HPCMarkupInfo :: [SymbolicPath Pkg (Dir Artifacts)] -> [ModuleName] -> HPCMarkupInfo
-- | The paths to the library components whose modules are included in the
-- coverage report
[pathsToLibsArtifacts] :: HPCMarkupInfo -> [SymbolicPath Pkg (Dir Artifacts)]
-- | The modules to include in the coverage report
[libsModulesToInclude] :: HPCMarkupInfo -> [ModuleName]
-- | Generate the HTML markup for a package's test suites.
markupPackage :: Verbosity -> HPCMarkupInfo -> LocalBuildInfo -> SymbolicPath Pkg (Dir Dist) -> PackageDescription -> [TestSuite] -> IO ()
instance GHC.Show.Show Distribution.Simple.Hpc.Way
instance GHC.Read.Read Distribution.Simple.Hpc.Way
instance GHC.Classes.Eq Distribution.Simple.Hpc.Way
instance GHC.Enum.Enum Distribution.Simple.Hpc.Way
instance GHC.Enum.Bounded Distribution.Simple.Hpc.Way
-- | Generating the PackageInfo_pkgname module.
--
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their package informations.
module Distribution.Simple.Build.PackageInfoModule
generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String
-- | Generate cabal_macros.h - CPP macros for package version testing
--
-- When using CPP you get
--
--
-- VERSION_<package>
-- MIN_VERSION_<package>(A,B,C)
--
--
-- for each package in build-depends, which is true if
-- the version of package in use is >= A.B.C, using
-- the normal ordering on version numbers.
--
-- TODO Figure out what to do about backpack and internal libraries. It
-- is very suspicious that this stuff works with munged package
-- identifiers
module Distribution.Simple.Build.Macros
-- | The contents of the cabal_macros.h for the given configured
-- package.
generateCabalMacrosHeader :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
-- | Helper function that generates just the VERSION_pkg and
-- MIN_VERSION_pkg macros for a list of package ids (usually
-- used with the specific deps of a configured package).
generatePackageVersionMacros :: Version -> [PackageId] -> String
-- | See
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
module Distribution.Backpack.ConfiguredComponent
-- | A configured component, we know exactly what its ComponentId
-- is, and the ComponentIds of the things it depends on.
data ConfiguredComponent
ConfiguredComponent :: AnnotatedId ComponentId -> Component -> Bool -> [AnnotatedId ComponentId] -> [ComponentInclude ComponentId IncludeRenaming] -> ConfiguredComponent
-- | Unique identifier of component, plus extra useful info.
[cc_ann_id] :: ConfiguredComponent -> AnnotatedId ComponentId
-- | The fragment of syntax from the Cabal file describing this component.
[cc_component] :: ConfiguredComponent -> Component
-- | Is this the public library component of the package? (If we invoke
-- Setup with an instantiation, this is the component the instantiation
-- applies to.) Note that in one-component configure mode, this is always
-- True, because any component is the "public" one.)
[cc_public] :: ConfiguredComponent -> Bool
-- | Dependencies on executables from build-tools and
-- build-tool-depends.
[cc_exe_deps] :: ConfiguredComponent -> [AnnotatedId ComponentId]
-- | The mixins of this package, including both explicit (from the
-- mixins field) and implicit (from build-depends). Not
-- mix-in linked yet; component configuration only looks at
-- ComponentIds.
[cc_includes] :: ConfiguredComponent -> [ComponentInclude ComponentId IncludeRenaming]
-- | The ComponentName of a component; this uniquely identifies a
-- fragment of syntax within a specified Cabal file describing the
-- component.
cc_name :: ConfiguredComponent -> ComponentName
-- | Uniquely identifies a configured component.
cc_cid :: ConfiguredComponent -> ComponentId
-- | The package this component came from.
cc_pkgid :: ConfiguredComponent -> PackageId
toConfiguredComponent :: PackageDescription -> ComponentId -> ConfiguredComponentMap -> ConfiguredComponentMap -> Component -> LogProgress ConfiguredComponent
toConfiguredComponents :: Bool -> FlagAssignment -> Bool -> Flag String -> Flag ComponentId -> PackageDescription -> ConfiguredComponentMap -> [Component] -> LogProgress [ConfiguredComponent]
-- | Pretty-print a ConfiguredComponent.
dispConfiguredComponent :: ConfiguredComponent -> Doc
type ConfiguredComponentMap = Map PackageName (Map ComponentName (AnnotatedId ComponentId))
extendConfiguredComponentMap :: ConfiguredComponent -> ConfiguredComponentMap -> ConfiguredComponentMap
newPackageDepsBehaviour :: PackageDescription -> Bool
-- | See
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
module Distribution.Backpack.LinkedComponent
-- | A linked component is a component that has been mix-in linked, at
-- which point we have determined how all the dependencies of the
-- component are explicitly instantiated (in the form of an OpenUnitId).
-- ConfiguredComponent is mix-in linked into
-- LinkedComponent, which is then instantiated into
-- ReadyComponent.
data LinkedComponent
LinkedComponent :: AnnotatedId ComponentId -> Component -> [AnnotatedId OpenUnitId] -> Bool -> [ComponentInclude OpenUnitId ModuleRenaming] -> [ComponentInclude OpenUnitId ModuleRenaming] -> ModuleShape -> LinkedComponent
-- | Uniquely identifies linked component
[lc_ann_id] :: LinkedComponent -> AnnotatedId ComponentId
-- | Corresponds to cc_component.
[lc_component] :: LinkedComponent -> Component
-- | build-tools and build-tool-depends dependencies.
-- Corresponds to cc_exe_deps.
[lc_exe_deps] :: LinkedComponent -> [AnnotatedId OpenUnitId]
-- | Is this the public library of a package? Corresponds to
-- cc_public.
[lc_public] :: LinkedComponent -> Bool
-- | Corresponds to cc_includes, but (1) this does not contain
-- includes of signature packages (packages with no exports), and (2) the
-- ModuleRenaming for requirements (stored in
-- IncludeRenaming) has been removed, as it is reflected in
-- OpenUnitId.)
[lc_includes] :: LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
-- | Like lc_includes, but this specifies includes on signature
-- packages which have no exports.
[lc_sig_includes] :: LinkedComponent -> [ComponentInclude OpenUnitId ModuleRenaming]
-- | The module shape computed by mix-in linking. This is newly computed
-- from ConfiguredComponent
[lc_shape] :: LinkedComponent -> ModuleShape
-- | The instantiation of lc_uid; this always has the invariant that
-- it is a mapping from a module name A to A
-- (the hole A).
lc_insts :: LinkedComponent -> [(ModuleName, OpenModule)]
-- | The OpenUnitId of this component in the "default"
-- instantiation. See also lc_insts. LinkedComponents
-- cannot be instantiated (e.g., there is no ModSubst instance
-- for them).
lc_uid :: LinkedComponent -> OpenUnitId
-- | Uniquely identifies a LinkedComponent. Corresponds to
-- cc_cid.
lc_cid :: LinkedComponent -> ComponentId
-- | Corresponds to cc_pkgid.
lc_pkgid :: LinkedComponent -> PackageId
toLinkedComponent :: Verbosity -> Bool -> FullDb -> PackageId -> LinkedComponentMap -> ConfiguredComponent -> LogProgress LinkedComponent
toLinkedComponents :: Verbosity -> Bool -> FullDb -> PackageId -> LinkedComponentMap -> [ConfiguredComponent] -> LogProgress [LinkedComponent]
dispLinkedComponent :: LinkedComponent -> Doc
type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape)
extendLinkedComponentMap :: LinkedComponent -> LinkedComponentMap -> LinkedComponentMap
instance Distribution.Package.Package Distribution.Backpack.LinkedComponent.LinkedComponent
-- | See
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
module Distribution.Backpack.ComponentsGraph
-- | A graph of source-level components by their source-level dependencies
type ComponentsGraph = Graph (Node ComponentName Component)
-- | A list of components associated with the source level dependencies
-- between them.
type ComponentsWithDeps = [(Component, [ComponentName])]
-- | Create a Graph of Component, or report a cycle if there
-- is a problem.
mkComponentsGraph :: ComponentRequestedSpec -> PackageDescription -> Either [ComponentName] ComponentsGraph
-- | Given the package description and a PackageDescription (used to
-- determine if a package name is internal or not), sort the components
-- in dependency order (fewest dependencies first). This is NOT
-- necessarily the build order (although it is in the absence of
-- Backpack.)
componentsGraphToList :: ComponentsGraph -> ComponentsWithDeps
-- | Pretty-print ComponentsWithDeps.
dispComponentsWithDeps :: ComponentsWithDeps -> Doc
-- | Error message when there is a cycle; takes the SCC of components.
componentCycleMsg :: PackageIdentifier -> [ComponentName] -> Doc
-- | 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.
--
-- All the flags types are instances of Monoid, see
-- http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html
-- for an explanation.
--
-- The types defined here get used in the front end and especially in
-- cabal-install which has to do quite a bit of manipulating
-- sets of command line flags.
--
-- This is actually relatively nice, it works quite well. The main change
-- it needs is to unify it with the code for managing sets of fields that
-- can be read and written from files. This would allow us to save
-- configure flags in config files.
module Distribution.Simple.Setup
-- | Flags that apply at the top level, not to any sub-command.
data GlobalFlags
GlobalFlags :: Flag Bool -> Flag Bool -> Flag (SymbolicPath CWD (Dir Pkg)) -> GlobalFlags
[globalVersion] :: GlobalFlags -> Flag Bool
[globalNumericVersion] :: GlobalFlags -> Flag Bool
[globalWorkingDir] :: GlobalFlags -> Flag (SymbolicPath CWD (Dir Pkg))
emptyGlobalFlags :: GlobalFlags
defaultGlobalFlags :: GlobalFlags
globalCommand :: [Command action] -> CommandUI GlobalFlags
-- | A datatype that stores common flags for different invocations of a
-- Setup executable, e.g. configure, build, install.
data CommonSetupFlags
CommonSetupFlags :: !Flag Verbosity -> !Flag (SymbolicPath CWD (Dir Pkg)) -> !Flag (SymbolicPath Pkg (Dir Dist)) -> !Flag (SymbolicPath Pkg File) -> [String] -> CommonSetupFlags
-- | Verbosity
[setupVerbosity] :: CommonSetupFlags -> !Flag Verbosity
-- | Working directory (optional)
[setupWorkingDir] :: CommonSetupFlags -> !Flag (SymbolicPath CWD (Dir Pkg))
-- | Build directory
[setupDistPref] :: CommonSetupFlags -> !Flag (SymbolicPath Pkg (Dir Dist))
-- | Which Cabal file to use (optional)
[setupCabalFilePath] :: CommonSetupFlags -> !Flag (SymbolicPath Pkg File)
-- | Which targets is this Setup invocation relative to?
--
-- TODO: this one should not be here, it's just that the silly UserHooks
-- stop us from passing extra info in other ways
[setupTargets] :: CommonSetupFlags -> [String]
defaultCommonSetupFlags :: CommonSetupFlags
-- | Flags to configure command.
--
-- IMPORTANT: every time a new flag is added, filterConfigureFlags
-- should be updated. IMPORTANT: every time a new flag is added, it
-- should be added to the Eq instance
data ConfigFlags
ConfigFlags :: !CommonSetupFlags -> Option' (Last' ProgramDb) -> [(String, FilePath)] -> [(String, [String])] -> NubList FilePath -> Flag CompilerFlavor -> Flag FilePath -> Flag FilePath -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag ProfDetailLevel -> Flag ProfDetailLevel -> [String] -> Flag OptimisationLevel -> Flag PathTemplate -> Flag PathTemplate -> InstallDirs (Flag PathTemplate) -> Flag FilePath -> [SymbolicPath Pkg (Dir Lib)] -> [SymbolicPath Pkg (Dir Lib)] -> [SymbolicPath Pkg (Dir Framework)] -> [SymbolicPath Pkg (Dir Include)] -> Flag String -> Flag ComponentId -> Flag Bool -> Flag Bool -> [Maybe PackageDB] -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> [PackageVersionConstraint] -> [GivenComponent] -> [PromisedComponent] -> [(ModuleName, Module)] -> FlagAssignment -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag String -> Flag Bool -> Flag DebugInfoLevel -> Flag DumpBuildInfo -> Flag Bool -> Flag Bool -> Flag [UnitId] -> Flag Bool -> ConfigFlags
[configCommonFlags] :: ConfigFlags -> !CommonSetupFlags
-- | All programs that cabal may run
[configPrograms_] :: ConfigFlags -> Option' (Last' ProgramDb)
-- | user specified programs paths
[configProgramPaths] :: ConfigFlags -> [(String, FilePath)]
-- | user specified programs args
[configProgramArgs] :: ConfigFlags -> [(String, [String])]
-- | Extend the $PATH
[configProgramPathExtra] :: ConfigFlags -> NubList FilePath
-- | The "flavor" of the compiler, e.g. GHC.
[configHcFlavor] :: ConfigFlags -> Flag CompilerFlavor
-- | given compiler location
[configHcPath] :: ConfigFlags -> Flag FilePath
-- | given hc-pkg location
[configHcPkg] :: ConfigFlags -> Flag FilePath
-- | Enable vanilla library
[configVanillaLib] :: ConfigFlags -> Flag Bool
-- | Enable profiling in the library
[configProfLib] :: ConfigFlags -> Flag Bool
-- | Build shared library
[configSharedLib] :: ConfigFlags -> Flag Bool
-- | Build static library
[configStaticLib] :: ConfigFlags -> Flag Bool
-- | Enable dynamic linking of the executables.
[configDynExe] :: ConfigFlags -> Flag Bool
-- | Enable fully static linking of the executables.
[configFullyStaticExe] :: ConfigFlags -> Flag Bool
-- | Enable profiling in the executables.
[configProfExe] :: ConfigFlags -> Flag Bool
-- | Enable profiling in the library and executables.
[configProf] :: ConfigFlags -> Flag Bool
-- | Enable shared profiling objects
[configProfShared] :: ConfigFlags -> Flag Bool
-- | Profiling detail level in the library and executables.
[configProfDetail] :: ConfigFlags -> Flag ProfDetailLevel
-- | Profiling detail level in the library
[configProfLibDetail] :: ConfigFlags -> Flag ProfDetailLevel
-- | Extra arguments to configure
[configConfigureArgs] :: ConfigFlags -> [String]
-- | Enable optimization.
[configOptimization] :: ConfigFlags -> Flag OptimisationLevel
-- | Installed executable prefix.
[configProgPrefix] :: ConfigFlags -> Flag PathTemplate
-- | Installed executable suffix.
[configProgSuffix] :: ConfigFlags -> Flag PathTemplate
-- | Installation paths
[configInstallDirs] :: ConfigFlags -> InstallDirs (Flag PathTemplate)
[configScratchDir] :: ConfigFlags -> Flag FilePath
-- | path to search for extra libraries
[configExtraLibDirs] :: ConfigFlags -> [SymbolicPath Pkg (Dir Lib)]
-- | path to search for extra libraries when linking fully static
-- executables
[configExtraLibDirsStatic] :: ConfigFlags -> [SymbolicPath Pkg (Dir Lib)]
-- | path to search for extra frameworks (OS X only)
[configExtraFrameworkDirs] :: ConfigFlags -> [SymbolicPath Pkg (Dir Framework)]
-- | path to search for header files
[configExtraIncludeDirs] :: ConfigFlags -> [SymbolicPath Pkg (Dir Include)]
-- | explicit IPID to be used
[configIPID] :: ConfigFlags -> Flag String
-- | explicit CID to be used
[configCID] :: ConfigFlags -> Flag ComponentId
-- | be as deterministic as possible (e.g., invariant over GHC, database,
-- etc). Used by the test suite
[configDeterministic] :: ConfigFlags -> Flag Bool
-- | The --user/--global flag
[configUserInstall] :: ConfigFlags -> Flag Bool
-- | Which package DBs to use
[configPackageDBs] :: ConfigFlags -> [Maybe PackageDB]
-- | Enable compiling library for GHCi
[configGHCiLib] :: ConfigFlags -> Flag Bool
-- | Enable -split-sections with GHC
[configSplitSections] :: ConfigFlags -> Flag Bool
-- | Enable -split-objs with GHC
[configSplitObjs] :: ConfigFlags -> Flag Bool
-- | Enable executable stripping
[configStripExes] :: ConfigFlags -> Flag Bool
-- | Enable library stripping
[configStripLibs] :: ConfigFlags -> Flag Bool
-- | Additional constraints for dependencies.
[configConstraints] :: ConfigFlags -> [PackageVersionConstraint]
-- | The packages depended on which already exist
[configDependencies] :: ConfigFlags -> [GivenComponent]
-- | The packages depended on which doesn't yet exist (i.e. promised).
-- Promising dependencies enables us to configure components in parallel,
-- and avoids expensive builds if they are not necessary. For example, in
-- multi-repl mode, we don't want to build dependencies that are loaded
-- into the interactive session, since we have to build them again.
[configPromisedDependencies] :: ConfigFlags -> [PromisedComponent]
-- | The requested Backpack instantiation. If empty, either this package
-- does not use Backpack, or we just want to typecheck the indefinite
-- package.
[configInstantiateWith] :: ConfigFlags -> [(ModuleName, Module)]
[configConfigurationsFlags] :: ConfigFlags -> FlagAssignment
-- | Enable test suite compilation
[configTests] :: ConfigFlags -> Flag Bool
-- | Enable benchmark compilation
[configBenchmarks] :: ConfigFlags -> Flag Bool
-- | Enable program coverage
[configCoverage] :: ConfigFlags -> Flag Bool
-- | Enable program coverage (deprecated)
[configLibCoverage] :: ConfigFlags -> Flag Bool
-- | All direct dependencies and flags are provided on the command line by
-- the user via the '--dependency' and '--flags' options.
[configExactConfiguration] :: ConfigFlags -> Flag Bool
-- | Halt and show an error message indicating an error in flag assignment
[configFlagError] :: ConfigFlags -> Flag String
-- | Enable relocatable package built
[configRelocatable] :: ConfigFlags -> Flag Bool
-- | Emit debug info.
[configDebugInfo] :: ConfigFlags -> Flag DebugInfoLevel
-- | 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.
[configDumpBuildInfo] :: ConfigFlags -> Flag DumpBuildInfo
-- | Whether to use response files at all. They're used for such tools as
-- haddock, or ld.
[configUseResponseFiles] :: ConfigFlags -> 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.
[configAllowDependingOnPrivateLibs] :: ConfigFlags -> Flag Bool
-- | The list of libraries to be included in the hpc coverage report for
-- testsuites run with --enable-coverage. Notably, this list
-- must exclude indefinite libraries and instantiations because HPC does
-- not support backpack (Nov. 2023).
[configCoverageFor] :: ConfigFlags -> Flag [UnitId]
-- | When this flag is set, all tools declared in `build-tool`s and
-- `build-tool-depends` will be ignored. This allows a Cabal package with
-- build-tool-dependencies to be built even if the tool is not found.
[configIgnoreBuildTools] :: ConfigFlags -> Flag Bool
pattern ConfigCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> ConfigFlags
emptyConfigFlags :: ConfigFlags
defaultConfigFlags :: ProgramDb -> ConfigFlags
configureCommand :: ProgramDb -> CommandUI ConfigFlags
-- | More convenient version of configPrograms. Results in an
-- error if internal invariant is violated.
configPrograms :: WithCallStack (ConfigFlags -> ProgramDb)
-- | Parse a PackageDB stack entry
readPackageDb :: String -> Maybe PackageDB
readPackageDbList :: String -> [Maybe PackageDB]
-- | Show a PackageDB stack entry
showPackageDb :: Maybe PackageDB -> String
showPackageDbList :: [Maybe PackageDB] -> [String]
-- | Flags to copy: (destdir, copy-prefix (backwards compat),
-- verbosity)
data CopyFlags
CopyFlags :: !CommonSetupFlags -> Flag CopyDest -> CopyFlags
[copyCommonFlags] :: CopyFlags -> !CommonSetupFlags
[copyDest] :: CopyFlags -> Flag CopyDest
pattern CopyCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> CopyFlags
emptyCopyFlags :: CopyFlags
defaultCopyFlags :: CopyFlags
copyCommand :: CommandUI CopyFlags
-- | Flags to install: (package db, verbosity)
data InstallFlags
InstallFlags :: !CommonSetupFlags -> Flag PackageDB -> Flag CopyDest -> Flag Bool -> Flag Bool -> InstallFlags
[installCommonFlags] :: InstallFlags -> !CommonSetupFlags
[installPackageDB] :: InstallFlags -> Flag PackageDB
[installDest] :: InstallFlags -> Flag CopyDest
[installUseWrapper] :: InstallFlags -> Flag Bool
[installInPlace] :: InstallFlags -> Flag Bool
pattern InstallCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> InstallFlags
emptyInstallFlags :: InstallFlags
defaultInstallFlags :: InstallFlags
installCommand :: CommandUI InstallFlags
-- | When we build haddock documentation, there are two cases:
--
--
-- - 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
-- distdochtml/name.
-- - 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
-- distdochtml/id-docs.
--
data HaddockTarget
ForHackage :: HaddockTarget
ForDevelopment :: HaddockTarget
data HaddockFlags
HaddockFlags :: !CommonSetupFlags -> [(String, FilePath)] -> [(String, [String])] -> Flag Bool -> Flag Bool -> Flag String -> Flag HaddockTarget -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag FilePath -> Flag Bool -> Flag Bool -> Flag FilePath -> Flag PathTemplate -> Flag PathTemplate -> Flag Bool -> Flag String -> Flag String -> Flag FilePath -> Flag Bool -> HaddockFlags
[haddockCommonFlags] :: HaddockFlags -> !CommonSetupFlags
[haddockProgramPaths] :: HaddockFlags -> [(String, FilePath)]
[haddockProgramArgs] :: HaddockFlags -> [(String, [String])]
[haddockHoogle] :: HaddockFlags -> Flag Bool
[haddockHtml] :: HaddockFlags -> Flag Bool
[haddockHtmlLocation] :: HaddockFlags -> Flag String
[haddockForHackage] :: HaddockFlags -> Flag HaddockTarget
[haddockExecutables] :: HaddockFlags -> Flag Bool
[haddockTestSuites] :: HaddockFlags -> Flag Bool
[haddockBenchmarks] :: HaddockFlags -> Flag Bool
[haddockForeignLibs] :: HaddockFlags -> Flag Bool
[haddockInternal] :: HaddockFlags -> Flag Bool
[haddockCss] :: HaddockFlags -> Flag FilePath
[haddockLinkedSource] :: HaddockFlags -> Flag Bool
[haddockQuickJump] :: HaddockFlags -> Flag Bool
[haddockHscolourCss] :: HaddockFlags -> Flag FilePath
[haddockContents] :: HaddockFlags -> Flag PathTemplate
[haddockIndex] :: HaddockFlags -> Flag PathTemplate
[haddockKeepTempFiles] :: HaddockFlags -> Flag Bool
[haddockBaseUrl] :: HaddockFlags -> Flag String
[haddockResourcesDir] :: HaddockFlags -> Flag String
[haddockOutputDir] :: HaddockFlags -> Flag FilePath
[haddockUseUnicode] :: HaddockFlags -> Flag Bool
pattern HaddockCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> HaddockFlags
emptyHaddockFlags :: HaddockFlags
defaultHaddockFlags :: HaddockFlags
haddockCommand :: CommandUI HaddockFlags
-- | 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 :: Visibility
Hidden :: Visibility
data HaddockProjectFlags
HaddockProjectFlags :: Flag Bool -> Flag String -> Flag String -> Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)] -> [(String, FilePath)] -> [(String, [String])] -> Flag Bool -> Flag String -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag FilePath -> Flag FilePath -> Flag Bool -> Flag Verbosity -> Flag String -> Flag Bool -> HaddockProjectFlags
-- | 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`
[haddockProjectHackage] :: HaddockProjectFlags -> Flag Bool
-- | output directory of combined haddocks, the default is './haddocks'
[haddockProjectDir] :: HaddockProjectFlags -> Flag String
[haddockProjectPrologue] :: HaddockProjectFlags -> Flag String
-- | haddocksInterfaces is inferred by the
-- haddocksAction; currently not exposed to the user.
[haddockProjectInterfaces] :: HaddockProjectFlags -> Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
[haddockProjectProgramPaths] :: HaddockProjectFlags -> [(String, FilePath)]
[haddockProjectProgramArgs] :: HaddockProjectFlags -> [(String, [String])]
[haddockProjectHoogle] :: HaddockProjectFlags -> Flag Bool
[haddockProjectHtmlLocation] :: HaddockProjectFlags -> Flag String
[haddockProjectExecutables] :: HaddockProjectFlags -> Flag Bool
[haddockProjectTestSuites] :: HaddockProjectFlags -> Flag Bool
[haddockProjectBenchmarks] :: HaddockProjectFlags -> Flag Bool
[haddockProjectForeignLibs] :: HaddockProjectFlags -> Flag Bool
[haddockProjectInternal] :: HaddockProjectFlags -> Flag Bool
[haddockProjectCss] :: HaddockProjectFlags -> Flag FilePath
[haddockProjectHscolourCss] :: HaddockProjectFlags -> Flag FilePath
[haddockProjectKeepTempFiles] :: HaddockProjectFlags -> Flag Bool
[haddockProjectVerbosity] :: HaddockProjectFlags -> Flag Verbosity
[haddockProjectResourcesDir] :: HaddockProjectFlags -> Flag String
[haddockProjectUseUnicode] :: HaddockProjectFlags -> Flag Bool
emptyHaddockProjectFlags :: HaddockProjectFlags
defaultHaddockProjectFlags :: HaddockProjectFlags
haddockProjectCommand :: CommandUI HaddockProjectFlags
data HscolourFlags
HscolourFlags :: !CommonSetupFlags -> Flag FilePath -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> HscolourFlags
[hscolourCommonFlags] :: HscolourFlags -> !CommonSetupFlags
[hscolourCSS] :: HscolourFlags -> Flag FilePath
[hscolourExecutables] :: HscolourFlags -> Flag Bool
[hscolourTestSuites] :: HscolourFlags -> Flag Bool
[hscolourBenchmarks] :: HscolourFlags -> Flag Bool
[hscolourForeignLibs] :: HscolourFlags -> Flag Bool
pattern HscolourCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> HscolourFlags
emptyHscolourFlags :: HscolourFlags
defaultHscolourFlags :: HscolourFlags
hscolourCommand :: CommandUI HscolourFlags
data BuildFlags
BuildFlags :: !CommonSetupFlags -> [(String, FilePath)] -> [(String, [String])] -> Flag (Maybe Int) -> Flag String -> BuildFlags
[buildCommonFlags] :: BuildFlags -> !CommonSetupFlags
[buildProgramPaths] :: BuildFlags -> [(String, FilePath)]
[buildProgramArgs] :: BuildFlags -> [(String, [String])]
[buildNumJobs] :: BuildFlags -> Flag (Maybe Int)
[buildUseSemaphore] :: BuildFlags -> Flag String
pattern BuildCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> BuildFlags
emptyBuildFlags :: BuildFlags
defaultBuildFlags :: BuildFlags
buildCommand :: ProgramDb -> CommandUI BuildFlags
data DumpBuildInfo
NoDumpBuildInfo :: DumpBuildInfo
DumpBuildInfo :: DumpBuildInfo
data ReplFlags
ReplFlags :: !CommonSetupFlags -> [(String, FilePath)] -> [(String, [String])] -> Flag Bool -> ReplOptions -> ReplFlags
[replCommonFlags] :: ReplFlags -> !CommonSetupFlags
[replProgramPaths] :: ReplFlags -> [(String, FilePath)]
[replProgramArgs] :: ReplFlags -> [(String, [String])]
[replReload] :: ReplFlags -> Flag Bool
[replReplOptions] :: ReplFlags -> ReplOptions
pattern ReplCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> ReplFlags
defaultReplFlags :: ReplFlags
replCommand :: ProgramDb -> CommandUI ReplFlags
data ReplOptions
ReplOptions :: [String] -> Flag Bool -> Flag FilePath -> ReplOptions
[replOptionsFlags] :: ReplOptions -> [String]
[replOptionsNoLoad] :: ReplOptions -> Flag Bool
[replOptionsFlagOutput] :: ReplOptions -> Flag FilePath
data CleanFlags
CleanFlags :: !CommonSetupFlags -> Flag Bool -> CleanFlags
[cleanCommonFlags] :: CleanFlags -> !CommonSetupFlags
[cleanSaveConf] :: CleanFlags -> Flag Bool
pattern CleanCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> CleanFlags
emptyCleanFlags :: CleanFlags
defaultCleanFlags :: CleanFlags
cleanCommand :: CommandUI CleanFlags
-- | Flags to register and unregister: (user package,
-- gen-script, in-place, verbosity)
data RegisterFlags
RegisterFlags :: !CommonSetupFlags -> Flag PackageDB -> Flag Bool -> Flag (Maybe (SymbolicPath Pkg (Dir PkgConf))) -> Flag Bool -> Flag Bool -> RegisterFlags
[registerCommonFlags] :: RegisterFlags -> !CommonSetupFlags
[regPackageDB] :: RegisterFlags -> Flag PackageDB
[regGenScript] :: RegisterFlags -> Flag Bool
[regGenPkgConf] :: RegisterFlags -> Flag (Maybe (SymbolicPath Pkg (Dir PkgConf)))
[regInPlace] :: RegisterFlags -> Flag Bool
[regPrintId] :: RegisterFlags -> Flag Bool
pattern RegisterCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> RegisterFlags
emptyRegisterFlags :: RegisterFlags
defaultRegisterFlags :: RegisterFlags
registerCommand :: CommandUI RegisterFlags
unregisterCommand :: CommandUI RegisterFlags
-- | Flags to sdist: (snapshot, verbosity)
data SDistFlags
SDistFlags :: !CommonSetupFlags -> Flag Bool -> Flag FilePath -> Flag FilePath -> SDistFlags
[sDistCommonFlags] :: SDistFlags -> !CommonSetupFlags
[sDistSnapshot] :: SDistFlags -> Flag Bool
[sDistDirectory] :: SDistFlags -> Flag FilePath
[sDistListSources] :: SDistFlags -> Flag FilePath
pattern SDistCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> SDistFlags
emptySDistFlags :: SDistFlags
defaultSDistFlags :: SDistFlags
sdistCommand :: CommandUI SDistFlags
data TestFlags
TestFlags :: !CommonSetupFlags -> Flag PathTemplate -> Flag PathTemplate -> Flag TestShowDetails -> Flag Bool -> Flag FilePath -> Flag Bool -> [PathTemplate] -> TestFlags
[testCommonFlags] :: TestFlags -> !CommonSetupFlags
[testHumanLog] :: TestFlags -> Flag PathTemplate
[testMachineLog] :: TestFlags -> Flag PathTemplate
[testShowDetails] :: TestFlags -> Flag TestShowDetails
[testKeepTix] :: TestFlags -> Flag Bool
[testWrapper] :: TestFlags -> Flag FilePath
[testFailWhenNoTestSuites] :: TestFlags -> Flag Bool
[testOptions] :: TestFlags -> [PathTemplate]
pattern TestCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> TestFlags
emptyTestFlags :: TestFlags
defaultTestFlags :: TestFlags
testCommand :: CommandUI TestFlags
data TestShowDetails
Never :: TestShowDetails
Failures :: TestShowDetails
Always :: TestShowDetails
Streaming :: TestShowDetails
Direct :: TestShowDetails
data BenchmarkFlags
BenchmarkFlags :: !CommonSetupFlags -> [PathTemplate] -> BenchmarkFlags
[benchmarkCommonFlags] :: BenchmarkFlags -> !CommonSetupFlags
[benchmarkOptions] :: BenchmarkFlags -> [PathTemplate]
pattern BenchmarkCommonFlags :: Flag Verbosity -> Flag (SymbolicPath Pkg (Dir Dist)) -> Flag (SymbolicPath CWD (Dir Pkg)) -> Flag (SymbolicPath Pkg File) -> [String] -> BenchmarkFlags
emptyBenchmarkFlags :: BenchmarkFlags
defaultBenchmarkFlags :: BenchmarkFlags
benchmarkCommand :: CommandUI BenchmarkFlags
-- | The location prefix for the copy command.
data CopyDest
NoCopyDest :: CopyDest
CopyTo :: FilePath -> CopyDest
-- | when using the ${pkgroot} as prefix. The CopyToDb will adjust the
-- paths to be relative to the provided package database when copying /
-- installing.
CopyToDb :: FilePath -> CopyDest
-- | Arguments to pass to a configure script, e.g. generated by
-- autoconf.
configureArgs :: Bool -> ConfigFlags -> [String]
configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags]
configureCCompiler :: Verbosity -> ProgramDb -> IO (FilePath, [String])
configureLinker :: Verbosity -> ProgramDb -> IO (FilePath, [String])
buildOptions :: ProgramDb -> ShowOrParseArgs -> [OptionField BuildFlags]
haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags]
installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))]
testOptions' :: ShowOrParseArgs -> [OptionField TestFlags]
benchmarkOptions' :: ShowOrParseArgs -> [OptionField BenchmarkFlags]
-- | For each known program PROG in progDb, produce a
-- PROG-options OptionField.
programDbOptions :: ProgramDb -> ShowOrParseArgs -> (flags -> [(String, [String])]) -> ([(String, [String])] -> flags -> flags) -> [OptionField flags]
-- | Like programDbPaths, but allows to customise the option name.
programDbPaths' :: (String -> String) -> ProgramDb -> ShowOrParseArgs -> (flags -> [(String, FilePath)]) -> ([(String, FilePath)] -> flags -> flags) -> [OptionField flags]
programFlagsDescription :: ProgramDb -> String
replOptions :: ShowOrParseArgs -> [OptionField ReplOptions]
-- | 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]
defaultDistPref :: SymbolicPath Pkg (Dir Dist)
optionDistPref :: (flags -> Flag (SymbolicPath Pkg (Dir Dist))) -> (Flag (SymbolicPath Pkg (Dir Dist)) -> flags -> flags) -> ShowOrParseArgs -> OptionField flags
-- | All flags are monoids, they come in two flavours:
--
--
-- - list flags eg
--
--
--
-- --ghc-option=foo --ghc-option=bar
--
--
-- gives us all the values ["foo", "bar"]
--
--
-- - singular value flags, eg:
--
--
--
-- --enable-foo --disable-foo
--
--
-- gives us Just False
--
-- So, this Flag type is for the latter singular kind of flag. Its
-- monoid instance gives us the behaviour where it starts out as
-- NoFlag and later flags override earlier ones.
--
-- Isomorphic to Maybe a.
data Flag a
Flag :: a -> Flag a
NoFlag :: Flag a
-- | Wraps a value in Flag.
toFlag :: a -> Flag a
-- | Extracts a value from a Flag, and throws an exception on
-- NoFlag.
fromFlag :: WithCallStack (Flag a -> a)
-- | Extracts a value from a Flag, and returns the default value on
-- NoFlag.
fromFlagOrDefault :: a -> Flag a -> a
-- | Converts a Flag value to a Maybe value.
flagToMaybe :: Flag a -> Maybe a
-- | Converts a Flag value to a list.
flagToList :: Flag a -> [a]
-- | Converts a Maybe value to a Flag value.
maybeToFlag :: Maybe a -> Flag a
-- | Types that represent boolean flags.
class BooleanFlag a
asBool :: BooleanFlag a => a -> Bool
boolOpt :: SFlags -> SFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' :: OptFlags -> OptFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
optionVerbosity :: (flags -> Flag Verbosity) -> (Flag Verbosity -> flags -> flags) -> OptionField flags
-- | What kind of build phase are we doing/hooking into?
--
-- Is this a normal build, or is it perhaps for running an interactive
-- session or Haddock?
data BuildingWhat
-- | A normal build.
BuildNormal :: BuildFlags -> BuildingWhat
-- | Build steps for an interactive session.
BuildRepl :: ReplFlags -> BuildingWhat
-- | Build steps for generating documentation.
BuildHaddock :: HaddockFlags -> BuildingWhat
-- | Build steps for Hscolour.
BuildHscolour :: HscolourFlags -> BuildingWhat
buildingWhatCommonFlags :: BuildingWhat -> CommonSetupFlags
buildingWhatVerbosity :: BuildingWhat -> Verbosity
buildingWhatWorkingDir :: BuildingWhat -> Maybe (SymbolicPath CWD (Dir Pkg))
buildingWhatDistPref :: BuildingWhat -> SymbolicPath Pkg (Dir Dist)
instance GHC.Show.Show Distribution.Simple.Setup.BuildingWhat
instance GHC.Generics.Generic Distribution.Simple.Setup.BuildingWhat
instance Data.Binary.Class.Binary Distribution.Simple.Setup.BuildingWhat
instance Distribution.Utils.Structured.Structured Distribution.Simple.Setup.BuildingWhat
module Distribution.Simple.Build.Inputs
-- | The information required for a build computation which is available
-- right before building each component, i.e. the pre-build component
-- inputs.
data PreBuildComponentInputs
PreBuildComponentInputs :: BuildingWhat -> LocalBuildInfo -> TargetInfo -> PreBuildComponentInputs
-- | What kind of build are we doing?
[buildingWhat] :: PreBuildComponentInputs -> BuildingWhat
-- | Information about the package
[localBuildInfo] :: PreBuildComponentInputs -> LocalBuildInfo
-- | Information about an individual component
[targetInfo] :: PreBuildComponentInputs -> TargetInfo
-- | Get the Verbosity from the context the component being
-- built is in.
buildVerbosity :: PreBuildComponentInputs -> Verbosity
-- | Get the Component being built.
buildComponent :: PreBuildComponentInputs -> Component
-- | Is the Component being built a
-- Library?
buildIsLib :: PreBuildComponentInputs -> Bool
-- | Get the ComponentLocalBuildInfo for the component
-- being built.
buildCLBI :: PreBuildComponentInputs -> ComponentLocalBuildInfo
-- | Get the BuildInfo of the component being built.
buildBI :: PreBuildComponentInputs -> BuildInfo
-- | Get the Compiler being used to build the component.
buildCompiler :: PreBuildComponentInputs -> Compiler
-- | What kind of build phase are we doing/hooking into?
--
-- Is this a normal build, or is it perhaps for running an interactive
-- session or Haddock?
data BuildingWhat
-- | A normal build.
BuildNormal :: BuildFlags -> BuildingWhat
-- | Build steps for an interactive session.
BuildRepl :: ReplFlags -> BuildingWhat
-- | Build steps for generating documentation.
BuildHaddock :: HaddockFlags -> BuildingWhat
-- | Build steps for Hscolour.
BuildHscolour :: HscolourFlags -> BuildingWhat
-- | Data cached after configuration step. See also ConfigFlags.
data LocalBuildInfo
NewLocalBuildInfo :: LocalBuildDescr -> LocalBuildConfig -> LocalBuildInfo
-- | Information about a package determined by Cabal after the
-- configuration step.
[$sel:localBuildDescr:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildDescr
-- | Information about a package configuration that can be modified by the
-- user at configuration time.
[$sel:localBuildConfig:NewLocalBuildInfo] :: LocalBuildInfo -> LocalBuildConfig
-- | This pattern synonym is for backwards compatibility, to adapt to
-- LocalBuildInfo being split into LocalBuildDescr and
-- LocalBuildConfig.
pattern LocalBuildInfo :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> [String] -> InstallDirTemplates -> Compiler -> Platform -> Maybe (SymbolicPath Pkg File) -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> Map (PackageName, ComponentName) PromisedComponent -> InstalledPackageIndex -> PackageDescription -> ProgramDb -> PackageDBStack -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> [UnitId] -> Bool -> LocalBuildInfo
-- | The TargetInfo contains all the information necessary to build
-- a specific target (e.g., componentmodulefile) in a package. In
-- principle, one can get the Component from a
-- ComponentLocalBuildInfo and LocalBuildInfo, but it is
-- much more convenient to have the component in hand.
data TargetInfo
TargetInfo :: ComponentLocalBuildInfo -> Component -> TargetInfo
[targetCLBI] :: TargetInfo -> ComponentLocalBuildInfo
[targetComponent] :: TargetInfo -> Component
buildingWhatCommonFlags :: BuildingWhat -> CommonSetupFlags
buildingWhatVerbosity :: BuildingWhat -> Verbosity
buildingWhatWorkingDir :: BuildingWhat -> Maybe (SymbolicPath CWD (Dir Pkg))
buildingWhatDistPref :: BuildingWhat -> SymbolicPath Pkg (Dir Dist)
-- | Handling for user-specified build targets
module Distribution.Simple.BuildTarget
-- | Take a list of String build targets, and parse and validate
-- them into actual TargetInfos to be
-- builtregisteredwhatever.
readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo]
-- | Read a list of user-supplied build target strings and resolve them to
-- BuildTargets according to a PackageDescription. If there
-- are problems with any of the targets e.g. they don't exist or are
-- misformatted, throw an IOException.
readBuildTargets :: Verbosity -> PackageDescription -> [String] -> IO [BuildTarget]
-- | A fully resolved build target.
data BuildTarget
-- | A specific component
BuildTargetComponent :: ComponentName -> BuildTarget
-- | A specific module within a specific component.
BuildTargetModule :: ComponentName -> ModuleName -> BuildTarget
-- | A specific file within a specific component.
BuildTargetFile :: ComponentName -> FilePath -> BuildTarget
-- | Unambiguously render a BuildTarget, so that it can be parsed in
-- all situations.
showBuildTarget :: PackageId -> BuildTarget -> String
data QualLevel
QL1 :: QualLevel
QL2 :: QualLevel
QL3 :: QualLevel
buildTargetComponentName :: BuildTarget -> ComponentName
-- | Various ways that a user may specify a build target.
data UserBuildTarget
readUserBuildTargets :: [String] -> ([UserBuildTargetProblem], [UserBuildTarget])
showUserBuildTarget :: UserBuildTarget -> String
data UserBuildTargetProblem
UserBuildTargetUnrecognised :: String -> UserBuildTargetProblem
reportUserBuildTargetProblems :: Verbosity -> [UserBuildTargetProblem] -> IO ()
-- | Given a bunch of user-specified targets, try to resolve what it is
-- they refer to.
resolveBuildTargets :: PackageDescription -> [(UserBuildTarget, Bool)] -> ([BuildTargetProblem], [BuildTarget])
data BuildTargetProblem
-- |
-- - expected thing (actually got)
--
BuildTargetExpected :: UserBuildTarget -> [String] -> String -> BuildTargetProblem
-- |
-- - (no such thing, actually got)
--
BuildTargetNoSuch :: UserBuildTarget -> [(String, String)] -> BuildTargetProblem
BuildTargetAmbiguous :: UserBuildTarget -> [(UserBuildTarget, BuildTarget)] -> BuildTargetProblem
reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO ()
instance GHC.Classes.Ord Distribution.Simple.BuildTarget.UserBuildTarget
instance GHC.Classes.Eq Distribution.Simple.BuildTarget.UserBuildTarget
instance GHC.Show.Show Distribution.Simple.BuildTarget.UserBuildTarget
instance GHC.Generics.Generic Distribution.Simple.BuildTarget.BuildTarget
instance GHC.Show.Show Distribution.Simple.BuildTarget.BuildTarget
instance GHC.Classes.Eq Distribution.Simple.BuildTarget.BuildTarget
instance GHC.Show.Show Distribution.Simple.BuildTarget.UserBuildTargetProblem
instance GHC.Show.Show Distribution.Simple.BuildTarget.BuildTargetProblem
instance GHC.Show.Show Distribution.Simple.BuildTarget.QualLevel
instance GHC.Enum.Enum Distribution.Simple.BuildTarget.QualLevel
instance GHC.Enum.Bounded Distribution.Simple.BuildTarget.ComponentKind
instance GHC.Enum.Enum Distribution.Simple.BuildTarget.ComponentKind
instance GHC.Show.Show Distribution.Simple.BuildTarget.ComponentKind
instance GHC.Classes.Ord Distribution.Simple.BuildTarget.ComponentKind
instance GHC.Classes.Eq Distribution.Simple.BuildTarget.ComponentKind
instance GHC.Classes.Eq Distribution.Simple.BuildTarget.MatchError
instance GHC.Show.Show Distribution.Simple.BuildTarget.MatchError
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.BuildTarget.Match a)
instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.BuildTarget.MaybeAmbiguous a)
instance GHC.Base.Alternative Distribution.Simple.BuildTarget.Match
instance GHC.Base.MonadPlus Distribution.Simple.BuildTarget.Match
instance GHC.Base.Functor Distribution.Simple.BuildTarget.Match
instance GHC.Base.Applicative Distribution.Simple.BuildTarget.Match
instance GHC.Base.Monad Distribution.Simple.BuildTarget.Match
instance Data.Binary.Class.Binary Distribution.Simple.BuildTarget.BuildTarget
-- | A bunch of dirs, paths and file names used for intermediate build
-- steps.
module Distribution.Simple.BuildPaths
defaultDistPref :: SymbolicPath Pkg (Dir Dist)
srcPref :: FilePath -> FilePath
-- | Build info json file, generated in every build
buildInfoPref :: SymbolicPath root (Dir Dist) -> SymbolicPath root File
-- | This is the name of the directory in which the generated haddocks
-- should be stored. It does not include the
-- distdochtml prefix.
--
-- It is also used by `haddock-project` when constructing its output
-- directory.
haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
-- | This is the name of the directory in which the generated haddocks for
-- a (sub)library should be stored. It does not include the
-- distdochtml prefix.
--
-- It is also used by `haddock-project` when constructing its output
-- directory.
haddockLibraryDirPath :: HaddockTarget -> PackageDescription -> Library -> FilePath
haddockTestDirPath :: HaddockTarget -> PackageDescription -> TestSuite -> FilePath
haddockBenchmarkDirPath :: HaddockTarget -> PackageDescription -> Benchmark -> FilePath
hscolourPref :: HaddockTarget -> SymbolicPath root (Dir Dist) -> PackageDescription -> SymbolicPath root (Dir Artifacts)
-- | The directory to which generated haddock documentation should be
-- written.
haddockPref :: HaddockTarget -> SymbolicPath root (Dir Dist) -> PackageDescription -> SymbolicPath root (Dir Artifacts)
-- | The directory in which we put auto-generated modules for EVERY
-- component in the package.
autogenPackageModulesDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Source)
-- | The directory in which we put auto-generated modules for a particular
-- component.
autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Source)
-- | The name of the auto-generated Paths_* module associated with a
-- package
autogenPathsModuleName :: PackageDescription -> ModuleName
-- | The name of the auto-generated PackageInfo_* module associated with a
-- package
autogenPackageInfoModuleName :: PackageDescription -> ModuleName
cppHeaderName :: String
haddockPath :: PackageDescription -> FilePath
-- | A name of a (sub)library used by haddock, in the form
-- `package:library` if it is a sublibrary, or
-- `package` if it is the main library.
--
-- Used by `haddock-project` and Haddock.
haddockPackageLibraryName :: PackageDescription -> Library -> String
haddockPackageLibraryName' :: PackageName -> LibraryName -> String
-- | A name of a (sub)library used by haddock.
haddockLibraryName :: PackageDescription -> Library -> String
-- | File path of the ".haddock" file.
haddockLibraryPath :: PackageDescription -> Library -> FilePath
-- | Create a library name for a static library from a given name. Prepends
-- lib and appends the static library extension (.a).
mkGenericStaticLibName :: String -> String
mkLibName :: UnitId -> String
mkProfLibName :: UnitId -> String
-- | Create a library name for a shared library from a given name. Prepends
-- lib and appends the
-- -<compilerFlavour><compilerVersion> as well as
-- the shared library extension.
mkGenericSharedLibName :: Platform -> CompilerId -> String -> String
mkSharedLibName :: Platform -> CompilerId -> UnitId -> String
mkProfSharedLibName :: Platform -> CompilerId -> UnitId -> String
mkStaticLibName :: Platform -> CompilerId -> UnitId -> String
-- | Create a library name for a bundled shared library from a given name.
-- This matches the naming convention for shared libraries as implemented
-- in GHC's packageHsLibs function in the Packages module. If the given
-- name is prefixed with HS, then this prepends lib and appends
-- the compiler flavour/version and shared library extension e.g.:
-- "HSrts-1.0" -> "libHSrts-1.0-ghc8.7.20190109.so" Otherwise the
-- given name should be prefixed with C, then this strips the
-- C, prepends lib and appends the shared library
-- extension e.g.: Cffi -> "libffi.so"
mkGenericSharedBundledLibName :: Platform -> CompilerId -> String -> String
-- | Default extension for executable files on the current platform.
-- (typically "" on Unix and "exe" on Windows or OS/2)
exeExtension :: Platform -> String
-- | Extension for object files. For GHC the extension is "o".
objExtension :: String
-- | Extension for dynamically linked (or shared) libraries (typically
-- "so" on Unix and "dll" on Windows)
dllExtension :: Platform -> String
-- | Extension for static libraries
--
-- TODO: Here, as well as in dllExtension, it's really the target OS that
-- we're interested in, not the build OS.
staticLibExtension :: Platform -> String
getSourceFiles :: Verbosity -> Maybe (SymbolicPath CWD ('Dir Pkg)) -> [SymbolicPathX allowAbsolute Pkg (Dir Source)] -> [ModuleName] -> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg File)]
getLibSourceFiles :: Verbosity -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO [(ModuleName, SymbolicPath Pkg File)]
getExeSourceFiles :: Verbosity -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO [(ModuleName, SymbolicPath Pkg 'File)]
getTestSourceFiles :: Verbosity -> LocalBuildInfo -> TestSuite -> ComponentLocalBuildInfo -> IO [(ModuleName, SymbolicPath Pkg 'File)]
getBenchmarkSourceFiles :: Verbosity -> LocalBuildInfo -> Benchmark -> ComponentLocalBuildInfo -> IO [(ModuleName, SymbolicPath Pkg 'File)]
getFLibSourceFiles :: Verbosity -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO [(ModuleName, SymbolicPath Pkg File)]
-- | The directory where we put build results for an executable
exeBuildDir :: LocalBuildInfo -> Executable -> SymbolicPath Pkg (Dir Build)
-- | The directory where we put build results for a foreign library
flibBuildDir :: LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg (Dir Build)
-- | The name of the stub executable associated with a library
-- TestSuite.
stubName :: TestSuite -> FilePath
-- | The directory where we put build results for a test suite
testBuildDir :: LocalBuildInfo -> TestSuite -> SymbolicPath Pkg (Dir Build)
-- | The directory where we put build results for a benchmark suite
benchmarkBuildDir :: LocalBuildInfo -> Benchmark -> SymbolicPath Pkg (Dir Build)
-- | This module contains most of the UHC-specific code for configuring,
-- building and installing packages.
--
-- Thanks to the authors of the other implementation-specific files, in
-- particular to Isaac Jones, Duncan Coutts and Henning Thielemann, for
-- inspiration on how to design this module.
module Distribution.Simple.UHC
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
getInstalledPackages :: Verbosity -> Compiler -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO ()
installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO ()
registerPackage :: Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> Compiler -> ProgramDb -> PackageDBStackS from -> InstalledPackageInfo -> IO ()
inplacePackageDbPath :: LocalBuildInfo -> SymbolicPath Pkg (Dir PkgDB)
module Distribution.Simple.Test.LibV09
runTest :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> HPCMarkupInfo -> TestFlags -> TestSuite -> IO TestSuiteLog
-- | Source code for library test suite stub executable
simpleTestStub :: ModuleName -> String
-- | The filename of the source file for the stub executable associated
-- with a library TestSuite.
stubFilePath :: TestSuite -> FilePath
-- | Main function for test stubs. Once, it was written directly into the
-- stub, but minimizing the amount of code actually in the stub maximizes
-- the number of detectable errors when Cabal is compiled.
stubMain :: IO [Test] -> IO ()
-- | The name of the stub executable associated with a library
-- TestSuite.
stubName :: TestSuite -> FilePath
-- | From a test stub, write the TestSuiteLog to temporary file for
-- the calling Cabal process to read.
stubWriteLog :: FilePath -> UnqualComponentName -> TestLogs -> IO ()
-- | Write the source file for a library TestSuite stub
-- executable.
writeSimpleTestStub :: TestSuite -> FilePath -> IO ()
module Distribution.Simple.Test.ExeV10
runTest :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> HPCMarkupInfo -> TestFlags -> TestSuite -> IO TestSuiteLog
-- | Internal implementation module. Users of build-type: Hooks
-- should import Distribution.Simple.SetupHooks instead.
module Distribution.Simple.SetupHooks.Internal
-- | Hooks into the cabal build phases.
--
-- Usage:
--
--
-- - In your .cabal file, declare build-type: Hooks
-- (with a cabal-version greater than or equal to
-- 3.14),
-- - In your .cabal file, include a custom-setup
-- stanza which declares the dependencies of your SetupHooks
-- module; this will usually contain a dependency on the
-- Cabal-hooks package.
-- - Provide a SetupHooks.hs module next to your
-- .cabal file; it must export setupHooks ::
-- SetupHooks.
--
data SetupHooks
SetupHooks :: ConfigureHooks -> BuildHooks -> InstallHooks -> SetupHooks
-- | Hooks into the configure phase.
[$sel:configureHooks:SetupHooks] :: SetupHooks -> ConfigureHooks
-- | Hooks into the build phase.
--
-- These hooks are relevant to any build-like phase, such as repl or
-- haddock.
[$sel:buildHooks:SetupHooks] :: SetupHooks -> BuildHooks
-- | Hooks into the copy/install phase.
[$sel:installHooks:SetupHooks] :: SetupHooks -> InstallHooks
-- | Empty hooks.
noSetupHooks :: SetupHooks
-- | Configure-time hooks.
--
-- Order of execution:
--
--
data ConfigureHooks
ConfigureHooks :: Maybe PreConfPackageHook -> Maybe PostConfPackageHook -> Maybe PreConfComponentHook -> ConfigureHooks
-- | Package-wide pre-configure hook. See PreConfPackageHook.
[$sel:preConfPackageHook:ConfigureHooks] :: ConfigureHooks -> Maybe PreConfPackageHook
-- | Package-wide post-configure hook. See PostConfPackageHook.
[$sel:postConfPackageHook:ConfigureHooks] :: ConfigureHooks -> Maybe PostConfPackageHook
-- | Per-component pre-configure hook. See PreConfComponentHook.
[$sel:preConfComponentHook:ConfigureHooks] :: ConfigureHooks -> Maybe PreConfComponentHook
-- | Empty configure phase hooks.
noConfigureHooks :: ConfigureHooks
-- | Inputs to the package-wide pre-configure step.
data PreConfPackageInputs
PreConfPackageInputs :: ConfigFlags -> LocalBuildConfig -> Compiler -> Platform -> PreConfPackageInputs
[$sel:configFlags:PreConfPackageInputs] :: PreConfPackageInputs -> ConfigFlags
-- | Warning: the ProgramDb in the LocalBuildInfo field will
-- not contain any unconfigured programs.
[$sel:localBuildConfig:PreConfPackageInputs] :: PreConfPackageInputs -> LocalBuildConfig
[$sel:compiler:PreConfPackageInputs] :: PreConfPackageInputs -> Compiler
[$sel:platform:PreConfPackageInputs] :: PreConfPackageInputs -> Platform
-- | Outputs of the package-wide pre-configure step.
--
-- Prefer using noPreConfPackageOutputs and overriding the fields
-- you care about, to avoid depending on implementation details of this
-- datatype.
data PreConfPackageOutputs
PreConfPackageOutputs :: BuildOptions -> ConfiguredProgs -> PreConfPackageOutputs
[$sel:buildOptions:PreConfPackageOutputs] :: PreConfPackageOutputs -> BuildOptions
[$sel:extraConfiguredProgs:PreConfPackageOutputs] :: PreConfPackageOutputs -> ConfiguredProgs
-- | Use this smart constructor to declare an empty set of changes by the
-- package-wide pre-configure hook, and override the fields you care
-- about.
--
-- Use this rather than PreConfPackageOutputs to avoid relying on
-- internal implementation details of the latter.
noPreConfPackageOutputs :: PreConfPackageInputs -> PreConfPackageOutputs
type PreConfPackageHook = PreConfPackageInputs -> IO PreConfPackageOutputs
-- | Inputs to the package-wide post-configure step.
data PostConfPackageInputs
PostConfPackageInputs :: LocalBuildConfig -> PackageBuildDescr -> PostConfPackageInputs
[$sel:localBuildConfig:PostConfPackageInputs] :: PostConfPackageInputs -> LocalBuildConfig
[$sel:packageBuildDescr:PostConfPackageInputs] :: PostConfPackageInputs -> PackageBuildDescr
-- | Package-wide post-configure step.
--
-- Perform side effects. Last opportunity for any package-wide logic; any
-- subsequent hooks work per-component.
type PostConfPackageHook = PostConfPackageInputs -> IO ()
-- | Inputs to the per-component pre-configure step.
data PreConfComponentInputs
PreConfComponentInputs :: LocalBuildConfig -> PackageBuildDescr -> Component -> PreConfComponentInputs
[$sel:localBuildConfig:PreConfComponentInputs] :: PreConfComponentInputs -> LocalBuildConfig
[$sel:packageBuildDescr:PreConfComponentInputs] :: PreConfComponentInputs -> PackageBuildDescr
[$sel:component:PreConfComponentInputs] :: PreConfComponentInputs -> Component
-- | Outputs of the per-component pre-configure step.
--
-- Prefer using noPreComponentOutputs and overriding the fields
-- you care about, to avoid depending on implementation details of this
-- datatype.
data PreConfComponentOutputs
PreConfComponentOutputs :: ComponentDiff -> PreConfComponentOutputs
[$sel:componentDiff:PreConfComponentOutputs] :: PreConfComponentOutputs -> ComponentDiff
-- | Use this smart constructor to declare an empty set of changes by a
-- per-component pre-configure hook, and override the fields you care
-- about.
--
-- Use this rather than PreConfComponentOutputs to avoid relying
-- on internal implementation details of the latter.
noPreConfComponentOutputs :: PreConfComponentInputs -> PreConfComponentOutputs
-- | Per-component pre-configure step.
--
-- For each component of the package, this hook can perform side effects,
-- and return a diff to the passed in component, e.g. to declare
-- additional autogenerated modules.
type PreConfComponentHook = PreConfComponentInputs -> IO PreConfComponentOutputs
-- | A diff to a Cabal Component, that gets combined monoidally into
-- an existing Component.
newtype ComponentDiff
ComponentDiff :: Component -> ComponentDiff
[$sel:componentDiff:ComponentDiff] :: ComponentDiff -> Component
emptyComponentDiff :: ComponentName -> ComponentDiff
buildInfoComponentDiff :: ComponentName -> BuildInfo -> ComponentDiff
type LibraryDiff = Library
type ForeignLibDiff = ForeignLib
type ExecutableDiff = Executable
type TestSuiteDiff = TestSuite
type BenchmarkDiff = Benchmark
type BuildInfoDiff = BuildInfo
-- | Build-time hooks.
data BuildHooks
BuildHooks :: Maybe PreBuildComponentRules -> Maybe PostBuildComponentHook -> BuildHooks
-- | Per-component fine-grained pre-build rules.
[$sel:preBuildComponentRules:BuildHooks] :: BuildHooks -> Maybe PreBuildComponentRules
-- | Per-component post-build hook.
[$sel:postBuildComponentHook:BuildHooks] :: BuildHooks -> Maybe PostBuildComponentHook
-- | Empty build hooks.
noBuildHooks :: BuildHooks
-- | What kind of build phase are we doing/hooking into?
--
-- Is this a normal build, or is it perhaps for running an interactive
-- session or Haddock?
data BuildingWhat
-- | A normal build.
BuildNormal :: BuildFlags -> BuildingWhat
-- | Build steps for an interactive session.
BuildRepl :: ReplFlags -> BuildingWhat
-- | Build steps for generating documentation.
BuildHaddock :: HaddockFlags -> BuildingWhat
-- | Build steps for Hscolour.
BuildHscolour :: HscolourFlags -> BuildingWhat
buildingWhatVerbosity :: BuildingWhat -> Verbosity
buildingWhatWorkingDir :: BuildingWhat -> Maybe (SymbolicPath CWD (Dir Pkg))
buildingWhatDistPref :: BuildingWhat -> SymbolicPath Pkg (Dir Dist)
data PreBuildComponentInputs
PreBuildComponentInputs :: BuildingWhat -> LocalBuildInfo -> TargetInfo -> PreBuildComponentInputs
-- | what kind of build phase are we hooking into?
[$sel:buildingWhat:PreBuildComponentInputs] :: PreBuildComponentInputs -> BuildingWhat
-- | information about the package
[$sel:localBuildInfo:PreBuildComponentInputs] :: PreBuildComponentInputs -> LocalBuildInfo
-- | information about an individual component
[$sel:targetInfo:PreBuildComponentInputs] :: PreBuildComponentInputs -> TargetInfo
type PreBuildComponentRules = Rules PreBuildComponentInputs
data PostBuildComponentInputs
PostBuildComponentInputs :: BuildFlags -> LocalBuildInfo -> TargetInfo -> PostBuildComponentInputs
[$sel:buildFlags:PostBuildComponentInputs] :: PostBuildComponentInputs -> BuildFlags
[$sel:localBuildInfo:PostBuildComponentInputs] :: PostBuildComponentInputs -> LocalBuildInfo
[$sel:targetInfo:PostBuildComponentInputs] :: PostBuildComponentInputs -> TargetInfo
type PostBuildComponentHook = PostBuildComponentInputs -> IO ()
-- | Copy/install hooks.
data InstallHooks
InstallHooks :: Maybe InstallComponentHook -> InstallHooks
-- | Per-component install hook.
[$sel:installComponentHook:InstallHooks] :: InstallHooks -> Maybe InstallComponentHook
-- | Empty copy/install hooks.
noInstallHooks :: InstallHooks
data InstallComponentInputs
InstallComponentInputs :: CopyFlags -> LocalBuildInfo -> TargetInfo -> InstallComponentInputs
[$sel:copyFlags:InstallComponentInputs] :: InstallComponentInputs -> CopyFlags
[$sel:localBuildInfo:InstallComponentInputs] :: InstallComponentInputs -> LocalBuildInfo
[$sel:targetInfo:InstallComponentInputs] :: InstallComponentInputs -> TargetInfo
-- | A per-component install hook, which can only perform side effects
-- (e.g. copying files).
type InstallComponentHook = InstallComponentInputs -> IO ()
applyComponentDiffs :: Verbosity -> (Component -> IO (Maybe ComponentDiff)) -> PackageDescription -> IO PackageDescription
forComponents_ :: PackageDescription -> (Component -> IO ()) -> IO ()
-- | Run all pre-build rules.
--
-- This function should only be called internally within Cabal,
-- as it is used to implement the (legacy) Setup.hs interface. The build
-- tool (e.g. cabal-install or hls) should instead go
-- through the separate hooks executable, which allows us to only rerun
-- the out-of-date rules (instead of running all of these rules at once).
executeRules :: Verbosity -> LocalBuildInfo -> TargetInfo -> Map RuleId Rule -> IO ()
hookedBuildInfoComponents :: HookedBuildInfo -> Set ComponentName
hookedBuildInfoComponentDiff_maybe :: HookedBuildInfo -> ComponentName -> Maybe (IO ComponentDiff)
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PreConfPackageInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PreConfPackageInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PreConfPackageOutputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PreConfPackageOutputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PostConfPackageInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PostConfPackageInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PreConfComponentInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PreConfComponentInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PreBuildComponentInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PreBuildComponentInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PostBuildComponentInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PostBuildComponentInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.InstallComponentInputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.InstallComponentInputs
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.ComponentDiff
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.ComponentDiff
instance GHC.Show.Show Distribution.Simple.SetupHooks.Internal.PreConfComponentOutputs
instance GHC.Generics.Generic Distribution.Simple.SetupHooks.Internal.PreConfComponentOutputs
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.ComponentDiff
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.ComponentDiff
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.SetupHooks
instance GHC.Base.Monoid Distribution.Simple.SetupHooks.Internal.SetupHooks
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.ConfigureHooks
instance GHC.Base.Monoid Distribution.Simple.SetupHooks.Internal.ConfigureHooks
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.PreConfComponentSemigroup
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PreConfComponentOutputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PreConfComponentOutputs
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.InstallHooks
instance GHC.Base.Monoid Distribution.Simple.SetupHooks.Internal.InstallHooks
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.InstallComponentInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.InstallComponentInputs
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.BuildHooks
instance GHC.Base.Monoid Distribution.Simple.SetupHooks.Internal.BuildHooks
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PostBuildComponentInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PostBuildComponentInputs
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PreBuildComponentInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PreBuildComponentInputs
instance GHC.Base.Semigroup Distribution.Simple.SetupHooks.Internal.PreConfPkgSemigroup
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PreConfComponentInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PreConfComponentInputs
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PostConfPackageInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PostConfPackageInputs
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PreConfPackageOutputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PreConfPackageOutputs
instance Data.Binary.Class.Binary Distribution.Simple.SetupHooks.Internal.PreConfPackageInputs
instance Distribution.Utils.Structured.Structured Distribution.Simple.SetupHooks.Internal.PreConfPackageInputs
module Distribution.Simple.HaskellSuite
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe CompilerFlag)]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, CompilerFlag)]
getInstalledPackages :: Verbosity -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO ()
registerPackage :: Verbosity -> ProgramDb -> PackageDBStackS from -> InstalledPackageInfo -> IO ()
initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()
packageDbOpt :: PackageDBX (SymbolicPath from (Dir PkgDB)) -> String
module Distribution.Simple.GHCJS
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
-- | Get the packages from specific PackageDBs, not cumulative.
getInstalledPackagesMonitorFiles :: Verbosity -> Platform -> Maybe (SymbolicPath CWD (Dir Pkg)) -> ProgramDb -> [PackageDB] -> IO [FilePath]
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
buildLib :: Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
-- | Build a foreign library
buildFLib :: Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO ()
-- | Build an executable with GHC.
buildExe :: Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO ()
replLib :: [String] -> Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
replFLib :: [String] -> Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO ()
replExe :: [String] -> Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO ()
-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
-- | Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO ()
-- | Install foreign library for GHC.
installFLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> PackageDescription -> ForeignLib -> IO ()
-- | Install executables for GHCJS.
installExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO ()
-- | Extracts a String representing a hash of the ABI of a built library.
-- It can fail if the library has not yet been built.
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO String
hcPkgInfo :: ProgramDb -> HcPkgInfo
registerPackage :: Verbosity -> ProgramDb -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackS from -> InstalledPackageInfo -> RegisterOptions -> IO ()
componentGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir build) -> GhcOptions
componentCcGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Artifacts) -> SymbolicPath Pkg File -> GhcOptions
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
isDynamic :: Compiler -> Bool
-- | Return the FilePath to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
-- | Get the JavaScript file name and command and arguments to run a
-- program compiled by GHCJS the exe should be the base program name
-- without exe extension
runCmd :: ProgramDb -> FilePath -> (FilePath, FilePath, [String])
-- | The kinds of entries we can stick in a .ghc.environment file.
data GhcEnvironmentFileEntry fp
-- |
-- -- a comment
--
GhcEnvFileComment :: String -> GhcEnvironmentFileEntry fp
-- |
-- package-id foo-1.0-4fe301a...
--
GhcEnvFilePackageId :: UnitId -> GhcEnvironmentFileEntry fp
-- | global-package-db, user-package-db or package-db
-- blahpackage.conf.d
GhcEnvFilePackageDb :: PackageDBX fp -> GhcEnvironmentFileEntry fp
-- |
-- clear-package-db
--
GhcEnvFileClearPackageDbStack :: GhcEnvironmentFileEntry fp
-- | Make entries for a GHC environment file based on a
-- PackageDBStack and a bunch of package (unit) ids.
--
-- If you need to do anything more complicated then either use this as a
-- basis and add more entries, or just make all the entries directly.
simpleGhcEnvironmentFile :: PackageDBStackX fp -> [UnitId] -> [GhcEnvironmentFileEntry fp]
-- | Render a bunch of GHC environment file entries
renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry FilePath] -> String
-- | Write a .ghc.environment-$arch-$os-$ver file in the given
-- directory.
--
-- The Platform and GHC Version are needed as part of the
-- file name.
--
-- Returns the name of the file written.
writeGhcEnvironmentFile :: FilePath -> Platform -> Version -> [GhcEnvironmentFileEntry FilePath] -> IO FilePath
-- | GHC's rendering of its platform and compiler version string as used in
-- certain file locations (such as user package db location). For example
-- x86_64-linux-7.10.4
ghcPlatformAndVersionString :: Platform -> Version -> String
readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry FilePath]
parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry FilePath]
newtype ParseErrorExc
ParseErrorExc :: ParseError -> ParseErrorExc
getImplInfo :: Compiler -> GhcImplInfo
-- | Information about features and quirks of a GHC-based implementation.
--
-- Compiler flavors based on GHC behave similarly enough that some of the
-- support code for them is shared. Every implementation has its own
-- peculiarities, that may or may not be a direct result of the
-- underlying GHC version. This record keeps track of these differences.
--
-- All shared code (i.e. everything not in the Distribution.Simple.FLAVOR
-- module) should use implementation info rather than version numbers to
-- test for supported features.
data GhcImplInfo
GhcImplInfo :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> GhcImplInfo
-- |
-- - XHaskell2010 and -XHaskell98 flags
--
[supportsHaskell2010] :: GhcImplInfo -> Bool
-- |
[supportsGHC2021] :: GhcImplInfo -> Bool
-- |
[supportsGHC2024] :: GhcImplInfo -> Bool
-- |
-- - -supported-languages gives Ext and NoExt
--
[reportsNoExt] :: GhcImplInfo -> Bool
-- | NondecreasingIndentation is always on
[alwaysNondecIndent] :: GhcImplInfo -> Bool
-- |
-- - ghci-script flag supported
--
[flagGhciScript] :: GhcImplInfo -> Bool
-- | new style -fprof-auto* flags
[flagProfAuto] :: GhcImplInfo -> Bool
-- | fprof-late flag
[flagProfLate] :: GhcImplInfo -> Bool
-- | use package-conf instead of package-db
[flagPackageConf] :: GhcImplInfo -> Bool
-- |
[flagDebugInfo] :: GhcImplInfo -> Bool
-- |
-- - hiedir flag supported
--
[flagHie] :: GhcImplInfo -> Bool
-- | supports numeric -g levels
[supportsDebugLevels] :: GhcImplInfo -> Bool
-- | picks up .ghc.environment files
[supportsPkgEnvFiles] :: GhcImplInfo -> Bool
-- |
-- - Wmissing-home-modules is supported
--
[flagWarnMissingHomeModules] :: GhcImplInfo -> Bool
-- | Pass -this-unit-id flag when building executables
[unitIdForExes] :: GhcImplInfo -> Bool
-- | This is a fairly large module. It contains most of the GHC-specific
-- code for configuring, building and installing packages. It also
-- exports a function for finding out what packages are already
-- installed. Configuring involves finding the ghc and
-- ghc-pkg programs, finding what language extensions this
-- version of ghc supports and returning a Compiler value.
--
-- getInstalledPackages involves calling the ghc-pkg
-- program to find out what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to
-- take into account. We have to build libs and programs, possibly for
-- profiling and shared libs. We have to support building libraries that
-- will be usable by GHCi and also ghc's -split-objs feature. We
-- have to compile any C files using ghc. Linking, especially for
-- split-objs is remarkably complex, partly because there tend
-- to be 1,000's of .o files and this can often be more than we
-- can pass to the ld or ar programs in one go.
--
-- Installing for libs and exes involves finding the right files and
-- copying them to the right places. One of the more tricky things about
-- this module is remembering the layout of files in the build directory
-- (which is not explicitly documented) and thus what search dirs are
-- used for various kinds of files.
module Distribution.Simple.GHC
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> Compiler -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackagesMonitorFiles :: forall from. Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> Platform -> ProgramDb -> [PackageDBS from] -> IO [FilePath]
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
buildLib :: BuildFlags -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
-- | Build a foreign library
buildFLib :: Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO ()
-- | Build an executable with GHC.
buildExe :: Verbosity -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO ()
replLib :: ReplFlags -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO ()
replFLib :: ReplFlags -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO ()
replExe :: ReplFlags -> Flag ParStrat -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO ()
-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
-- | Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO ()
-- | Install foreign library for GHC.
installFLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> PackageDescription -> ForeignLib -> IO ()
-- | Install executables for GHC.
installExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO ()
-- | Extracts a String representing a hash of the ABI of a built library.
-- It can fail if the library has not yet been built.
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO String
hcPkgInfo :: ProgramDb -> HcPkgInfo
registerPackage :: Verbosity -> ProgramDb -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackS from -> InstalledPackageInfo -> RegisterOptions -> IO ()
componentGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir build) -> GhcOptions
componentCcGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Artifacts) -> SymbolicPath Pkg File -> GhcOptions
-- | Return the FilePath to the GHC application data directory.
getGhcAppDir :: IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
compilerBuildWay :: Compiler -> BuildWay
-- | Return the FilePath to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO (SymbolicPath CWD (Dir Pkg))
-- | The kinds of entries we can stick in a .ghc.environment file.
data GhcEnvironmentFileEntry fp
-- |
-- -- a comment
--
GhcEnvFileComment :: String -> GhcEnvironmentFileEntry fp
-- |
-- package-id foo-1.0-4fe301a...
--
GhcEnvFilePackageId :: UnitId -> GhcEnvironmentFileEntry fp
-- | global-package-db, user-package-db or package-db
-- blahpackage.conf.d
GhcEnvFilePackageDb :: PackageDBX fp -> GhcEnvironmentFileEntry fp
-- |
-- clear-package-db
--
GhcEnvFileClearPackageDbStack :: GhcEnvironmentFileEntry fp
-- | Make entries for a GHC environment file based on a
-- PackageDBStack and a bunch of package (unit) ids.
--
-- If you need to do anything more complicated then either use this as a
-- basis and add more entries, or just make all the entries directly.
simpleGhcEnvironmentFile :: PackageDBStackX fp -> [UnitId] -> [GhcEnvironmentFileEntry fp]
-- | Render a bunch of GHC environment file entries
renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry FilePath] -> String
-- | Write a .ghc.environment-$arch-$os-$ver file in the given
-- directory.
--
-- The Platform and GHC Version are needed as part of the
-- file name.
--
-- Returns the name of the file written.
writeGhcEnvironmentFile :: FilePath -> Platform -> Version -> [GhcEnvironmentFileEntry FilePath] -> IO FilePath
-- | GHC's rendering of its platform and compiler version string as used in
-- certain file locations (such as user package db location). For example
-- x86_64-linux-7.10.4
ghcPlatformAndVersionString :: Platform -> Version -> String
readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry FilePath]
parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry FilePath]
newtype ParseErrorExc
ParseErrorExc :: ParseError -> ParseErrorExc
getImplInfo :: Compiler -> GhcImplInfo
-- | Information about features and quirks of a GHC-based implementation.
--
-- Compiler flavors based on GHC behave similarly enough that some of the
-- support code for them is shared. Every implementation has its own
-- peculiarities, that may or may not be a direct result of the
-- underlying GHC version. This record keeps track of these differences.
--
-- All shared code (i.e. everything not in the Distribution.Simple.FLAVOR
-- module) should use implementation info rather than version numbers to
-- test for supported features.
data GhcImplInfo
GhcImplInfo :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> GhcImplInfo
-- |
-- - XHaskell2010 and -XHaskell98 flags
--
[supportsHaskell2010] :: GhcImplInfo -> Bool
-- |
[supportsGHC2021] :: GhcImplInfo -> Bool
-- |
[supportsGHC2024] :: GhcImplInfo -> Bool
-- |
-- - -supported-languages gives Ext and NoExt
--
[reportsNoExt] :: GhcImplInfo -> Bool
-- | NondecreasingIndentation is always on
[alwaysNondecIndent] :: GhcImplInfo -> Bool
-- |
-- - ghci-script flag supported
--
[flagGhciScript] :: GhcImplInfo -> Bool
-- | new style -fprof-auto* flags
[flagProfAuto] :: GhcImplInfo -> Bool
-- | fprof-late flag
[flagProfLate] :: GhcImplInfo -> Bool
-- | use package-conf instead of package-db
[flagPackageConf] :: GhcImplInfo -> Bool
-- |
[flagDebugInfo] :: GhcImplInfo -> Bool
-- |
-- - hiedir flag supported
--
[flagHie] :: GhcImplInfo -> Bool
-- | supports numeric -g levels
[supportsDebugLevels] :: GhcImplInfo -> Bool
-- | picks up .ghc.environment files
[supportsPkgEnvFiles] :: GhcImplInfo -> Bool
-- |
-- - Wmissing-home-modules is supported
--
[flagWarnMissingHomeModules] :: GhcImplInfo -> Bool
-- | Pass -this-unit-id flag when building executables
[unitIdForExes] :: GhcImplInfo -> Bool
-- | This module defines a simple JSON-based format for exporting basic
-- information about a Cabal package and the compiler configuration Cabal
-- would use to build it. This can be produced with the cabal build
-- --enable-build-info command.
--
-- This format is intended for consumption by external tooling and should
-- therefore be rather stable. Moreover, this allows tooling users to
-- avoid linking against Cabal. This is an important advantage as direct
-- API usage tends to be rather fragile in the presence of user-initiated
-- upgrades of Cabal.
--
-- Below is an example of the output this module produces,
--
--
-- { "cabal-lib-version": "1.23.0.0",
-- "compiler": {
-- "flavour": GHC,
-- "compiler-id": "ghc-7.10.2",
-- "path": "usrbin/ghc",
-- },
-- "components": [
-- { "type": "lib",
-- "name": "lib:Cabal",
-- "compiler-args":
-- ["-O", "-XHaskell98", "-Wall",
-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"]
-- "modules": [Project.ModA, Project.ModB, Paths_project],
-- "src-files": [],
-- "src-dirs": ["src"]
-- }
-- ]
-- }
--
--
-- The output format needs to be validated against
-- 'docjson-schemasbuild-info.schema.json'. If the format changes,
-- update the schema as well!
--
-- The cabal-lib-version property provides the version of the
-- Cabal library which generated the output. The compiler
-- property gives some basic information about the compiler Cabal would
-- use to compile the package.
--
-- The components property gives a list of the Cabal
-- Components defined by the package. Each has,
--
--
-- - type: the type of the component (one of lib,
-- exe, test, bench, or flib)
-- - name: a string serving to uniquely identify the component
-- within the package.
-- - compiler-args: the command-line arguments Cabal would
-- pass to the compiler to compile the component
-- - modules: the modules belonging to the component
-- - src-dirs: a list of directories where the modules might
-- be found
-- - src-files: any other Haskell sources needed by the
-- component
--
--
-- Note: At the moment this is only supported when using the GHC
-- compiler.
module Distribution.Simple.ShowBuildInfo
-- | Construct a JSON document describing the build information for a
-- package.
mkBuildInfo :: AbsolutePath (Dir Pkg) -> PackageDescription -> LocalBuildInfo -> BuildFlags -> (ConfiguredProgram, Compiler) -> [TargetInfo] -> ([String], Json)
-- | A variant of mkBuildInfo if you need to call
-- mkCompilerInfo and mkComponentInfo yourself.
--
-- If you change the format or any name in the output json, don't forget
-- to update the schema at
-- /doc/json-schemas/build-info.schema.json and the docs of
-- --enable-build-info/--disable-build-info.
mkBuildInfo' :: Json -> [Json] -> [(String, Json)]
mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json
mkComponentInfo :: AbsolutePath (Dir Pkg) -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> ([String], Json)
-- | This is the entry point into installing a built package. Performs the
-- "./setup install" and "./setup copy" actions. It
-- moves files into place based on the prefix argument. It does the
-- generic bits and then calls compiler-specific functions to do the
-- rest.
module Distribution.Simple.Install
-- | Perform the "./setup install" and "./setup copy"
-- actions. Move files into place based on the prefix argument.
--
-- This does NOT register libraries, you should call register to
-- do that.
install :: PackageDescription -> LocalBuildInfo -> CopyFlags -> IO ()
install_setupHooks :: InstallHooks -> PackageDescription -> LocalBuildInfo -> CopyFlags -> IO ()
-- | Install the files specified by the given glob pattern.
installFileGlob :: Verbosity -> CabalSpecVersion -> Maybe (SymbolicPath CWD (Dir Pkg)) -> (Maybe (SymbolicPath CWD (Dir DataDir)), SymbolicPath Pkg (Dir DataDir)) -> RelativePath DataDir File -> IO ()
-- | Generating the Paths_pkgname module.
--
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their version number and find any installed data
-- files at runtime. This code should probably be split off into another
-- module.
module Distribution.Simple.Build.PathsModule
generatePathsModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
-- | Generates the name of the environment variable controlling the path
-- component of interest.
--
-- Note: The format of these strings is part of Cabal's public API;
-- changing this function constitutes a *backwards-compatibility* break.
pkgPathEnvVar :: PackageDescription -> String -> String
-- | This has code for checking for various problems in packages. There is
-- one set of checks that just looks at a PackageDescription in
-- isolation and another set of checks that also looks at files in the
-- package. Some of the checks are basic sanity checks, others are
-- portability standards that we'd like to encourage. There is a
-- PackageCheck type that distinguishes the different kinds of
-- checks so we can see which ones are appropriate to report in different
-- situations. This code gets used when configuring a package when we
-- consider only basic problems. The higher standard is used when
-- preparing a source tarball and by Hackage when uploading new packages.
-- The reason for this is that we want to hold packages that are expected
-- to be distributed to a higher standard than packages that are only
-- ever expected to be used on the author's own environment.
module Distribution.PackageDescription.Check
-- | Explanations of PackageCheck's errors/warnings.
data CheckExplanation
ParseWarning :: FilePath -> PWarning -> CheckExplanation
NoNameField :: CheckExplanation
NoVersionField :: CheckExplanation
NoTarget :: CheckExplanation
UnnamedInternal :: CheckExplanation
DuplicateSections :: [UnqualComponentName] -> CheckExplanation
IllegalLibraryName :: PackageName -> CheckExplanation
NoModulesExposed :: LibraryName -> CheckExplanation
SignaturesCabal2 :: CheckExplanation
AutogenNotExposed :: CheckExplanation
AutogenIncludesNotIncluded :: CheckExplanation
NoMainIs :: UnqualComponentName -> CheckExplanation
NoHsLhsMain :: CheckExplanation
MainCCabal1_18 :: CheckExplanation
AutogenNoOther :: CEType -> CheckExplanation
AutogenIncludesNotIncludedExe :: CheckExplanation
TestsuiteTypeNotKnown :: TestType -> CheckExplanation
TestsuiteNotSupported :: TestType -> CheckExplanation
BenchmarkTypeNotKnown :: BenchmarkType -> CheckExplanation
BenchmarkNotSupported :: BenchmarkType -> CheckExplanation
NoHsLhsMainBench :: CheckExplanation
InvalidNameWin :: PackageName -> CheckExplanation
ZPrefix :: CheckExplanation
NoBuildType :: CheckExplanation
NoCustomSetup :: CheckExplanation
UnknownCompilers :: [String] -> CheckExplanation
UnknownLanguages :: [String] -> CheckExplanation
UnknownExtensions :: [String] -> CheckExplanation
LanguagesAsExtension :: [String] -> CheckExplanation
DeprecatedExtensions :: [(Extension, Maybe Extension)] -> CheckExplanation
MissingFieldCategory :: CheckExplanation
MissingFieldMaintainer :: CheckExplanation
MissingFieldSynopsis :: CheckExplanation
MissingFieldDescription :: CheckExplanation
MissingFieldSynOrDesc :: CheckExplanation
SynopsisTooLong :: CheckExplanation
ShortDesc :: CheckExplanation
InvalidTestWith :: [Dependency] -> CheckExplanation
ImpossibleInternalDep :: [Dependency] -> CheckExplanation
ImpossibleInternalExe :: [ExeDependency] -> CheckExplanation
MissingInternalExe :: [ExeDependency] -> CheckExplanation
NONELicense :: CheckExplanation
NoLicense :: CheckExplanation
AllRightsReservedLicense :: CheckExplanation
LicenseMessParse :: License -> CheckExplanation
UnrecognisedLicense :: String -> CheckExplanation
UncommonBSD4 :: CheckExplanation
UnknownLicenseVersion :: License -> [Version] -> CheckExplanation
NoLicenseFile :: CheckExplanation
UnrecognisedSourceRepo :: String -> CheckExplanation
MissingType :: CheckExplanation
MissingLocation :: CheckExplanation
GitProtocol :: CheckExplanation
MissingModule :: CheckExplanation
MissingTag :: CheckExplanation
SubdirRelPath :: CheckExplanation
SubdirGoodRelPath :: String -> CheckExplanation
OptFasm :: String -> CheckExplanation
OptHpc :: String -> CheckExplanation
OptProf :: String -> CheckExplanation
OptO :: String -> CheckExplanation
OptHide :: String -> CheckExplanation
OptMake :: String -> CheckExplanation
OptONot :: String -> CheckExplanation
OptOOne :: String -> CheckExplanation
OptOTwo :: String -> CheckExplanation
OptSplitSections :: String -> CheckExplanation
OptSplitObjs :: String -> CheckExplanation
OptWls :: String -> CheckExplanation
OptExts :: String -> CheckExplanation
OptRts :: String -> CheckExplanation
OptWithRts :: String -> CheckExplanation
COptONumber :: String -> WarnLang -> CheckExplanation
COptCPP :: String -> CheckExplanation
OptAlternatives :: String -> String -> [(String, String)] -> CheckExplanation
RelativeOutside :: String -> FilePath -> CheckExplanation
AbsolutePath :: String -> FilePath -> CheckExplanation
BadRelativePath :: String -> FilePath -> String -> CheckExplanation
DistPoint :: Maybe String -> FilePath -> CheckExplanation
GlobSyntaxError :: String -> String -> CheckExplanation
RecursiveGlobInRoot :: String -> FilePath -> CheckExplanation
InvalidOnWin :: [FilePath] -> CheckExplanation
FilePathTooLong :: FilePath -> CheckExplanation
FilePathNameTooLong :: FilePath -> CheckExplanation
FilePathSplitTooLong :: FilePath -> CheckExplanation
FilePathEmpty :: CheckExplanation
CVTestSuite :: CheckExplanation
CVDefaultLanguage :: CheckExplanation
CVDefaultLanguageComponent :: CheckExplanation
CVDefaultLanguageComponentSoft :: CheckExplanation
CVExtraDocFiles :: CheckExplanation
CVMultiLib :: CheckExplanation
CVReexported :: CheckExplanation
CVMixins :: CheckExplanation
CVExtraFrameworkDirs :: CheckExplanation
CVDefaultExtensions :: CheckExplanation
CVExtensionsDeprecated :: CheckExplanation
CVSources :: CheckExplanation
CVExtraDynamic :: [[String]] -> CheckExplanation
CVVirtualModules :: CheckExplanation
CVSourceRepository :: CheckExplanation
CVExtensions :: CabalSpecVersion -> [Extension] -> CheckExplanation
CVCustomSetup :: CheckExplanation
CVExpliticDepsCustomSetup :: CheckExplanation
CVAutogenPaths :: CheckExplanation
CVAutogenPackageInfo :: CheckExplanation
CVAutogenPackageInfoGuard :: CheckExplanation
GlobNoMatch :: String -> String -> CheckExplanation
GlobExactMatch :: String -> String -> FilePath -> CheckExplanation
GlobNoDir :: String -> String -> FilePath -> CheckExplanation
UnknownOS :: [String] -> CheckExplanation
UnknownArch :: [String] -> CheckExplanation
UnknownCompiler :: [String] -> CheckExplanation
BaseNoUpperBounds :: CheckExplanation
MissingUpperBounds :: CEType -> [String] -> CheckExplanation
SuspiciousFlagName :: [String] -> CheckExplanation
DeclaredUsedFlags :: Set FlagName -> Set FlagName -> CheckExplanation
NonASCIICustomField :: [String] -> CheckExplanation
RebindableClashPaths :: CheckExplanation
RebindableClashPackageInfo :: CheckExplanation
WErrorUnneeded :: String -> CheckExplanation
JUnneeded :: String -> CheckExplanation
FDeferTypeErrorsUnneeded :: String -> CheckExplanation
DynamicUnneeded :: String -> CheckExplanation
ProfilingUnneeded :: String -> CheckExplanation
UpperBoundSetup :: String -> CheckExplanation
DuplicateModule :: String -> [ModuleName] -> CheckExplanation
PotentialDupModule :: String -> [ModuleName] -> CheckExplanation
BOMStart :: FilePath -> CheckExplanation
NotPackageName :: FilePath -> String -> CheckExplanation
NoDesc :: CheckExplanation
MultiDesc :: [String] -> CheckExplanation
UnknownFile :: String -> RelativePath Pkg File -> CheckExplanation
MissingSetupFile :: CheckExplanation
MissingConfigureScript :: CheckExplanation
UnknownDirectory :: String -> FilePath -> CheckExplanation
MissingSourceControl :: CheckExplanation
MissingExpectedDocFiles :: Bool -> [FilePath] -> CheckExplanation
WrongFieldForExpectedDocFiles :: Bool -> String -> [FilePath] -> CheckExplanation
-- | Identifier for the speficic CheckExplanation. This ensures
-- `--ignore` can output a warning on unrecognised values. ☞ N.B.: should
-- be kept in sync with CheckExplanation.
data CheckExplanationID
type CheckExplanationIDString = String
-- | Results of some kind of failed package check.
--
-- There are a range of severities, from merely dubious to totally
-- insane. All of them come with a human readable explanation. In future
-- we may augment them with more machine readable explanations, for
-- example to help an IDE suggest automatic corrections.
data PackageCheck
-- | This package description is no good. There's no way it's going to
-- build sensibly. This should give an error at configure time.
PackageBuildImpossible :: CheckExplanation -> PackageCheck
[explanation] :: PackageCheck -> CheckExplanation
-- | A problem that is likely to affect building the package, or an issue
-- that we'd like every package author to be aware of, even if the
-- package is never distributed.
PackageBuildWarning :: CheckExplanation -> PackageCheck
[explanation] :: PackageCheck -> CheckExplanation
-- | An issue that might not be a problem for the package author but might
-- be annoying or detrimental when the package is distributed to users.
-- We should encourage distributed packages to be free from these issues,
-- but occasionally there are justifiable reasons so we cannot ban them
-- entirely.
PackageDistSuspicious :: CheckExplanation -> PackageCheck
[explanation] :: PackageCheck -> CheckExplanation
-- | Like PackageDistSuspicious but will only display warnings rather than
-- causing abnormal exit when you run 'cabal check'.
PackageDistSuspiciousWarn :: CheckExplanation -> PackageCheck
[explanation] :: PackageCheck -> CheckExplanation
-- | An issue that is OK in the author's environment but is almost certain
-- to be a portability problem for other environments. We can quite
-- legitimately refuse to publicly distribute packages with these
-- problems.
PackageDistInexcusable :: CheckExplanation -> PackageCheck
[explanation] :: PackageCheck -> CheckExplanation
-- | Check for common mistakes and problems in package descriptions.
--
-- This is the standard collection of checks covering all aspects except
-- for checks that require looking at files within the package. For those
-- see checkPackageFiles.
checkPackage :: GenericPackageDescription -> [PackageCheck]
-- | This function is an oddity due to the historical
-- GenericPackageDescription/PackageDescription split. It is only
-- maintained not to break interface, use checkPackage if
-- possible.
checkConfiguredPackage :: PackageDescription -> [PackageCheck]
-- | Wraps ParseWarning into PackageCheck.
wrapParseWarning :: FilePath -> PWarning -> PackageCheck
-- | Pretty printing PackageCheck.
ppPackageCheck :: PackageCheck -> String
ppCheckExplanationId :: CheckExplanationID -> CheckExplanationIDString
-- | Would Hackage refuse a package because of this error?
isHackageDistError :: PackageCheck -> Bool
-- | Filter Package Check by CheckExplanationID.
filterPackageChecksById :: [PackageCheck] -> [CheckExplanationID] -> [PackageCheck]
-- | Filter Package Check by Check explanation string.
filterPackageChecksByIdString :: [PackageCheck] -> [CheckExplanationIDString] -> ([PackageCheck], [CheckExplanationIDString])
-- | Same as checkPackageFilesGPD, but working with
-- PackageDescription.
--
-- This function is included for legacy reasons, use
-- checkPackageFilesGPD if you are working with
-- GenericPackageDescription.
checkPackageFiles :: Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
-- | Sanity checks that require IO. checkPackageFiles looks at the
-- files in the package and expects to find the package unpacked at the
-- given filepath.
checkPackageFilesGPD :: Verbosity -> GenericPackageDescription -> FilePath -> IO [PackageCheck]
-- | Sanity check things that requires looking at files in the package.
-- This is a generalised version of checkPackageFiles that can
-- work in any monad for which you can provide
-- CheckPackageContentOps operations.
--
-- The point of this extra generality is to allow doing checks in some
-- virtual file system, for example a tarball in memory.
checkPackageContent :: Monad m => CheckPackageContentOps m -> GenericPackageDescription -> m [PackageCheck]
-- | A record of operations needed to check the contents of packages.
-- Abstracted over m to provide flexibility (could be IO, a
-- .tar.gz file, etc).
data CheckPackageContentOps m
CheckPackageContentOps :: (FilePath -> m Bool) -> (FilePath -> m Bool) -> (FilePath -> m [FilePath]) -> (FilePath -> m ByteString) -> CheckPackageContentOps m
[doesFileExist] :: CheckPackageContentOps m -> FilePath -> m Bool
[doesDirectoryExist] :: CheckPackageContentOps m -> FilePath -> m Bool
[getDirectoryContents] :: CheckPackageContentOps m -> FilePath -> m [FilePath]
[getFileContents] :: CheckPackageContentOps m -> FilePath -> m ByteString
-- | This is an alternative build system that delegates everything to the
-- make program. All the commands just end up calling
-- make with appropriate arguments. The intention was to allow
-- preexisting packages that used makefiles to be wrapped into Cabal
-- packages. In practice essentially all such packages were converted
-- over to the "Simple" build system instead. Consequently this module is
-- not used much and it certainly only sees cursory maintenance and no
-- testing. Perhaps at some point we should stop pretending that it
-- works.
--
-- Uses the parsed command-line from Distribution.Simple.Setup in
-- order to build Haskell tools using a back-end build system based on
-- make. Obviously we assume that there is a configure script, and that
-- after the ConfigCmd has been run, there is a Makefile. Further
-- assumptions:
--
--
-- - ConfigCmd We assume the configure script accepts
-- --with-hc, --with-hc-pkg, --prefix,
-- --bindir, --libdir, --libexecdir,
-- --datadir.
-- - BuildCmd We assume that the default Makefile target will
-- build everything.
-- - InstallCmd We assume there is an install target.
-- Note that we assume that this does *not* register the package!
-- - CopyCmd We assume there is a copy target, and a
-- variable $(destdir). The copy target should probably
-- just invoke make install recursively (e.g. $(MAKE)
-- install prefix=$(destdir)/$(prefix) bindir=$(destdir)/$(bindir).
-- The reason we can't invoke make install directly here is that
-- we don't know the value of $(prefix).
-- - SDistCmd We assume there is a dist target.
-- - RegisterCmd We assume there is a register target
-- and a variable $(user).
-- - UnregisterCmd We assume there is an unregister
-- target.
-- - HaddockCmd We assume there is a docs or
-- doc target.
--
module Distribution.Make
data () => License
GPL :: Maybe Version -> License
AGPL :: Maybe Version -> License
LGPL :: Maybe Version -> License
BSD2 :: License
BSD3 :: License
BSD4 :: License
MIT :: License
ISC :: License
MPL :: Version -> License
Apache :: Maybe Version -> License
PublicDomain :: License
AllRightsReserved :: License
UnspecifiedLicense :: License
OtherLicense :: License
UnknownLicense :: String -> License
data () => Version
defaultMain :: IO ()
defaultMainArgs :: [String] -> IO ()
module Distribution.Compat.Time
-- | An opaque type representing a file's modification time, represented
-- internally as a 64-bit unsigned integer in the Windows UTC format.
newtype ModTime
ModTime :: Word64 -> ModTime
-- | Return modification time of the given file. Works around the low clock
-- resolution problem that getModificationTime has on GHC <
-- 7.8.
--
-- This is a modified version of the code originally written for Shake by
-- Neil Mitchell. See module Development.Shake.FileInfo.
getModTime :: FilePath -> IO ModTime
-- | Return age of given file in days.
getFileAge :: FilePath -> IO Double
-- | Return the current time as ModTime.
getCurTime :: IO ModTime
-- | Convert POSIX seconds to ModTime.
posixSecondsToModTime :: Int64 -> ModTime
-- | Based on code written by Neil Mitchell for Shake. See
-- sleepFileTimeCalibrate in Type. Returns a pair of
-- microsecond values: first, the maximum delay seen, and the recommended
-- delay to use before testing for file modification change. The returned
-- delay is never smaller than 10 ms, but never larger than 1 second.
calibrateMtimeChangeDelay :: IO (Int, Int)
instance GHC.Classes.Ord Distribution.Compat.Time.ModTime
instance GHC.Classes.Eq Distribution.Compat.Time.ModTime
instance GHC.Enum.Bounded Distribution.Compat.Time.ModTime
instance GHC.Generics.Generic Distribution.Compat.Time.ModTime
instance Data.Binary.Class.Binary Distribution.Compat.Time.ModTime
instance Distribution.Utils.Structured.Structured Distribution.Compat.Time.ModTime
instance GHC.Show.Show Distribution.Compat.Time.ModTime
instance GHC.Read.Read Distribution.Compat.Time.ModTime
-- | See
-- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst
--
-- WARNING: The contents of this module are HIGHLY experimental. We may
-- refactor it under you.
module Distribution.Backpack.Configure
configureComponentLocalBuildInfos :: Verbosity -> Bool -> ComponentRequestedSpec -> Bool -> Flag String -> Flag ComponentId -> PackageDescription -> ([PreExistingComponent], [ConfiguredPromisedComponent]) -> FlagAssignment -> [(ModuleName, Module)] -> InstalledPackageIndex -> Compiler -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
module Distribution.Backpack.DescribeUnitId
-- | Print a Setup message stating (1) what operation we are doing, for (2)
-- which component (with enough details to uniquely identify the build in
-- question.)
setupMessage' :: Pretty a => Verbosity -> String -> PackageIdentifier -> ComponentName -> Maybe [(ModuleName, a)] -> IO ()
-- | This module deals with registering and unregistering packages. There
-- are a couple ways it can do this, one is to do it directly. Another is
-- to generate a script that can be run later to do it. The idea here
-- being that the user is shielded from the details of what command to
-- use for package registration for a particular compiler. In practice
-- this aspect was not especially popular so we also provide a way to
-- simply generate the package registration file which then must be
-- manually passed to ghc-pkg. It is possible to generate
-- registration information for where the package is to be installed, or
-- alternatively to register the package in place in the build tree. The
-- latter is occasionally handy, and will become more important when we
-- try to build multi-package systems.
--
-- This module does not delegate anything to the per-compiler modules but
-- just mixes it all in this module, which is rather unsatisfactory. The
-- script generation and the unregister feature are not well used or
-- tested.
module Distribution.Simple.Register
register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
internalPackageDBPath :: LocalBuildInfo -> SymbolicPath Pkg (Dir Dist) -> SymbolicPath Pkg (Dir PkgDB)
initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO ()
doesPackageDBExist :: FilePath -> IO Bool
-- | Create an empty package DB at the specified location.
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO ()
deletePackageDB :: FilePath -> IO ()
-- | Compute the AbiHash of a library that we built inplace.
abiHash :: Verbosity -> PackageDescription -> SymbolicPath Pkg (Dir Dist) -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO AbiHash
-- | Run hc-pkg using a given package DB stack, directly
-- forwarding the provided command-line arguments to it.
invokeHcPkg :: Verbosity -> Compiler -> ProgramDb -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> [String] -> IO ()
registerPackage :: Verbosity -> Compiler -> ProgramDb -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackS from -> InstalledPackageInfo -> RegisterOptions -> IO ()
-- | Additional variations in the behaviour for register.
data RegisterOptions
RegisterOptions :: Bool -> Bool -> Bool -> RegisterOptions
-- | Allows re-registering / overwriting an existing package
[registerAllowOverwrite] :: RegisterOptions -> Bool
-- | Insist on the ability to register multiple instances of a single
-- version of a single package. This will fail if the hc-pkg
-- does not support it, see nativeMultiInstance and
-- recacheMultiInstance.
[registerMultiInstance] :: RegisterOptions -> Bool
-- | Require that no checks are performed on the existence of package files
-- mentioned in the registration info. This must be used if registering
-- prior to putting the files in their final place. This will fail if the
-- hc-pkg does not support it, see suppressFilesCheck.
[registerSuppressFilesCheck] :: RegisterOptions -> Bool
-- | Defaults are True, False and False
defaultRegisterOptions :: RegisterOptions
generateRegistrationInfo :: Verbosity -> PackageDescription -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> Bool -> Bool -> SymbolicPath Pkg (Dir Dist) -> PackageDB -> IO InstalledPackageInfo
-- | Construct InstalledPackageInfo for a library that is in place
-- in the build tree.
--
-- This function knows about the layout of in place packages.
inplaceInstalledPackageInfo :: AbsolutePath (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> PackageDescription -> AbiHash -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstalledPackageInfo
-- | Construct InstalledPackageInfo for the final install location
-- of a library package.
--
-- This function knows about the layout of installed packages.
absoluteInstalledPackageInfo :: PackageDescription -> AbiHash -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstalledPackageInfo
-- | Construct InstalledPackageInfo for a library in a package,
-- given a set of installation directories.
generalInstalledPackageInfo :: ([FilePath] -> [FilePath]) -> PackageDescription -> AbiHash -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstallDirs FilePath -> InstalledPackageInfo
-- | This module defines PPSuffixHandler, which is a combination of
-- a file extension and a function for configuring a PreProcessor.
-- It also defines a bunch of known built-in preprocessors like
-- cpp, cpphs, c2hs, hsc2hs,
-- happy, alex etc and lists them in
-- knownSuffixHandlers. On top of this it provides a function for
-- actually preprocessing some sources given a bunch of known suffix
-- handlers. This module is not as good as it could be, it could really
-- do with a rewrite to address some of the problems we have with
-- pre-processors.
module Distribution.Simple.PreProcess
-- | Apply preprocessors to the sources from hsSourceDirs for a
-- given component (lib, exe, or test suite).
--
-- XXX: This is terrible
preprocessComponent :: PackageDescription -> Component -> LocalBuildInfo -> ComponentLocalBuildInfo -> Bool -> Verbosity -> [PPSuffixHandler] -> IO ()
-- | Find any extra C sources generated by preprocessing that need to be
-- added to the component (addresses issue #238).
preprocessExtras :: Verbosity -> Component -> LocalBuildInfo -> IO [SymbolicPath Pkg File]
-- | Find the first extension of the file that exists, and preprocess it if
-- required.
preprocessFile :: Maybe (SymbolicPath CWD (Dir Pkg)) -> [SymbolicPath Pkg (Dir Source)] -> SymbolicPath Pkg (Dir Build) -> Bool -> RelativePath Source File -> Verbosity -> [Suffix] -> [(Suffix, PreProcessor)] -> Bool -> IO ()
-- | Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and
-- cpphs.
knownSuffixHandlers :: [PPSuffixHandler]
-- | Convenience function; get the suffixes of these preprocessors.
ppSuffixes :: [PPSuffixHandler] -> [Suffix]
-- | A preprocessor for turning non-Haskell files with the given
-- Suffix (i.e. file extension) into plain Haskell source files.
type PPSuffixHandler = (Suffix, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)
-- | A suffix (or file extension).
--
-- Mostly used to decide which preprocessor to use, e.g. files with
-- suffix "y" are usually processed by the "happy"
-- build tool.
newtype Suffix
Suffix :: String -> Suffix
builtinHaskellSuffixes :: [Suffix]
builtinHaskellBootSuffixes :: [Suffix]
-- | The interface to a preprocessor, which may be implemented using an
-- external program, but need not be. The arguments are the name of the
-- input file, the name of the output file and a verbosity level. Here is
-- a simple example that merely prepends a comment to the given source
-- file:
--
--
-- ppTestHandler :: PreProcessor
-- ppTestHandler =
-- PreProcessor {
-- platformIndependent = True,
-- runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
-- do info verbosity (inFile++" has been preprocessed to "++outFile)
-- stuff <- readFile inFile
-- writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
-- return ExitSuccess
--
--
-- We split the input and output file names into a base directory and the
-- rest of the file name. The input base dir is the path in the list of
-- search dirs that this file was found in. The output base dir is the
-- build dir where all the generated source files are put.
--
-- The reason for splitting it up this way is that some pre-processors
-- don't simply generate one output .hs file from one input file but have
-- dependencies on other generated files (notably c2hs, where building
-- one .hs file may require reading other .chi files, and then compiling
-- the .hs file may require reading a generated .h file). In these cases
-- the generated files need to embed relative path names to each other
-- (eg the generated .hs file mentions the .h file in the FFI imports).
-- This path must be relative to the base directory where the generated
-- files are located, it cannot be relative to the top level of the build
-- tree because the compilers do not look for .h files relative to there,
-- ie we do not use "-I .", instead we use "-I dist/build" (or whatever
-- dist dir has been set by the user)
--
-- Most pre-processors do not care of course, so mkSimplePreProcessor and
-- runSimplePreProcessor functions handle the simple case.
data PreProcessor
PreProcessor :: Bool -> (Verbosity -> [SymbolicPath Pkg (Dir Source)] -> [ModuleName] -> IO [ModuleName]) -> PreProcessCommand -> PreProcessor
[platformIndependent] :: PreProcessor -> Bool
-- | This function can reorder all modules, not just those that the
-- require the preprocessor in question. As such, this function should be
-- well-behaved and not reorder modules it doesn't have dominion over!
[ppOrdering] :: PreProcessor -> Verbosity -> [SymbolicPath Pkg (Dir Source)] -> [ModuleName] -> IO [ModuleName]
[runPreProcessor] :: PreProcessor -> PreProcessCommand
mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ()) -> (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()
runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity -> IO ()
ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppHappy :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppAlex :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor
ppUnlit :: PreProcessor
platformDefines :: LocalBuildInfo -> [String]
-- | Just present the modules in the order given; this is the default and
-- it is appropriate for preprocessors which do not have any sort of
-- dependencies between modules.
unsorted :: Verbosity -> [path] -> [ModuleName] -> IO [ModuleName]
-- | This defines the API that Setup.hs scripts can use to
-- customise the way the build works. This module just defines the
-- UserHooks type. The predefined sets of hooks that implement the
-- Simple, Make and Configure build systems
-- are defined in Distribution.Simple. The UserHooks is a
-- big record of functions. There are 3 for each action, a pre, post and
-- the action itself. There are few other miscellaneous hooks, ones to
-- extend the set of programs and preprocessors and one to override the
-- function used to read the .cabal file.
--
-- This hooks type is widely agreed to not be the right solution. Partly
-- this is because changes to it usually break custom Setup.hs
-- files and yet many internal code changes do require changes to the
-- hooks. For example we cannot pass any extra parameters to most of the
-- functions that implement the various phases because it would involve
-- changing the types of the corresponding hook. At some point it will
-- have to be replaced.
module Distribution.Simple.UserHooks
-- | Hooks allow authors to add specific functionality before and after a
-- command is run, and also to specify additional preprocessors.
--
--
-- - WARNING: The hooks interface is under rather constant flux as we
-- try to understand users needs. Setup files that depend on this
-- interface may break in future releases.
--
data UserHooks
UserHooks :: IO (Maybe GenericPackageDescription) -> [PPSuffixHandler] -> [Program] -> (Args -> ConfigFlags -> IO HookedBuildInfo) -> ((GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo) -> (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> BuildFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()) -> (Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> ReplFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()) -> (Args -> ReplFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> CleanFlags -> IO HookedBuildInfo) -> (PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()) -> (Args -> CleanFlags -> PackageDescription -> () -> IO ()) -> (Args -> CopyFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()) -> (Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> InstallFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()) -> (Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> RegisterFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()) -> (Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> RegisterFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()) -> (Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> HscolourFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO ()) -> (Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> HaddockFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()) -> (Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> TestFlags -> IO HookedBuildInfo) -> (Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()) -> (Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> BenchmarkFlags -> IO HookedBuildInfo) -> (Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO ()) -> (Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> UserHooks
-- | Read the description file
[readDesc] :: UserHooks -> IO (Maybe GenericPackageDescription)
-- | Custom preprocessors in addition to and overriding
-- knownSuffixHandlers.
[hookedPreProcessors] :: UserHooks -> [PPSuffixHandler]
-- | These programs are detected at configure time. Arguments for them are
-- added to the configure command.
[hookedPrograms] :: UserHooks -> [Program]
-- | Hook to run before configure command
[preConf] :: UserHooks -> Args -> ConfigFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during configure.
[confHook] :: UserHooks -> (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
-- | Hook to run after configure command
[postConf] :: UserHooks -> Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before build command. Second arg indicates verbosity
-- level.
[preBuild] :: UserHooks -> Args -> BuildFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during build.
[buildHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
-- | Hook to run after build command. Second arg indicates verbosity level.
[postBuild] :: UserHooks -> Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before repl command. Second arg indicates verbosity level.
[preRepl] :: UserHooks -> Args -> ReplFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during interpretation.
[replHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
-- | Hook to run after repl command. Second arg indicates verbosity level.
[postRepl] :: UserHooks -> Args -> ReplFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before clean command. Second arg indicates verbosity
-- level.
[preClean] :: UserHooks -> Args -> CleanFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during clean.
[cleanHook] :: UserHooks -> PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()
-- | Hook to run after clean command. Second arg indicates verbosity level.
[postClean] :: UserHooks -> Args -> CleanFlags -> PackageDescription -> () -> IO ()
-- | Hook to run before copy command
[preCopy] :: UserHooks -> Args -> CopyFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during copy.
[copyHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
-- | Hook to run after copy command
[postCopy] :: UserHooks -> Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before install command
[preInst] :: UserHooks -> Args -> InstallFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during install.
[instHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()
-- | Hook to run after install command. postInst should be run on the
-- target, not on the build machine.
[postInst] :: UserHooks -> Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before register command
[preReg] :: UserHooks -> Args -> RegisterFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during registration.
[regHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()
-- | Hook to run after register command
[postReg] :: UserHooks -> Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before unregister command
[preUnreg] :: UserHooks -> Args -> RegisterFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during unregistration.
[unregHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()
-- | Hook to run after unregister command
[postUnreg] :: UserHooks -> Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before hscolour command. Second arg indicates verbosity
-- level.
[preHscolour] :: UserHooks -> Args -> HscolourFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during hscolour.
[hscolourHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO ()
-- | Hook to run after hscolour command. Second arg indicates verbosity
-- level.
[postHscolour] :: UserHooks -> Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before haddock command. Second arg indicates verbosity
-- level.
[preHaddock] :: UserHooks -> Args -> HaddockFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during haddock.
[haddockHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
-- | Hook to run after haddock command. Second arg indicates verbosity
-- level.
[postHaddock] :: UserHooks -> Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before test command.
[preTest] :: UserHooks -> Args -> TestFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during test.
[testHook] :: UserHooks -> Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()
-- | Hook to run after test command.
[postTest] :: UserHooks -> Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before bench command.
[preBench] :: UserHooks -> Args -> BenchmarkFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during bench.
[benchHook] :: UserHooks -> Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO ()
-- | Hook to run after bench command.
[postBench] :: UserHooks -> Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO ()
type Args = [String]
-- | Empty UserHooks which do nothing.
emptyUserHooks :: UserHooks
-- | This deals with the configure phase. It provides the
-- configure action which is given the package description and
-- configure flags. It then tries to: configure the compiler; resolves
-- any conditionals in the package description; resolve the package
-- dependencies; check if all the extensions used by this package are
-- supported by the compiler; check that all the build tools are
-- available (including version checks if appropriate); checks for any
-- required pkg-config packages (updating the BuildInfo
-- with the results)
--
-- Then based on all this it saves the info in the LocalBuildInfo
-- and writes it out to the dist/setup-config file. It also
-- displays various details to the user, the amount of information
-- displayed depending on the verbosity level.
module Distribution.Simple.Configure
-- | Perform the "./setup configure" action. Returns the
-- .setup-config file.
configure :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
configure_setupHooks :: ConfigureHooks -> (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
-- | After running configure, output the LocalBuildInfo to the
-- localBuildInfoFile.
writePersistBuildConfig :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> LocalBuildInfo -> IO ()
-- | Read the localBuildInfoFile. Throw an exception if the file is
-- missing, if the file cannot be read, or if the file was created by an
-- older version of Cabal.
getConfigStateFile :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -> IO LocalBuildInfo
-- | Read the localBuildInfoFile. Throw an exception if the file is
-- missing, if the file cannot be read, or if the file was created by an
-- older version of Cabal.
getPersistBuildConfig :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> IO LocalBuildInfo
-- | Check that localBuildInfoFile is up-to-date with respect to the .cabal
-- file.
checkPersistBuildConfigOutdated :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> SymbolicPath Pkg File -> IO Bool
-- | Try to read the localBuildInfoFile.
tryGetPersistBuildConfig :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> IO (Either ConfigStateFileError LocalBuildInfo)
-- | Try to read the localBuildInfoFile.
maybeGetPersistBuildConfig :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> IO (Maybe LocalBuildInfo)
-- | Return the "dist/" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix,
-- the "CABAL_BUILDDIR" environment variable, or the default prefix.
findDistPref :: SymbolicPath Pkg (Dir Dist) -> Flag (SymbolicPath Pkg (Dir Dist)) -> IO (SymbolicPath Pkg (Dir Dist))
-- | Return the "dist/" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix,
-- the "CABAL_BUILDDIR" environment variable, or defaultDistPref
-- is used. Call this function to resolve a *DistPref flag
-- whenever it is not known to be set. (The *DistPref flags are
-- always set to a definite value before invoking UserHooks.)
findDistPrefOrDefault :: Flag (SymbolicPath Pkg (Dir Dist)) -> IO (SymbolicPath Pkg (Dir Dist))
-- | Create a PackageIndex that makes *any libraries that might be* defined
-- internally to this package look like installed packages, in case an
-- executable should refer to any of them as dependencies.
--
-- It must be *any libraries that might be* defined rather than the
-- actual definitions, because these depend on conditionals in the .cabal
-- file, and we haven't resolved them yet. finalizePD does the resolution
-- of conditionals, and it takes internalPackageSet as part of its input.
getInternalLibraries :: GenericPackageDescription -> Set LibraryName
-- | This method computes a default, "good enough" ComponentId for a
-- package. The intent is that cabal-install (or the user) will specify a
-- more detailed IPID via the --ipid flag if necessary.
computeComponentId :: Bool -> Flag String -> Flag ComponentId -> PackageIdentifier -> ComponentName -> Maybe ([ComponentId], FlagAssignment) -> ComponentId
-- | In GHC 8.0, the string we pass to GHC to use for symbol names for a
-- package can be an arbitrary, IPID-compatible string. However, prior to
-- GHC 8.0 there are some restrictions on what format this string can be
-- (due to how ghc-pkg parsed the key):
--
--
-- - In GHC 7.10, the string had either be of the form foo_ABCD, where
-- foo is a non-semantic alphanumeric/hyphenated prefix and ABCD is two
-- base-64 encoded 64-bit integers, or a GHC 7.8 style identifier.
-- - In GHC 7.8, the string had to be a valid package identifier like
-- foo-0.1.
--
--
-- So, the problem is that Cabal, in general, has a general IPID, but
-- needs to figure out a package key / package ID that the old ghc-pkg
-- will actually accept. But there's an EVERY WORSE problem: if ghc-pkg
-- decides to parse an identifier foo-0.1-xxx as if it were a package
-- identifier, which means it will SILENTLY DROP the "xxx" (because it's
-- a tag, and Cabal does not allow tags.) So we must CONNIVE to ensure
-- that we don't pick something that looks like this.
--
-- So this function attempts to define a mapping into the old formats.
--
-- The mapping for GHC 7.8 and before:
--
--
-- - We use the *compatibility* package name and version. For public
-- libraries this is just the package identifier; for internal libraries,
-- it's something like "z-pkgname-z-libname-0.1". See
-- computeCompatPackageName for more details.
--
--
-- The mapping for GHC 7.10:
--
--
-- - For CLibName: If the IPID is of the form foo-0.1-ABCDEF where
-- foo_ABCDEF would validly parse as a package key, we pass
-- ABCDEF. (NB: not all hashes parse this way, because GHC 7.10
-- mandated that these hashes be two base-62 encoded 64 bit integers),
-- but hashes that Cabal generated using computeComponentId are
-- guaranteed to have this form.If it is not of this form, we rehash the
-- IPID into the correct form and pass that.
-- - For sub-components, we rehash the IPID into the correct format and
-- pass that.
--
computeCompatPackageKey :: Compiler -> MungedPackageName -> Version -> UnitId -> String
-- | Get the path of dist/setup-config.
localBuildInfoFile :: SymbolicPath Pkg (Dir Dist) -> SymbolicPath Pkg File
-- | List all installed packages in the given package databases.
-- Non-existent package databases do not cause errors, they just get
-- skipped with a warning and treated as empty ones, since technically
-- they do not contain any package.
getInstalledPackages :: Verbosity -> Compiler -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) -> ProgramDb -> IO InstalledPackageIndex
-- | A set of files (or directories) that can be monitored to detect when
-- there might have been a change in the installed packages.
getInstalledPackagesMonitorFiles :: Verbosity -> Compiler -> Maybe (SymbolicPath CWD ('Dir from)) -> PackageDBStackS from -> ProgramDb -> Platform -> IO [FilePath]
-- | Looks up the InstalledPackageInfo of the given UnitIds
-- from the PackageDBStack in the LocalBuildInfo.
getInstalledPackagesById :: (Exception (VerboseException exception), Show exception, Typeable exception) => Verbosity -> LocalBuildInfo -> (UnitId -> exception) -> [UnitId] -> IO [InstalledPackageInfo]
-- | Like getInstalledPackages, but for a single package DB.
--
-- NB: Why isn't this always a fall through to
-- getInstalledPackages? That is because
-- getInstalledPackages performs some sanity checks on the package
-- database stack in question. However, when sandboxes are involved these
-- sanity checks are not desirable.
getPackageDBContents :: Verbosity -> Compiler -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> Verbosity -> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
-- | Compute the effective value of the profiling flags
-- --enable-library-profiling and
-- --enable-executable-profiling from the specified
-- ConfigFlags. This may be useful for external Cabal tools which
-- need to interact with Setup in a backwards-compatible way: the most
-- predictable mechanism for enabling profiling across many legacy
-- versions is to NOT use --enable-profiling and use those two
-- flags instead.
--
-- Note that --enable-executable-profiling also affects
-- profiling of benchmarks and (non-detailed) test suites.
computeEffectiveProfiling :: ConfigFlags -> (Bool, Bool, Bool)
-- | Makes a BuildInfo from C compiler and linker flags.
--
-- This can be used with the output from configuration programs like
-- pkg-config and similar package-specific programs like mysql-config,
-- freealut-config etc. For example:
--
--
-- ccflags <- getDbProgramOutput verbosity prog progdb ["--cflags"]
-- ldflags <- getDbProgramOutput verbosity prog progdb ["--libs"]
-- ldflags_static <- getDbProgramOutput verbosity prog progdb ["--libs", "--static"]
-- return (ccldOptionsBuildInfo (words ccflags) (words ldflags) (words ldflags_static))
--
ccLdOptionsBuildInfo :: [String] -> [String] -> [String] -> BuildInfo
checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
-- | The user interface specifies the package dbs to use with a combination
-- of --global, --user and
-- --package-db=global|user|clear|$file. This function combines
-- the global/user flag and interprets the package-db flag into a single
-- package db stack.
interpretPackageDbFlags :: Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp
-- | The errors that can be thrown when reading the setup-config
-- file.
data ConfigStateFileError
-- | No header found.
ConfigStateFileNoHeader :: ConfigStateFileError
-- | Incorrect header.
ConfigStateFileBadHeader :: ConfigStateFileError
-- | Cannot parse file contents.
ConfigStateFileNoParse :: ConfigStateFileError
-- | No file!
ConfigStateFileMissing :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -> ConfigStateFileError
[cfgStateFileErrorCwd] :: ConfigStateFileError -> Maybe (SymbolicPath CWD (Dir Pkg))
[cfgStateFileErrorFile] :: ConfigStateFileError -> SymbolicPath Pkg File
-- | Mismatched version.
ConfigStateFileBadVersion :: PackageIdentifier -> PackageIdentifier -> Either ConfigStateFileError LocalBuildInfo -> ConfigStateFileError
-- | Read the localBuildInfoFile, returning either an error or the
-- local build info.
tryGetConfigStateFile :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -> IO (Either ConfigStateFileError LocalBuildInfo)
platformDefines :: LocalBuildInfo -> [String]
instance GHC.Show.Show Distribution.Simple.Configure.ConfigStateFileError
instance GHC.Exception.Type.Exception Distribution.Simple.Configure.ConfigStateFileError
-- | This handles the sdist command. The module exports an
-- sdist action but also some of the phases that make it up so
-- that other tools can use just the bits they need. In particular the
-- preparation of the tree of files to go into the source tarball is
-- separated from actually building the source tarball.
--
-- The createArchive action uses the external tar program
-- and assumes that it accepts the -z flag. Neither of these
-- assumptions are valid on Windows. The sdist action now also
-- does some distribution QA checks.
module Distribution.Simple.SrcDist
-- | Create a source distribution.
sdist :: PackageDescription -> SDistFlags -> (FilePath -> FilePath) -> [PPSuffixHandler] -> IO ()
-- | Note: must be called with the CWD set to the directory containing the
-- '.cabal' file.
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
-- | Prepare a directory tree of source files.
prepareTree :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
-- | Create an archive from a tree of source files, and clean up the tree.
createArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath -> IO FilePath
-- | Prepare a directory tree of source files for a snapshot version. It is
-- expected that the appropriate snapshot version has already been set in
-- the package description, eg using snapshotPackage or
-- snapshotVersion.
prepareSnapshotTree :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
-- | Modifies a PackageDescription by appending a snapshot number
-- corresponding to the given date.
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
-- | Modifies a Version by appending a snapshot number corresponding
-- to the given date.
snapshotVersion :: UTCTime -> Version -> Version
-- | Given a date produce a corresponding integer representation. For
-- example given a date 18032008 produce the number
-- 20080318.
dateToSnapshotNumber :: UTCTime -> Int
-- | List all source files of a package.
--
-- Since Cabal-3.4 returns a single list. There shouldn't be any
-- executable files, they are hardly portable.
listPackageSources :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDescription -> [PPSuffixHandler] -> IO [SymbolicPath Pkg File]
-- | A variant of listPackageSources with configurable die.
--
-- Note: may still die directly. For example on missing
-- include file.
--
-- Since @3.4.0.0
listPackageSourcesWithDie :: Verbosity -> (forall res. Verbosity -> CabalException -> IO [res]) -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDescription -> [PPSuffixHandler] -> IO [SymbolicPath Pkg File]
-- | This is the entry point to actually building the modules in a package.
-- It doesn't actually do much itself, most of the work is delegated to
-- compiler-specific actions. It does do some non-compiler specific bits
-- like running pre-processors.
module Distribution.Simple.Build
-- | Build the libraries and executables in this package.
build :: PackageDescription -> LocalBuildInfo -> BuildFlags -> [PPSuffixHandler] -> IO ()
build_setupHooks :: BuildHooks -> PackageDescription -> LocalBuildInfo -> BuildFlags -> [PPSuffixHandler] -> IO ()
repl :: PackageDescription -> LocalBuildInfo -> ReplFlags -> [PPSuffixHandler] -> [String] -> IO ()
repl_setupHooks :: BuildHooks -> PackageDescription -> LocalBuildInfo -> ReplFlags -> [PPSuffixHandler] -> [String] -> IO ()
-- | Start an interpreter without loading any package files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO ()
-- | Creates the autogenerated files for a particular configured component,
-- and runs the pre-build hook.
preBuildComponent :: (LocalBuildInfo -> TargetInfo -> IO ()) -> Verbosity -> LocalBuildInfo -> TargetInfo -> IO ()
data AutogenFile
AutogenModule :: !ModuleName -> !Suffix -> AutogenFile
AutogenFile :: !ShortText -> AutogenFile
-- | A representation of the contents of an autogenerated file.
type AutogenFileContents = ByteString
-- | Generate and write to disk all built-in autogenerated files for the
-- specified component. These files will be put in the autogenerated
-- module directory for this component (see
-- autogenComponentsModuleDir).
--
-- This includes:
--
--
-- - Paths_pkg.hs,
-- - PackageInfo_pkg.hs,
-- - Backpack signature files for components that are not fully
-- instantiated,
-- - cabal_macros.h.
--
writeBuiltinAutogenFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()
-- | Write the given autogenerated files in the autogenerated modules
-- directory for the component.
writeAutogenFiles :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo -> Map AutogenFile AutogenFileContents -> IO ()
-- | Creates the autogenerated files for a particular configured component.
--
-- Legacy function: does not run pre-build hooks or pre-processors. This
-- function is insufficient on its own to prepare the build for a
-- component.
--
-- Consumers wanting to prepare the sources of a component, e.g. in order
-- to launch a REPL session, are advised to run Setup repl
-- compName --repl-multi-file=fn instead.
-- | Deprecated: This function does not prepare all source files for a
-- component. Suggestion: use 'Setup repl compName
-- --repl-multi-file=fn'.
componentInitialBuildSteps :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Verbosity -> IO ()
-- | Runs componentInitialBuildSteps on every configured component.
--
-- Legacy function: does not run pre-build hooks or pre-processors. This
-- function is insufficient on its own to prepare the build for a
-- package.
--
-- Consumers wanting to prepare the sources of a package, e.g. in order
-- to launch a REPL session, are advised to run Setup repl
-- --repl-multi-file=fn instead.
-- | Deprecated: This function does not prepare all source files for a
-- package. Suggestion: use 'Setup repl --repl-multi-file=fn'.
initialBuildSteps :: FilePath -> PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
-- | Initialize a new package db file for libraries defined internally to
-- the package.
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> SymbolicPath Pkg (Dir Dist) -> IO PackageDB
-- | Update the program database to include any build-tool-depends
-- specified in the given BuildInfo on build tools internal to the
-- current package.
--
-- This function:
--
--
-- - adds these internal build tools to the ProgramDb, including
-- paths to their respective data directories,
-- - adds their paths to the current progSearchPath, and adds
-- the data directory environment variable for the current package to the
-- current progOverrideEnv, so that any programs configured from
-- now on will be able to invoke these build tools.
--
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb
instance GHC.Classes.Ord Distribution.Simple.Build.AutogenFile
instance GHC.Classes.Eq Distribution.Simple.Build.AutogenFile
instance GHC.Show.Show Distribution.Simple.Build.AutogenFile
-- | This is the entry point into testing a built package. It performs the
-- "./setup test" action. It runs test suites designated in the
-- package description and reports on the results.
module Distribution.Simple.Test
-- | Perform the "./setup test" action.
test :: Args -> PackageDescription -> LocalBuildInfo -> TestFlags -> IO ()
-- | This module deals with the haddock and hscolour
-- commands. It uses information about installed packages (from
-- ghc-pkg) to find the locations of documentation for dependent
-- packages, so it can create links.
--
-- The hscolour support allows generating HTML versions of the
-- original source, with coloured syntax highlighting.
module Distribution.Simple.Haddock
haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
haddock_setupHooks :: BuildHooks -> PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
-- | Execute Haddock configured with HaddocksFlags. It is
-- used to build index and contents for documentation of multiple
-- packages.
createHaddockIndex :: Verbosity -> ProgramDb -> Compiler -> Platform -> Maybe (SymbolicPath CWD (Dir Pkg)) -> HaddockProjectFlags -> IO ()
hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO ()
hscolour_setupHooks :: BuildHooks -> PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO ()
-- | Given a list of InstalledPackageInfos, return a list of
-- interfaces and HTML paths, and an optional warning for packages with
-- missing documentation.
haddockPackagePaths :: [InstalledPackageInfo] -> Maybe (InstalledPackageInfo -> FilePath) -> IO ([(FilePath, Maybe FilePath, Maybe FilePath, Visibility)], Maybe String)
-- | 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 :: Visibility
Hidden :: Visibility
instance GHC.Classes.Ord Distribution.Simple.Haddock.Directory
instance GHC.Classes.Eq Distribution.Simple.Haddock.Directory
instance GHC.Show.Show Distribution.Simple.Haddock.Directory
instance GHC.Read.Read Distribution.Simple.Haddock.Directory
instance GHC.Classes.Eq Distribution.Simple.Haddock.Output
instance GHC.Generics.Generic Distribution.Simple.Haddock.HaddockArgs
instance GHC.Base.Monoid Distribution.Simple.Haddock.HaddockArgs
instance GHC.Base.Semigroup Distribution.Simple.Haddock.HaddockArgs
instance GHC.Base.Monoid Distribution.Simple.Haddock.Directory
instance GHC.Base.Semigroup Distribution.Simple.Haddock.Directory
-- | This is the entry point into running the benchmarks in a built
-- package. It performs the "./setup bench" action. It runs
-- benchmarks designated in the package description.
module Distribution.Simple.Bench
-- | Perform the "./setup bench" action.
bench :: Args -> PackageDescription -> LocalBuildInfo -> BenchmarkFlags -> IO ()
-- | This is the command line front end to the Simple build system. When
-- given the parsed command-line args and package information, is able to
-- perform basic commands like configure, build, install, register, etc.
--
-- This module exports the main functions that Setup.hs scripts use. It
-- re-exports the UserHooks type, the standard entry points like
-- defaultMain and defaultMainWithHooks and the predefined
-- sets of UserHooks that custom Setup.hs scripts can
-- extend to add their own behaviour.
--
-- This module isn't called "Simple" because it's simple. Far from it.
-- It's called "Simple" because it does complicated things to simple
-- software.
--
-- The original idea was that there could be different build systems that
-- all presented the same compatible command line interfaces. There is
-- still a Distribution.Make system but in practice no packages
-- use it.
module Distribution.Simple
-- | A simple implementation of main for a Cabal setup script. It
-- reads the package description file using IO, and performs the action
-- specified on the command line.
defaultMain :: IO ()
-- | Like defaultMain, but accepts the package description as input
-- rather than using IO to read it.
defaultMainNoRead :: GenericPackageDescription -> IO ()
-- | A version of defaultMain that is passed the command line
-- arguments, rather than getting them from the environment.
defaultMainArgs :: [String] -> IO ()
-- | Hooks allow authors to add specific functionality before and after a
-- command is run, and also to specify additional preprocessors.
--
--
-- - WARNING: The hooks interface is under rather constant flux as we
-- try to understand users needs. Setup files that depend on this
-- interface may break in future releases.
--
data UserHooks
UserHooks :: IO (Maybe GenericPackageDescription) -> [PPSuffixHandler] -> [Program] -> (Args -> ConfigFlags -> IO HookedBuildInfo) -> ((GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo) -> (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> BuildFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()) -> (Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> ReplFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()) -> (Args -> ReplFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> CleanFlags -> IO HookedBuildInfo) -> (PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()) -> (Args -> CleanFlags -> PackageDescription -> () -> IO ()) -> (Args -> CopyFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()) -> (Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> InstallFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()) -> (Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> RegisterFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()) -> (Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> RegisterFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()) -> (Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> HscolourFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO ()) -> (Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> HaddockFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()) -> (Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> TestFlags -> IO HookedBuildInfo) -> (Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()) -> (Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> (Args -> BenchmarkFlags -> IO HookedBuildInfo) -> (Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO ()) -> (Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO ()) -> UserHooks
-- | Read the description file
[readDesc] :: UserHooks -> IO (Maybe GenericPackageDescription)
-- | Custom preprocessors in addition to and overriding
-- knownSuffixHandlers.
[hookedPreProcessors] :: UserHooks -> [PPSuffixHandler]
-- | These programs are detected at configure time. Arguments for them are
-- added to the configure command.
[hookedPrograms] :: UserHooks -> [Program]
-- | Hook to run before configure command
[preConf] :: UserHooks -> Args -> ConfigFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during configure.
[confHook] :: UserHooks -> (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
-- | Hook to run after configure command
[postConf] :: UserHooks -> Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before build command. Second arg indicates verbosity
-- level.
[preBuild] :: UserHooks -> Args -> BuildFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during build.
[buildHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
-- | Hook to run after build command. Second arg indicates verbosity level.
[postBuild] :: UserHooks -> Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before repl command. Second arg indicates verbosity level.
[preRepl] :: UserHooks -> Args -> ReplFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during interpretation.
[replHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
-- | Hook to run after repl command. Second arg indicates verbosity level.
[postRepl] :: UserHooks -> Args -> ReplFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before clean command. Second arg indicates verbosity
-- level.
[preClean] :: UserHooks -> Args -> CleanFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during clean.
[cleanHook] :: UserHooks -> PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()
-- | Hook to run after clean command. Second arg indicates verbosity level.
[postClean] :: UserHooks -> Args -> CleanFlags -> PackageDescription -> () -> IO ()
-- | Hook to run before copy command
[preCopy] :: UserHooks -> Args -> CopyFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during copy.
[copyHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO ()
-- | Hook to run after copy command
[postCopy] :: UserHooks -> Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before install command
[preInst] :: UserHooks -> Args -> InstallFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during install.
[instHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO ()
-- | Hook to run after install command. postInst should be run on the
-- target, not on the build machine.
[postInst] :: UserHooks -> Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before register command
[preReg] :: UserHooks -> Args -> RegisterFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during registration.
[regHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()
-- | Hook to run after register command
[postReg] :: UserHooks -> Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before unregister command
[preUnreg] :: UserHooks -> Args -> RegisterFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during unregistration.
[unregHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO ()
-- | Hook to run after unregister command
[postUnreg] :: UserHooks -> Args -> RegisterFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before hscolour command. Second arg indicates verbosity
-- level.
[preHscolour] :: UserHooks -> Args -> HscolourFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during hscolour.
[hscolourHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> HscolourFlags -> IO ()
-- | Hook to run after hscolour command. Second arg indicates verbosity
-- level.
[postHscolour] :: UserHooks -> Args -> HscolourFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before haddock command. Second arg indicates verbosity
-- level.
[preHaddock] :: UserHooks -> Args -> HaddockFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during haddock.
[haddockHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
-- | Hook to run after haddock command. Second arg indicates verbosity
-- level.
[postHaddock] :: UserHooks -> Args -> HaddockFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before test command.
[preTest] :: UserHooks -> Args -> TestFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during test.
[testHook] :: UserHooks -> Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()
-- | Hook to run after test command.
[postTest] :: UserHooks -> Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO ()
-- | Hook to run before bench command.
[preBench] :: UserHooks -> Args -> BenchmarkFlags -> IO HookedBuildInfo
-- | Over-ride this hook to get different behavior during bench.
[benchHook] :: UserHooks -> Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO ()
-- | Hook to run after bench command.
[postBench] :: UserHooks -> Args -> BenchmarkFlags -> PackageDescription -> LocalBuildInfo -> IO ()
type Args = [String]
-- | A customizable version of defaultMain.
defaultMainWithHooks :: UserHooks -> IO ()
defaultMainWithSetupHooks :: SetupHooks -> IO ()
defaultMainWithSetupHooksArgs :: SetupHooks -> [String] -> IO ()
-- | A customizable version of defaultMain that also takes the
-- command line arguments.
defaultMainWithHooksArgs :: UserHooks -> [String] -> IO ()
-- | A customizable version of defaultMainNoRead.
defaultMainWithHooksNoRead :: UserHooks -> GenericPackageDescription -> IO ()
-- | A customizable version of defaultMainNoRead that also takes the
-- command line arguments.
defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription -> [String] -> IO ()
-- | Hooks that correspond to a plain instantiation of the "simple" build
-- system
simpleUserHooks :: UserHooks
-- | Basic autoconf UserHooks:
--
--
-- - postConf runs ./configure, if present.
-- - the pre-hooks, except for pre-conf, read additional build
-- information from package.buildinfo, if present.
--
--
-- Thus configure can use local system information to generate
-- package.buildinfo and possibly other files.
autoconfUserHooks :: UserHooks
autoconfSetupHooks :: SetupHooks
-- | Empty UserHooks which do nothing.
emptyUserHooks :: UserHooks