-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A framework for packaging Haskell software -- -- 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 2.0.0.2 module Distribution.Compat.Binary decodeOrFailIO :: Binary a => ByteString -> IO (Either String a) -- | Lazily reconstruct a value previously written to a file. decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a) module Distribution.Compat.Exception catchIO :: IO a -> (IOException -> IO a) -> IO a catchExit :: IO a -> (ExitCode -> IO a) -> IO a tryIO :: IO a -> IO (Either IOException a) -- | Render this exception value in a human-friendly manner. -- -- Default implementation: show. displayException :: Exception e => e -> String module Distribution.Compat.Map.Strict -- | Compatibility layer for Data.Semigroup module Distribution.Compat.Semigroup -- | The class of semigroups (types with an associative binary operation). class Semigroup a -- | An associative operation. -- --
--   (a <> b) <> c = a <> (b <> c)
--   
-- -- If a is also a Monoid we further require -- --
--   (<>) = mappend
--   
(<>) :: Semigroup a => a -> a -> a -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following laws: -- -- -- -- The method names refer to the monoid of lists under concatenation, but -- there are many other instances. -- -- Some types can be viewed as a monoid in more than one way, e.g. both -- addition and multiplication on numbers. In such cases we often define -- newtypes and make those instances of Monoid, e.g. -- Sum and Product. class Monoid a -- | Identity of mappend mempty :: Monoid a => a -- | An associative operation mappend :: Monoid a => a -> a -> a -- | Fold a list using the monoid. For most types, the default definition -- for mconcat will be used, but the function is included in the -- class definition so that an optimized version can be provided for -- specific types. mconcat :: Monoid a => [a] -> a -- | Boolean monoid under conjunction (&&). newtype All All :: Bool -> All [getAll] :: All -> Bool -- | Boolean monoid under disjunction (||). newtype Any Any :: Bool -> Any [getAny] :: Any -> Bool -- | Cabal's own Last copy to avoid requiring an orphan -- Binary instance. -- -- Once the oldest binary version we support provides a -- Binary instance for Last we can remove this one here. -- -- NB: Last is defined differently and not a Monoid newtype Last' a Last' :: Maybe a -> Last' a [getLast'] :: Last' a -> Maybe a -- | Generically generate a Semigroup (<>) operation -- for any type implementing Generic. This operation will append -- two values by point-wise appending their component fields. It is only -- defined for product types. -- --
--   gmappend a (gmappend b c) = gmappend (gmappend a b) c
--   
gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a -- | Generically generate a Monoid mempty for any -- product-like type implementing Generic. -- -- It is only defined for product types. -- --
--   gmappend gmempty a = a = gmappend a gmempty
--   
gmempty :: (Generic a, GMonoid (Rep a)) => a instance GHC.Generics.Generic (Distribution.Compat.Semigroup.Last' a) instance GHC.Base.Applicative Distribution.Compat.Semigroup.Last' instance GHC.Base.Functor Distribution.Compat.Semigroup.Last' instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Compat.Semigroup.Last' a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Compat.Semigroup.Last' a) instance GHC.Read.Read a => GHC.Read.Read (Distribution.Compat.Semigroup.Last' a) instance GHC.Classes.Ord a => GHC.Classes.Ord (Distribution.Compat.Semigroup.Last' a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Compat.Semigroup.Last' a) instance (Data.Semigroup.Semigroup a, GHC.Base.Monoid a) => Distribution.Compat.Semigroup.GMonoid (GHC.Generics.K1 i a) instance Distribution.Compat.Semigroup.GMonoid f => Distribution.Compat.Semigroup.GMonoid (GHC.Generics.M1 i c f) instance (Distribution.Compat.Semigroup.GMonoid f, Distribution.Compat.Semigroup.GMonoid g) => Distribution.Compat.Semigroup.GMonoid (f GHC.Generics.:*: g) instance Data.Semigroup.Semigroup a => Distribution.Compat.Semigroup.GSemigroup (GHC.Generics.K1 i a) instance Distribution.Compat.Semigroup.GSemigroup f => Distribution.Compat.Semigroup.GSemigroup (GHC.Generics.M1 i c f) instance (Distribution.Compat.Semigroup.GSemigroup f, Distribution.Compat.Semigroup.GSemigroup g) => Distribution.Compat.Semigroup.GSemigroup (f GHC.Generics.:*: g) instance Data.Semigroup.Semigroup (Distribution.Compat.Semigroup.Last' a) instance GHC.Base.Monoid (Distribution.Compat.Semigroup.Last' a) 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 -- --
--   errorWithCallStack :: HasCallStack => String -> a
--   
-- -- as a variant of error that will get its call-site. We can -- access the call-stack inside errorWithCallStack with -- callStack. -- --
--   errorWithCallStack :: HasCallStack => String -> a
--   errorWithCallStack msg = error (msg ++ "n" ++ prettyCallStack callStack)
--   
-- -- Thus, if we call errorWithCallStack we will get a formatted -- call-stack alongside our error message. -- --
--   >>> errorWithCallStack "die"
--   *** Exception: die
--   CallStack (from HasCallStack):
--     errorWithCallStack, called at <interactive>:2:1 in interactive:Ghci1
--   
-- -- GHC solves HasCallStack constraints in three steps: -- --
    --
  1. 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.
  2. --
  3. 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).
  4. --
  5. 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.
  6. --
-- -- 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 -- | This is a library of parser combinators, originally written by Koen -- Claessen. It parses all alternatives in parallel, so it never keeps -- hold of the beginning of the input string, a common source of space -- leaks with other parsers. The '(+++)' choice combinator is genuinely -- commutative; it makes no difference which branch is "shorter". -- -- See also Koen's paper Parallel Parsing Processes -- (http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.9217). -- -- This version of ReadP has been locally hacked to make it H98, by -- Martin Sjögren mailto:msjogren@gmail.com -- -- The unit tests have been moved to UnitTest.Distribution.Compat.ReadP, -- by Mark Lentczner mailto:mark@glyphic.com module Distribution.Compat.ReadP type ReadP r a = Parser r Char a -- | Consumes and returns the next character. Fails if there is no input -- left. get :: ReadP r Char -- | Look-ahead: returns the part of the input that is left, without -- consuming it. look :: ReadP r String -- | Symmetric choice. (+++) :: ReadP r a -> ReadP r a -> ReadP r a infixr 5 +++ -- | Local, exclusive, left-biased choice: If left parser locally produces -- any result at all, then right parser is not used. (<++) :: ReadP a a -> ReadP r a -> ReadP r a infixr 5 <++ -- | Transforms a parser into one that does the same, but in addition -- returns the exact characters read. IMPORTANT NOTE: gather gives -- a runtime error if its first argument is built using any occurrences -- of readS_to_P. gather :: ReadP (String -> P Char r) a -> ReadP r (String, a) -- | Always fails. pfail :: ReadP r a -- | Succeeds iff we are at the end of input eof :: ReadP r () -- | Consumes and returns the next character, if it satisfies the specified -- predicate. satisfy :: (Char -> Bool) -> ReadP r Char -- | Parses and returns the specified character. char :: Char -> ReadP r Char -- | Parses and returns the specified string. string :: String -> ReadP r String -- | Parses the first zero or more characters satisfying the predicate. munch :: (Char -> Bool) -> ReadP r String -- | Parses the first one or more characters satisfying the predicate. munch1 :: (Char -> Bool) -> ReadP r String -- | Skips all whitespace. skipSpaces :: ReadP r () -- | Like skipSpaces but succeeds only if there is at least one -- whitespace character to skip. skipSpaces1 :: ReadP r () -- | Combines all parsers in the specified list. choice :: [ReadP r a] -> ReadP r a -- | count n p parses n occurrences of p in -- sequence. A list of results is returned. count :: Int -> ReadP r a -> ReadP r [a] -- | between open close p parses open, followed by -- p and finally close. Only the value of p is -- returned. between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a -- | option x p will either parse p or return x -- without consuming any input. option :: a -> ReadP r a -> ReadP r a -- | optional p optionally parses p and always returns -- (). optional :: ReadP r a -> ReadP r () -- | Parses zero or more occurrences of the given parser. many :: ReadP r a -> ReadP r [a] -- | Parses one or more occurrences of the given parser. many1 :: ReadP r a -> ReadP r [a] -- | Like many, but discards the result. skipMany :: ReadP r a -> ReadP r () -- | Like many1, but discards the result. skipMany1 :: ReadP r a -> ReadP r () -- | sepBy p sep parses zero or more occurrences of p, -- separated by sep. Returns a list of values returned by -- p. sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a] -- | sepBy1 p sep parses one or more occurrences of p, -- separated by sep. Returns a list of values returned by -- p. sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] -- | endBy p sep parses zero or more occurrences of p, -- separated and ended by sep. endBy :: ReadP r a -> ReadP r sep -> ReadP r [a] -- | endBy p sep parses one or more occurrences of p, -- separated and ended by sep. endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a] -- | chainr p op x parses zero or more occurrences of p, -- separated by op. Returns a value produced by a right -- associative application of all functions returned by op. If -- there are no occurrences of p, x is returned. chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a -- | chainl p op x parses zero or more occurrences of p, -- separated by op. Returns a value produced by a left -- associative application of all functions returned by op. If -- there are no occurrences of p, x is returned. chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a -- | Like chainl, but parses one or more occurrences of p. chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a -- | Like chainr, but parses one or more occurrences of p. chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a -- | manyTill p end parses zero or more occurrences of p, -- until end succeeds. Returns a list of values returned by -- p. manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a] -- | A parser for a type a, represented as a function that takes a -- String and returns a list of possible parses as -- (a,String) pairs. -- -- Note that this kind of backtracking parser is very inefficient; -- reading a large structure may be quite slow (cf ReadP). type ReadS a = String -> [(a, String)] -- | Converts a parser into a Haskell ReadS-style function. This is the -- main way in which you can "run" a ReadP parser: the expanded -- type is readP_to_S :: ReadP a -> String -> [(a,String)] -- readP_to_S :: ReadP a a -> ReadS a -- | Converts a Haskell ReadS-style function into a parser. Warning: This -- introduces local backtracking in the resulting parser, and therefore a -- possible inefficiency. readS_to_P :: ReadS a -> ReadP r a instance GHC.Base.Functor (Distribution.Compat.ReadP.Parser r s) instance GHC.Base.Applicative (Distribution.Compat.ReadP.Parser r s) instance GHC.Base.Monad (Distribution.Compat.ReadP.Parser r s) instance Control.Monad.Fail.MonadFail (Distribution.Compat.ReadP.Parser r s) instance GHC.Base.Functor (Distribution.Compat.ReadP.P s) instance GHC.Base.Applicative (Distribution.Compat.ReadP.P s) instance GHC.Base.Monad (Distribution.Compat.ReadP.P s) instance Control.Monad.Fail.MonadFail (Distribution.Compat.ReadP.P s) instance GHC.Base.Alternative (Distribution.Compat.ReadP.P s) instance GHC.Base.MonadPlus (Distribution.Compat.ReadP.P s) -- | 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 -- | The class of semigroups (types with an associative binary operation). class Semigroup a -- | An associative operation. -- --
--   (a <> b) <> c = a <> (b <> c)
--   
-- -- If a is also a Monoid we further require -- --
--   (<>) = mappend
--   
(<>) :: Semigroup a => a -> a -> a -- | Generically generate a Semigroup (<>) operation -- for any type implementing Generic. This operation will append -- two values by point-wise appending their component fields. It is only -- defined for product types. -- --
--   gmappend a (gmappend b c) = gmappend (gmappend a b) c
--   
gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a -- | Generically generate a Monoid mempty for any -- product-like type implementing Generic. -- -- It is only defined for product types. -- --
--   gmappend gmempty a = a = gmappend a gmempty
--   
gmempty :: (Generic a, GMonoid (Rep a)) => a -- | The class Typeable allows a concrete representation of a type -- to be calculated. class Typeable k (a :: k) -- | The Data class comprehends a fundamental primitive -- gfoldl for folding over constructor applications, say terms. -- This primitive can be instantiated in several ways to map over the -- immediate subterms of a term; see the gmap combinators later -- in this class. Indeed, a generic programmer does not necessarily need -- to use the ingenious gfoldl primitive but rather the intuitive -- gmap combinators. The gfoldl primitive is completed by -- means to query top-level constructors, to turn constructor -- representations into proper terms, and to list all possible datatype -- constructors. This completion allows us to serve generic programming -- scenarios like read, show, equality, term generation. -- -- The combinators gmapT, gmapQ, gmapM, etc are all -- provided with default definitions in terms of gfoldl, leaving -- open the opportunity to provide datatype-specific definitions. (The -- inclusion of the gmap combinators as members of class -- Data allows the programmer or the compiler to derive -- specialised, and maybe more efficient code per datatype. Note: -- gfoldl is more higher-order than the gmap combinators. -- This is subject to ongoing benchmarking experiments. It might turn out -- that the gmap combinators will be moved out of the class -- Data.) -- -- Conceptually, the definition of the gmap combinators in terms -- of the primitive gfoldl requires the identification of the -- gfoldl function arguments. Technically, we also need to -- identify the type constructor c for the construction of the -- result type from the folded term type. -- -- In the definition of gmapQx combinators, we use -- phantom type constructors for the c in the type of -- gfoldl because the result type of a query does not involve the -- (polymorphic) type of the term argument. In the definition of -- gmapQl we simply use the plain constant type constructor -- because gfoldl is left-associative anyway and so it is readily -- suited to fold a left-associative binary operation over the immediate -- subterms. In the definition of gmapQr, extra effort is needed. We use -- a higher-order accumulation trick to mediate between left-associative -- constructor application vs. right-associative binary operation (e.g., -- (:)). When the query is meant to compute a value of type -- r, then the result type withing generic folding is r -- -> r. So the result of folding is a function to which we -- finally pass the right unit. -- -- With the -XDeriveDataTypeable option, GHC can generate -- instances of the Data class automatically. For example, given -- the declaration -- --
--   data T a b = C1 a b | C2 deriving (Typeable, Data)
--   
-- -- GHC will generate an instance that is equivalent to -- --
--   instance (Data a, Data b) => Data (T a b) where
--       gfoldl k z (C1 a b) = z C1 `k` a `k` b
--       gfoldl k z C2       = z C2
--   
--       gunfold k z c = case constrIndex c of
--                           1 -> k (k (z C1))
--                           2 -> z C2
--   
--       toConstr (C1 _ _) = con_C1
--       toConstr C2       = con_C2
--   
--       dataTypeOf _ = ty_T
--   
--   con_C1 = mkConstr ty_T "C1" [] Prefix
--   con_C2 = mkConstr ty_T "C2" [] Prefix
--   ty_T   = mkDataType "Module.T" [con_C1, con_C2]
--   
-- -- This is suitable for datatypes that are exported transparently. class Typeable * a => Data a -- | Representable types of kind *. This class is derivable in GHC with the -- DeriveGeneric flag on. class Generic a -- | A class of types that can be fully evaluated. class NFData a -- | rnf should reduce its argument to normal form (that is, fully -- evaluate all sub-components), and then return '()'. -- --

Generic NFData deriving

-- -- Starting with GHC 7.2, you can automatically derive instances for -- types possessing a Generic instance. -- -- Note: Generic1 can be auto-derived starting with GHC 7.4 -- --
--   {-# LANGUAGE DeriveGeneric #-}
--   
--   import GHC.Generics (Generic, Generic1)
--   import Control.DeepSeq
--   
--   data Foo a = Foo a String
--                deriving (Eq, Generic, Generic1)
--   
--   instance NFData a => NFData (Foo a)
--   instance NFData1 Foo
--   
--   data Colour = Red | Green | Blue
--                 deriving Generic
--   
--   instance NFData Colour
--   
-- -- Starting with GHC 7.10, the example above can be written more -- concisely by enabling the new DeriveAnyClass extension: -- --
--   {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
--   
--   import GHC.Generics (Generic)
--   import Control.DeepSeq
--   
--   data Foo a = Foo a String
--                deriving (Eq, Generic, Generic1, NFData, NFData1)
--   
--   data Colour = Red | Green | Blue
--                 deriving (Generic, NFData)
--   
-- --

Compatibility with previous deepseq versions

-- -- Prior to version 1.4.0.0, the default implementation of the rnf -- method was defined as -- --
--   rnf a = seq a ()
--   
-- -- However, starting with deepseq-1.4.0.0, the default -- implementation is based on DefaultSignatures allowing for -- more accurate auto-derived NFData instances. If you need the -- previously used exact default rnf method implementation -- semantics, use -- --
--   instance NFData Colour where rnf x = seq x ()
--   
-- -- or alternatively -- --
--   instance NFData Colour where rnf = rwhnf
--   
-- -- or -- --
--   {-# LANGUAGE BangPatterns #-}
--   instance NFData Colour where rnf !_ = ()
--   
rnf :: NFData a => a -> () -- | GHC.Generics-based rnf implementation -- -- This is needed in order to support deepseq < 1.4 which -- didn't have a Generic-based default rnf implementation -- yet. -- -- In order to define instances, use e.g. -- --
--   instance NFData MyType where rnf = genericRnf
--   
-- -- The implementation has been taken from deepseq-1.4.2's -- default rnf implementation. genericRnf :: (Generic a, GNFData (Rep a)) => a -> () -- | The Binary class provides put and get, methods to -- encode and decode a Haskell value to a lazy ByteString. It -- mirrors the Read and Show classes for textual -- representation of Haskell types, and is suitable for serialising -- Haskell values to disk, over the network. -- -- For decoding and generating simple external binary formats (e.g. C -- structures), Binary may be used, but in general is not suitable for -- complex protocols. Instead use the Put and Get -- primitives directly. -- -- Instances of Binary should satisfy the following property: -- --
--   decode . encode == id
--   
-- -- That is, the get and put methods should be the inverse -- of each other. A range of instances are provided for basic Haskell -- types. class Binary t -- | Encode a value in the Put monad. put :: Binary t => t -> Put -- | Decode a value in the Get monad get :: Binary t => Get t -- | Encode a list of values in the Put monad. The default implementation -- may be overridden to be more efficient but must still have the same -- encoding format. putList :: Binary t => [t] -> Put -- | A monoid on applicative functors. -- -- If defined, some and many should be the least solutions -- of the equations: -- -- class Applicative f => Alternative (f :: * -> *) -- | The identity of <|> empty :: Alternative f => f a -- | An associative binary operation (<|>) :: Alternative f => f a -> f a -> f a -- | One or more. some :: Alternative f => f a -> f [a] -- | Zero or more. many :: Alternative f => f a -> f [a] -- | Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus (m :: * -> *) -- | the identity of mplus. It should also satisfy the equations -- --
--   mzero >>= f  =  mzero
--   v >> mzero   =  mzero
--   
mzero :: MonadPlus m => m a -- | an associative operation mplus :: MonadPlus m => m a -> m a -> m a -- | Class for string-like datastructures; used by the overloaded string -- extension (-XOverloadedStrings in GHC). class IsString a fromString :: IsString a => String -> a type IO a = WithCallStack (IO a) type NoCallStackIO a = IO a -- | A Map from keys k to values a. data Map k a -- | The catMaybes function takes a list of Maybes and -- returns a list of all the Just values. -- --

Examples

-- -- Basic usage: -- --
--   >>> catMaybes [Just 1, Nothing, Just 3]
--   [1,3]
--   
-- -- When constructing a list of Maybe values, catMaybes can -- be used to return all of the "success" results (if the list is the -- result of a map, then mapMaybe would be more -- appropriate): -- --
--   >>> import Text.Read ( readMaybe )
--   
--   >>> [readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]
--   [Just 1,Nothing,Just 3]
--   
--   >>> catMaybes $ [readMaybe x :: Maybe Int | x <- ["1", "Foo", "3"] ]
--   [1,3]
--   
catMaybes :: () => [Maybe a] -> [a] -- | The mapMaybe function is a version of map which can -- throw out elements. In particular, the functional argument returns -- something of type Maybe b. If this is Nothing, -- no element is added on to the result list. If it is Just -- b, then b is included in the result list. -- --

Examples

-- -- Using mapMaybe f x is a shortcut for -- catMaybes $ map f x in most cases: -- --
--   >>> import Text.Read ( readMaybe )
--   
--   >>> let readMaybeInt = readMaybe :: String -> Maybe Int
--   
--   >>> mapMaybe readMaybeInt ["1", "Foo", "3"]
--   [1,3]
--   
--   >>> catMaybes $ map readMaybeInt ["1", "Foo", "3"]
--   [1,3]
--   
-- -- If we map the Just constructor, the entire list should be -- returned: -- --
--   >>> mapMaybe Just [1,2,3]
--   [1,2,3]
--   
mapMaybe :: () => (a -> Maybe b) -> [a] -> [b] -- | The fromMaybe function takes a default value and and -- Maybe value. If the Maybe is Nothing, it returns -- the default values; otherwise, it returns the value contained in the -- Maybe. -- --

Examples

-- -- Basic usage: -- --
--   >>> fromMaybe "" (Just "Hello, World!")
--   "Hello, World!"
--   
-- --
--   >>> fromMaybe "" Nothing
--   ""
--   
-- -- Read an integer from a string using readMaybe. If we fail to -- parse an integer, we want to return 0 by default: -- --
--   >>> import Text.Read ( readMaybe )
--   
--   >>> fromMaybe 0 (readMaybe "5")
--   5
--   
--   >>> fromMaybe 0 (readMaybe "")
--   0
--   
fromMaybe :: () => a -> Maybe a -> a -- | The maybeToList function returns an empty list when given -- Nothing or a singleton list when not given Nothing. -- --

Examples

-- -- Basic usage: -- --
--   >>> maybeToList (Just 7)
--   [7]
--   
-- --
--   >>> maybeToList Nothing
--   []
--   
-- -- One can use maybeToList to avoid pattern matching when combined -- with a function that (safely) works on lists: -- --
--   >>> import Text.Read ( readMaybe )
--   
--   >>> sum $ maybeToList (readMaybe "3")
--   3
--   
--   >>> sum $ maybeToList (readMaybe "")
--   0
--   
maybeToList :: () => Maybe a -> [a] -- | The listToMaybe function returns Nothing on an empty -- list or Just a where a is the first element -- of the list. -- --

Examples

-- -- Basic usage: -- --
--   >>> listToMaybe []
--   Nothing
--   
-- --
--   >>> listToMaybe [9]
--   Just 9
--   
-- --
--   >>> listToMaybe [1,2,3]
--   Just 1
--   
-- -- Composing maybeToList with listToMaybe should be the -- identity on singleton/empty lists: -- --
--   >>> maybeToList $ listToMaybe [5]
--   [5]
--   
--   >>> maybeToList $ listToMaybe []
--   []
--   
-- -- But not on lists with more than one element: -- --
--   >>> maybeToList $ listToMaybe [1,2,3]
--   [1]
--   
listToMaybe :: () => [a] -> Maybe a -- | The isNothing function returns True iff its argument is -- Nothing. -- --

Examples

-- -- Basic usage: -- --
--   >>> isNothing (Just 3)
--   False
--   
-- --
--   >>> isNothing (Just ())
--   False
--   
-- --
--   >>> isNothing Nothing
--   True
--   
-- -- Only the outer constructor is taken into consideration: -- --
--   >>> isNothing (Just Nothing)
--   False
--   
isNothing :: () => Maybe a -> Bool -- | The isJust function returns True iff its argument is of -- the form Just _. -- --

Examples

-- -- Basic usage: -- --
--   >>> isJust (Just 3)
--   True
--   
-- --
--   >>> isJust (Just ())
--   True
--   
-- --
--   >>> isJust Nothing
--   False
--   
-- -- Only the outer constructor is taken into consideration: -- --
--   >>> isJust (Just Nothing)
--   True
--   
isJust :: () => Maybe a -> Bool -- | The unfoldr function is a `dual' to foldr: while -- foldr reduces a list to a summary value, unfoldr builds -- a list from a seed value. The function takes the element and returns -- Nothing if it is done producing the list or returns Just -- (a,b), in which case, a is a prepended to the list -- and b is used as the next element in a recursive call. For -- example, -- --
--   iterate f == unfoldr (\x -> Just (x, f x))
--   
-- -- In some cases, unfoldr can undo a foldr operation: -- --
--   unfoldr f' (foldr f z xs) == xs
--   
-- -- if the following holds: -- --
--   f' (f x y) = Just (x,y)
--   f' z       = Nothing
--   
-- -- A simple use of unfoldr: -- --
--   unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
--    [10,9,8,7,6,5,4,3,2,1]
--   
unfoldr :: () => (b -> Maybe (a, b)) -> b -> [a] -- | The isPrefixOf function takes two lists and returns True -- iff the first list is a prefix of the second. isPrefixOf :: Eq a => [a] -> [a] -> Bool -- | The isSuffixOf function takes two lists and returns True -- iff the first list is a suffix of the second. The second list must be -- finite. isSuffixOf :: 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 :: () => [a] -> [[a]] -> [a] -- | The intersperse function takes an element and a list and -- `intersperses' that element between the elements of the list. For -- example, -- --
--   intersperse ',' "abcde" == "a,b,c,d,e"
--   
intersperse :: () => a -> [a] -> [a] -- | The sort function implements a stable sorting algorithm. It is -- a special case of sortBy, which allows the programmer to supply -- their own comparison function. -- -- Elements are arranged from from lowest to highest, keeping duplicates -- in the order they appeared in the input. sort :: Ord a => [a] -> [a] -- | The sortBy function is the non-overloaded version of -- sort. sortBy :: () => (a -> a -> Ordering) -> [a] -> [a] -- | O(n^2). The nub function removes duplicate elements from -- a list. In particular, it keeps only the first occurrence of each -- element. (The name nub means `essence'.) It is a special case -- of nubBy, which allows the programmer to supply their own -- equality test. nub :: Eq a => [a] -> [a] -- | The nubBy function behaves just like nub, except it uses -- a user-supplied equality predicate instead of the overloaded == -- function. nubBy :: () => (a -> a -> Bool) -> [a] -> [a] -- | Data structures that can be folded. -- -- For example, given a data type -- --
--   data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
--   
-- -- a suitable instance would be -- --
--   instance Foldable Tree where
--      foldMap f Empty = mempty
--      foldMap f (Leaf x) = f x
--      foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r
--   
-- -- This is suitable even for abstract types, as the monoid is assumed to -- satisfy the monoid laws. Alternatively, one could define -- foldr: -- --
--   instance Foldable Tree where
--      foldr f z Empty = z
--      foldr f z (Leaf x) = f x z
--      foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l
--   
-- -- Foldable instances are expected to satisfy the following -- laws: -- --
--   foldr f z t = appEndo (foldMap (Endo . f) t ) z
--   
-- --
--   foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
--   
-- --
--   fold = foldMap id
--   
-- -- sum, product, maximum, and minimum -- should all be essentially equivalent to foldMap forms, such -- as -- --
--   sum = getSum . foldMap Sum
--   
-- -- but may be less defined. -- -- If the type is also a Functor instance, it should satisfy -- --
--   foldMap f = fold . fmap f
--   
-- -- which implies that -- --
--   foldMap f . fmap g = foldMap (f . g)
--   
class Foldable (t :: * -> *) -- | Map each element of the structure to a monoid, and combine the -- results. foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m -- | Right-associative fold of a structure. -- -- In the case of lists, foldr, when applied to a binary operator, -- a starting value (typically the right-identity of the operator), and a -- list, reduces the list using the binary operator, from right to left: -- --
--   foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
--   
-- -- Note that, since the head of the resulting expression is produced by -- an application of the operator to the first element of the list, -- foldr can produce a terminating expression from an infinite -- list. -- -- For a general Foldable structure this should be semantically -- identical to, -- --
--   foldr f z = foldr f z . toList
--   
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b -- | Left-associative fold of a structure. -- -- In the case of lists, foldl, when applied to a binary operator, -- a starting value (typically the left-identity of the operator), and a -- list, reduces the list using the binary operator, from left to right: -- --
--   foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
--   
-- -- Note that to produce the outermost application of the operator the -- entire input list must be traversed. This means that foldl' -- will diverge if given an infinite list. -- -- Also note that if you want an efficient left-fold, you probably want -- to use foldl' instead of foldl. The reason for this is -- that latter does not force the "inner" results (e.g. z f -- x1 in the above example) before applying them to the operator -- (e.g. to (f x2)). This results in a thunk chain -- O(n) elements long, which then must be evaluated from the -- outside-in. -- -- For a general Foldable structure this should be semantically -- identical to, -- --
--   foldl f z = foldl f z . toList
--   
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b -- | Left-associative fold of a structure but with strict application of -- the operator. -- -- This ensures that each step of the fold is forced to weak head normal -- form before being applied, avoiding the collection of thunks that -- would otherwise occur. This is often what you want to strictly reduce -- a finite list to a single, monolithic result (e.g. length). -- -- For a general Foldable structure this should be semantically -- identical to, -- --
--   foldl f z = foldl' f z . toList
--   
foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b -- | A variant of foldr that has no base case, and thus may only be -- applied to non-empty structures. -- --
--   foldr1 f = foldr1 f . toList
--   
foldr1 :: Foldable t => (a -> a -> a) -> t a -> a -- | A variant of foldl that has no base case, and thus may only be -- applied to non-empty structures. -- --
--   foldl1 f = foldl1 f . toList
--   
foldl1 :: Foldable t => (a -> a -> a) -> t a -> a -- | Test whether the structure is empty. The default implementation is -- optimized for structures that are similar to cons-lists, because there -- is no general way to do better. null :: Foldable t => t a -> Bool -- | Returns the size/length of a finite structure as an Int. The -- default implementation is optimized for structures that are similar to -- cons-lists, because there is no general way to do better. length :: Foldable t => t a -> Int -- | Does the element occur in the structure? elem :: (Foldable t, Eq a) => a -> t a -> Bool -- | The largest element of a non-empty structure. maximum :: (Foldable t, Ord a) => t a -> a -- | The least element of a non-empty structure. minimum :: (Foldable t, Ord a) => t a -> a -- | The sum function computes the sum of the numbers of a -- structure. sum :: (Foldable t, Num a) => t a -> a -- | The product function computes the product of the numbers of a -- structure. product :: (Foldable t, Num a) => t a -> a -- | Map each element of the structure to a monoid, and combine the -- results. foldMap :: Foldable t => forall m a. Monoid m => (a -> m) -> t a -> m -- | Right-associative fold of a structure. -- -- In the case of lists, foldr, when applied to a binary operator, -- a starting value (typically the right-identity of the operator), and a -- list, reduces the list using the binary operator, from right to left: -- --
--   foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
--   
-- -- Note that, since the head of the resulting expression is produced by -- an application of the operator to the first element of the list, -- foldr can produce a terminating expression from an infinite -- list. -- -- For a general Foldable structure this should be semantically -- identical to, -- --
--   foldr f z = foldr f z . toList
--   
foldr :: Foldable t => forall a b. () => (a -> b -> b) -> b -> t a -> b -- | Test whether the structure is empty. The default implementation is -- optimized for structures that are similar to cons-lists, because there -- is no general way to do better. null :: Foldable t => forall a. () => t a -> Bool -- | Returns the size/length of a finite structure as an Int. The -- default implementation is optimized for structures that are similar to -- cons-lists, because there is no general way to do better. length :: Foldable t => forall a. () => t a -> Int -- | The find function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- Nothing if there is no such element. find :: Foldable t => (a -> Bool) -> t a -> Maybe a -- | Left-associative fold of a structure but with strict application of -- the operator. -- -- This ensures that each step of the fold is forced to weak head normal -- form before being applied, avoiding the collection of thunks that -- would otherwise occur. This is often what you want to strictly reduce -- a finite list to a single, monolithic result (e.g. length). -- -- For a general Foldable structure this should be semantically -- identical to, -- --
--   foldl f z = foldl' f z . toList
--   
foldl' :: Foldable t => forall b a. () => (b -> a -> b) -> b -> t a -> b -- | Map each element of a structure to an action, evaluate these actions -- from left to right, and ignore the results. For a version that doesn't -- ignore the results see traverse. traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () -- | for_ is traverse_ with its arguments flipped. For a -- version that doesn't ignore the results see for. -- --
--   >>> for_ [1..4] print
--   1
--   2
--   3
--   4
--   
for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () -- | Functors representing data structures that can be traversed from left -- to right. -- -- A definition of traverse must satisfy the following laws: -- -- -- -- A definition of sequenceA must satisfy the following laws: -- -- -- -- where an applicative transformation is a function -- --
--   t :: (Applicative f, Applicative g) => f a -> g a
--   
-- -- preserving the Applicative operations, i.e. -- -- -- -- and the identity functor Identity and composition of functors -- Compose are defined as -- --
--   newtype Identity a = Identity a
--   
--   instance Functor Identity where
--     fmap f (Identity x) = Identity (f x)
--   
--   instance Applicative Identity where
--     pure x = Identity x
--     Identity f <*> Identity x = Identity (f x)
--   
--   newtype Compose f g a = Compose (f (g a))
--   
--   instance (Functor f, Functor g) => Functor (Compose f g) where
--     fmap f (Compose x) = Compose (fmap (fmap f) x)
--   
--   instance (Applicative f, Applicative g) => Applicative (Compose f g) where
--     pure x = Compose (pure (pure x))
--     Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
--   
-- -- (The naturality law is implied by parametricity.) -- -- Instances are similar to Functor, e.g. given a data type -- --
--   data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
--   
-- -- a suitable instance would be -- --
--   instance Traversable Tree where
--      traverse f Empty = pure Empty
--      traverse f (Leaf x) = Leaf <$> f x
--      traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
--   
-- -- This is suitable even for abstract types, as the laws for -- <*> imply a form of associativity. -- -- The superclass instances should satisfy the following: -- -- class (Functor t, Foldable t) => Traversable (t :: * -> *) -- | Map each element of a structure to an action, evaluate these actions -- from left to right, and collect the results. For a version that -- ignores the results see traverse_. traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f t b -- | Evaluate each action in the structure from left to right, and and -- collect the results. For a version that ignores the results see -- sequenceA_. sequenceA :: (Traversable t, Applicative f) => t f a -> f t a -- | Map each element of a structure to an action, evaluate these actions -- from left to right, and collect the results. For a version that -- ignores the results see traverse_. traverse :: Traversable t => forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f t b -- | Evaluate each action in the structure from left to right, and and -- collect the results. For a version that ignores the results see -- sequenceA_. sequenceA :: Traversable t => forall (f :: * -> *) a. Applicative f => t f a -> f t a -- | for is traverse with its arguments flipped. For a -- version that ignores the results see for_. for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f t b -- | Send the first component of the input through the argument arrow, and -- copy the rest unchanged to the output. first :: Arrow a => forall b c d. () => a b c -> a (b, d) (c, d) -- | Promote a function to a monad. liftM :: Monad m => (a1 -> r) -> m a1 -> m r -- | Promote a function to a monad, scanning the monadic arguments from -- left to right. For example, -- --
--   liftM2 (+) [0,1] [0,2] = [0,2,1,3]
--   liftM2 (+) (Just 1) Nothing = Nothing
--   
liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r -- | The reverse of when. unless :: Applicative f => Bool -> f () -> f () -- | Conditional execution of Applicative expressions. For example, -- --
--   when debug (putStrLn "Debugging")
--   
-- -- will output the string Debugging if the Boolean value -- debug is True, and otherwise do nothing. when :: Applicative f => Bool -> f () -> f () -- | In many situations, the liftM operations can be replaced by -- uses of ap, which promotes function application. -- --
--   return f `ap` x1 `ap` ... `ap` xn
--   
-- -- is equivalent to -- --
--   liftMn f x1 x2 ... xn
--   
ap :: Monad m => m (a -> b) -> m a -> m b -- | void value discards or ignores the result of -- evaluation, such as the return value of an IO action. -- --

Examples

-- -- Replace the contents of a Maybe Int with -- unit: -- --
--   >>> void Nothing
--   Nothing
--   
--   >>> void (Just 3)
--   Just ()
--   
-- -- Replace the contents of an Either Int -- Int with unit, resulting in an Either -- Int '()': -- --
--   >>> void (Left 8675309)
--   Left 8675309
--   
--   >>> void (Right 8675309)
--   Right ()
--   
-- -- Replace every element of a list with unit: -- --
--   >>> void [1,2,3]
--   [(),(),()]
--   
-- -- Replace the second element of a pair with unit: -- --
--   >>> void (1,2)
--   (1,())
--   
-- -- Discard the result of an IO action: -- --
--   >>> mapM print [1,2]
--   1
--   2
--   [(),()]
--   
--   >>> void $ mapM print [1,2]
--   1
--   2
--   
void :: Functor f => f a -> f () -- | The foldM function is analogous to foldl, except that -- its result is encapsulated in a monad. Note that foldM works -- from left-to-right over the list arguments. This could be an issue -- where (>>) and the `folded function' are not -- commutative. -- --
--   foldM f a1 [x1, x2, ..., xm]
--   
-- -- == -- --
--   do
--     a2 <- f a1 x1
--     a3 <- f a2 x2
--     ...
--     f am xm
--   
-- -- If right-to-left evaluation is required, the input list should be -- reversed. -- -- Note: foldM is the same as foldlM foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b -- | This generalizes the list-based filter function. filterM :: Applicative m => (a -> m Bool) -> [a] -> m [a] -- | Returns True for any Unicode space character, and the control -- characters \t, \n, \r, \f, -- \v. isSpace :: Char -> Bool -- | Selects ASCII digits, i.e. '0'..'9'. isDigit :: Char -> Bool -- | Selects upper-case or title-case alphabetic Unicode characters -- (letters). Title case is used by a small number of letter ligatures -- like the single-character form of Lj. isUpper :: Char -> Bool -- | Selects alphabetic Unicode characters (lower-case, upper-case and -- title-case letters, plus letters of caseless scripts and modifiers -- letters). This function is equivalent to isLetter. isAlpha :: Char -> Bool -- | Selects alphabetic or numeric digit Unicode characters. -- -- Note that numeric digits outside the ASCII range are selected by this -- function but not by isDigit. Such digits may be part of -- identifiers but are not used by the printer and reader to represent -- numbers. isAlphaNum :: Char -> Bool -- | The toEnum method restricted to the type Char. chr :: Int -> Char -- | The fromEnum method restricted to the type Char. ord :: Char -> Int -- | Convert a letter to the corresponding lower-case letter, if any. Any -- other character is returned unchanged. toLower :: Char -> Char -- | Convert a letter to the corresponding upper-case letter, if any. Any -- other character is returned unchanged. toUpper :: Char -> Char -- | A Word is an unsigned integral type, with the same size as -- Int. data Word -- | 8-bit unsigned integer type data Word8 -- | 16-bit unsigned integer type data Word16 -- | 32-bit unsigned integer type data Word32 -- | 64-bit unsigned integer type data Word64 -- | 8-bit signed integer type data Int8 -- | 16-bit signed integer type data Int16 -- | 32-bit signed integer type data Int32 -- | 64-bit signed integer type data Int64 -- | New name for <> (<<>>) :: Doc -> Doc -> Doc -- | A data type representing directed graphs, backed by Data.Graph. -- It is strict in the node type. -- -- This is an alternative interface to Data.Graph. In this -- interface, nodes (identified by the IsNode type class) are -- associated with a key and record the keys of their neighbors. This -- interface is more convenient than Graph, which requires -- vertices to be explicitly handled by integer indexes. -- -- The current implementation has somewhat peculiar performance -- characteristics. The asymptotics of all map-like operations mirror -- their counterparts in Data.Map. However, to perform a graph -- operation, we first must build the Data.Graph representation, -- an operation that takes O(V + E log V). However, this operation -- can be amortized across all queries on that particular graph. -- -- Some nodes may be broken, i.e., refer to neighbors which are not -- stored in the graph. In our graph algorithms, we transparently ignore -- such edges; however, you can easily query for the broken vertices of a -- graph using broken (and should, e.g., to ensure that a closure -- of a graph is well-formed.) It's possible to take a closed subset of a -- broken graph and get a well-formed graph. module Distribution.Compat.Graph -- | A graph of nodes a. The nodes are expected to have instance -- of class IsNode. data Graph a -- | The IsNode class is used for datatypes which represent directed -- graph nodes. A node of type a is associated with some unique -- key of type Key a; given a node we can determine its -- key (nodeKey) and the keys of its neighbors -- (nodeNeighbors). class Ord (Key a) => IsNode a where { type family Key a :: *; } nodeKey :: IsNode a => a -> Key a nodeNeighbors :: IsNode a => a -> [Key a] -- | O(1). Is the graph empty? null :: Graph a -> Bool -- | O(1). The number of nodes in the graph. size :: Graph a -> Int -- | O(log V). Check if the key is in the graph. member :: IsNode a => Key a -> Graph a -> Bool -- | O(log V). Lookup the node at a key in the graph. lookup :: IsNode a => Key a -> Graph a -> Maybe a -- | O(1). The empty graph. empty :: IsNode a => Graph a -- | O(log V). Insert a node into a graph. insert :: IsNode a => a -> Graph a -> Graph a -- | O(log V). Delete the node at a key from the graph. deleteKey :: IsNode a => Key a -> Graph a -> Graph a -- | O(log V). Lookup and delete. This function returns the deleted -- value if it existed. deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a) -- | O(V + V'). Left-biased union, preferring entries from the first -- map when conflicts occur. unionLeft :: IsNode a => Graph a -> Graph a -> Graph a -- | O(V + V'). Right-biased union, preferring entries from the -- second map when conflicts occur. nodeKey x = nodeKey -- (f x). unionRight :: IsNode a => Graph a -> Graph a -> Graph a -- | Ω(V + E). Compute the strongly connected components of a graph. -- Requires amortized construction of graph. stronglyConnComp :: Graph a -> [SCC a] -- | Strongly connected component. data SCC vertex -- | A single vertex that is not in any cycle. AcyclicSCC :: vertex -> SCC vertex -- | A maximal set of mutually reachable vertices. CyclicSCC :: [vertex] -> SCC vertex -- | Ω(V + E). Compute the cycles of a graph. Requires amortized -- construction of graph. cycles :: Graph a -> [[a]] -- | O(1). Return a list of nodes paired with their broken neighbors -- (i.e., neighbor keys which are not in the graph). Requires amortized -- construction of graph. broken :: Graph a -> [(a, [Key a])] -- | Lookup the immediate neighbors from a key in the graph. Requires -- amortized construction of graph. neighbors :: Graph a -> Key a -> Maybe [a] -- | Lookup the immediate reverse neighbors from a key in the graph. -- Requires amortized construction of graph. revNeighbors :: Graph a -> Key a -> Maybe [a] -- | Compute the subgraph which is the closure of some set of keys. Returns -- Nothing if one (or more) keys are not present in the graph. -- Requires amortized construction of graph. closure :: Graph a -> [Key a] -> Maybe [a] -- | Compute the reverse closure of a graph from some set of keys. Returns -- Nothing if one (or more) keys are not present in the graph. -- Requires amortized construction of graph. revClosure :: Graph a -> [Key a] -> Maybe [a] -- | Topologically sort the nodes of a graph. Requires amortized -- construction of graph. topSort :: Graph a -> [a] -- | Reverse topologically sort the nodes of a graph. Requires amortized -- construction of graph. revTopSort :: Graph a -> [a] -- | O(1). Convert a graph into a map from keys to nodes. The -- resulting map m is guaranteed to have the property that -- all ((k,n) -> k == nodeKey n) (toList -- m). toMap :: Graph a -> Map (Key a) a -- | O(V log V). Convert a list of nodes (with distinct keys) into a -- graph. fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a -- | O(V). Convert a graph into a list of nodes. toList :: Graph a -> [a] -- | O(V). Convert a graph into a list of keys. keys :: Graph a -> [Key a] -- | O(V). Convert a graph into a set of keys. keysSet :: Graph a -> Set (Key a) -- | O(1). Convert a graph into a Graph. Requires amortized -- construction of graph. toGraph :: Graph a -> (Graph, Vertex -> a, Key a -> Maybe Vertex) -- | A simple, trivial data type which admits an IsNode instance. data Node k a N :: a -> k -> [k] -> Node k a -- | Get the value from a Node. nodeValue :: Node k a -> a instance (GHC.Classes.Eq k, GHC.Classes.Eq a) => GHC.Classes.Eq (Distribution.Compat.Graph.Node k a) instance (GHC.Show.Show k, GHC.Show.Show a) => GHC.Show.Show (Distribution.Compat.Graph.Node k a) instance GHC.Base.Functor (Distribution.Compat.Graph.Node k) instance GHC.Classes.Ord k => Distribution.Compat.Graph.IsNode (Distribution.Compat.Graph.Node k a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Compat.Graph.Graph a) instance (Distribution.Compat.Graph.IsNode a, GHC.Read.Read a, GHC.Show.Show (Distribution.Compat.Graph.Key a)) => GHC.Read.Read (Distribution.Compat.Graph.Graph a) instance (Distribution.Compat.Graph.IsNode a, Data.Binary.Class.Binary a, GHC.Show.Show (Distribution.Compat.Graph.Key a)) => Data.Binary.Class.Binary (Distribution.Compat.Graph.Graph a) instance (GHC.Classes.Eq (Distribution.Compat.Graph.Key a), GHC.Classes.Eq a) => GHC.Classes.Eq (Distribution.Compat.Graph.Graph a) instance Data.Foldable.Foldable Distribution.Compat.Graph.Graph instance (Control.DeepSeq.NFData a, Control.DeepSeq.NFData (Distribution.Compat.Graph.Key a)) => Control.DeepSeq.NFData (Distribution.Compat.Graph.Graph a) instance (Distribution.Compat.Graph.IsNode a, Distribution.Compat.Graph.IsNode b, Distribution.Compat.Graph.Key a ~ Distribution.Compat.Graph.Key b) => Distribution.Compat.Graph.IsNode (Data.Either.Either a b) -- | A very simple difference list. module Distribution.Compat.DList -- | Difference list. data DList a runDList :: DList a -> [a] -- | Make DList with containing single element. singleton :: a -> DList a snoc :: DList a -> a -> DList a instance GHC.Base.Monoid (Distribution.Compat.DList.DList a) instance Data.Semigroup.Semigroup (Distribution.Compat.DList.DList a) module Distribution.Compat.CreatePipe createPipe :: IO (Handle, Handle) -- | Common utils used by modules under Distribution.PackageDescription.*. module Distribution.PackageDescription.Utils cabalBug :: String -> a userBug :: String -> a -- | 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 parseReadE :: ReadE a -> ReadP r a readEOrFail :: ReadE a -> String -> a readP_to_E :: (String -> ErrorMsg) -> ReadP a a -> ReadE a instance GHC.Base.Functor Distribution.ReadE.ReadE -- | 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 Data.Semigroup.Semigroup Distribution.Simple.CCompiler.CDialect -- | 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 String -- | No unliteration. plain :: String -> String -> String -- | 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.Result instance GHC.Read.Read Distribution.TestSuite.Result instance GHC.Classes.Eq Distribution.TestSuite.Result 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.OptionType instance GHC.Read.Read Distribution.TestSuite.OptionType instance GHC.Classes.Eq Distribution.TestSuite.OptionType -- | This defines a Text class which is a bit like the Read -- and Show classes. The difference is that is uses a modern -- pretty printer and parser system and the format is not expected to be -- Haskell concrete syntax but rather the external human readable -- representation used by Cabal. module Distribution.Text class Text a disp :: Text a => a -> Doc parse :: Text a => ReadP r a -- | The default rendering style used in Cabal for console output. It has a -- fixed page width and adds line breaks automatically. defaultStyle :: Style -- | Pretty-prints with the default style. display :: Text a => a -> String -- | A style for rendering all on one line. flatStyle :: Style simpleParse :: Text a => String -> Maybe a stdParse :: Text ver => (ver -> String -> res) -> ReadP r res instance Distribution.Text.Text GHC.Types.Bool instance Distribution.Text.Text GHC.Types.Int instance Distribution.Text.Text Data.Version.Version -- | Cabal often needs to do slightly different things on specific -- platforms. You probably know about the os however using that is -- very inconvenient because it is a string and different Haskell -- implementations do not agree on using the same strings for the same -- platforms! (In particular see the controversy over "windows" vs -- "mingw32"). So to make it more consistent and easy to use we have an -- OS enumeration. module Distribution.System -- | These are the known OS names: Linux, Windows, OSX ,FreeBSD, OpenBSD, -- NetBSD, DragonFly ,Solaris, AIX, HPUX, IRIX ,HaLVM ,Hurd ,IOS, -- Android,Ghcjs -- -- The following aliases can also be used:, * Windows aliases: mingw32, -- win32, cygwin32 * OSX alias: darwin * Hurd alias: gnu * FreeBSD alias: -- kfreebsdgnu * Solaris alias: solaris2 data OS Linux :: OS Windows :: OS OSX :: OS FreeBSD :: OS OpenBSD :: OS NetBSD :: OS DragonFly :: OS Solaris :: OS AIX :: OS HPUX :: OS IRIX :: OS HaLVM :: OS Hurd :: OS IOS :: OS Android :: OS Ghcjs :: OS OtherOS :: String -> OS buildOS :: OS -- | These are the known Arches: I386, X86_64, PPC, PPC64, Sparc ,Arm, -- Mips, SH, IA64, S39, Alpha, Hppa, Rs6000, M68k, Vax and JavaScript. -- -- The following aliases can also be used: * PPC alias: powerpc * PPC64 -- alias : powerpc64 * Sparc aliases: sparc64, sun4 * Mips aliases: -- mipsel, mipseb * Arm aliases: armeb, armel data Arch I386 :: Arch X86_64 :: Arch PPC :: Arch PPC64 :: Arch Sparc :: Arch Arm :: Arch Mips :: Arch SH :: Arch IA64 :: Arch S390 :: Arch Alpha :: Arch Hppa :: Arch Rs6000 :: Arch M68k :: Arch Vax :: Arch JavaScript :: Arch OtherArch :: String -> Arch buildArch :: Arch data Platform Platform :: Arch -> OS -> Platform -- | The platform Cabal was compiled on. In most cases, -- LocalBuildInfo.hostPlatform should be used instead (the -- platform we're targeting). buildPlatform :: Platform platformFromTriple :: String -> Maybe Platform knownOSs :: [OS] knownArches :: [Arch] -- | How strict to be when classifying strings into the OS and -- Arch enums. -- -- The reason we have multiple ways to do the classification is because -- there are two situations where we need to do it. -- -- For parsing OS and arch names in .cabal files we really want everyone -- to be referring to the same or or arch by the same name. Variety is -- not a virtue in this case. We don't mind about case though. -- -- For the System.Info.os/arch different Haskell implementations use -- different names for the same or/arch. Also they tend to distinguish -- versions of an OS/arch which we just don't care about. -- -- The Compat classification allows us to recognise aliases that -- are already in common use but it allows us to distinguish them from -- the canonical name which enables us to warn about such deprecated -- aliases. data ClassificationStrictness Permissive :: ClassificationStrictness Compat :: ClassificationStrictness Strict :: ClassificationStrictness classifyOS :: ClassificationStrictness -> String -> OS classifyArch :: ClassificationStrictness -> String -> Arch instance Data.Data.Data Distribution.System.Platform instance GHC.Read.Read Distribution.System.Platform instance GHC.Show.Show Distribution.System.Platform instance GHC.Classes.Ord Distribution.System.Platform instance GHC.Generics.Generic Distribution.System.Platform instance GHC.Classes.Eq Distribution.System.Platform instance Data.Data.Data Distribution.System.Arch instance GHC.Read.Read Distribution.System.Arch instance GHC.Show.Show Distribution.System.Arch instance GHC.Classes.Ord Distribution.System.Arch instance GHC.Generics.Generic Distribution.System.Arch instance GHC.Classes.Eq Distribution.System.Arch instance Data.Data.Data Distribution.System.OS instance GHC.Read.Read Distribution.System.OS instance GHC.Show.Show Distribution.System.OS instance GHC.Classes.Ord Distribution.System.OS instance GHC.Generics.Generic Distribution.System.OS instance GHC.Classes.Eq Distribution.System.OS instance Data.Binary.Class.Binary Distribution.System.Platform instance Distribution.Text.Text Distribution.System.Platform instance Data.Binary.Class.Binary Distribution.System.Arch instance Distribution.Text.Text Distribution.System.Arch instance Data.Binary.Class.Binary Distribution.System.OS instance Distribution.Text.Text Distribution.System.OS module Distribution.Types.BuildType -- | The type of build system used by this package. data BuildType -- | calls Distribution.Simple.defaultMain Simple :: BuildType -- | calls Distribution.Simple.defaultMainWithHooks -- defaultUserHooks, which invokes configure to generate -- additional build information used by later phases. Configure :: BuildType -- | calls Distribution.Make.defaultMain Make :: BuildType -- | uses user-supplied Setup.hs or Setup.lhs (default) Custom :: BuildType -- | a package that uses an unknown build type cannot actually be built. -- Doing it this way rather than just giving a parse error means we get -- better error messages and allows you to inspect the rest of the -- package description. UnknownBuildType :: String -> BuildType knownBuildTypes :: [BuildType] instance Data.Data.Data Distribution.Types.BuildType.BuildType instance GHC.Classes.Eq Distribution.Types.BuildType.BuildType instance GHC.Read.Read Distribution.Types.BuildType.BuildType instance GHC.Show.Show Distribution.Types.BuildType.BuildType instance GHC.Generics.Generic Distribution.Types.BuildType.BuildType instance Data.Binary.Class.Binary Distribution.Types.BuildType.BuildType instance Distribution.Text.Text Distribution.Types.BuildType.BuildType module Distribution.Types.Condition -- | A boolean expression parameterized over the variable type used. data Condition c Var :: c -> Condition c Lit :: Bool -> Condition c CNot :: (Condition c) -> Condition c COr :: (Condition c) -> (Condition c) -> Condition c CAnd :: (Condition c) -> (Condition c) -> Condition c -- | Boolean negation of a Condition value. cNot :: Condition a -> Condition a -- | Boolean AND of two Condtion values. cAnd :: Condition a -> Condition a -> Condition a -- | Boolean OR of two Condition values. cOr :: Eq v => Condition v -> Condition v -> Condition v -- | Simplify the condition and return its free variables. simplifyCondition :: Condition c -> (c -> Either d Bool) -> (Condition d, [d]) instance GHC.Generics.Generic (Distribution.Types.Condition.Condition c) instance Data.Data.Data c => Data.Data.Data (Distribution.Types.Condition.Condition c) instance GHC.Classes.Eq c => GHC.Classes.Eq (Distribution.Types.Condition.Condition c) instance GHC.Show.Show c => GHC.Show.Show (Distribution.Types.Condition.Condition c) instance GHC.Base.Functor Distribution.Types.Condition.Condition instance Data.Foldable.Foldable Distribution.Types.Condition.Condition instance Data.Traversable.Traversable Distribution.Types.Condition.Condition instance GHC.Base.Applicative Distribution.Types.Condition.Condition instance GHC.Base.Monad Distribution.Types.Condition.Condition instance GHC.Base.Monoid (Distribution.Types.Condition.Condition a) instance Data.Semigroup.Semigroup (Distribution.Types.Condition.Condition a) instance GHC.Base.Alternative Distribution.Types.Condition.Condition instance GHC.Base.MonadPlus Distribution.Types.Condition.Condition instance Data.Binary.Class.Binary c => Data.Binary.Class.Binary (Distribution.Types.Condition.Condition c) module Distribution.Types.CondTree -- | A CondTree is used to represent the conditional structure of a -- Cabal file, reflecting a syntax element subject to constraints, and -- then any number of sub-elements which may be enabled subject to some -- condition. Both a and c are usually Monoids. -- -- To be more concrete, consider the following fragment of a -- Cabal file: -- --
--   build-depends: base >= 4.0
--   if flag(extra)
--       build-depends: base >= 4.2
--   
-- -- One way to represent this is to have CondTree -- ConfVar [Dependency] BuildInfo. Here, -- condTreeData represents the actual fields which are not behind -- any conditional, while condTreeComponents recursively records -- any further fields which are behind a conditional. -- condTreeConstraints records the constraints (in this case, -- base >= 4.0) which would be applied if you use this -- syntax; in general, this is derived off of targetBuildInfo -- (perhaps a good refactoring would be to convert this into an opaque -- type, with a smart constructor that pre-computes the dependencies.) data CondTree v c a CondNode :: a -> c -> [CondBranch v c a] -> CondTree v c a [condTreeData] :: CondTree v c a -> a [condTreeConstraints] :: CondTree v c a -> c [condTreeComponents] :: CondTree v c a -> [CondBranch v c a] -- | A CondBranch represents a conditional branch, e.g., if -- flag(foo) on some syntax a. It also has an optional -- false branch. data CondBranch v c a CondBranch :: Condition v -> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a [condBranchCondition] :: CondBranch v c a -> Condition v [condBranchIfTrue] :: CondBranch v c a -> CondTree v c a [condBranchIfFalse] :: CondBranch v c a -> Maybe (CondTree v c a) condIfThen :: Condition v -> CondTree v c a -> CondBranch v c a condIfThenElse :: Condition v -> CondTree v c a -> CondTree v c a -> CondBranch v c a mapCondTree :: (a -> b) -> (c -> d) -> (Condition v -> Condition w) -> CondTree v c a -> CondTree w d b mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d a mapTreeConds :: (Condition v -> Condition w) -> CondTree v c a -> CondTree w c a mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b -- | Extract the condition matched by the given predicate from a cond tree. -- -- We use this mainly for extracting buildable conditions (see the Note -- above), but the function is in fact more general. extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v -- | Flattens a CondTree using a partial flag assignment. When a condition -- cannot be evaluated, both branches are ignored. simplifyCondTree :: (Monoid a, Monoid d) => (v -> Either v Bool) -> CondTree v d a -> (d, a) -- | Flatten a CondTree. This will resolve the CondTree by taking all -- possible paths into account. Note that since branches represent -- exclusive choices this may not result in a "sane" result. ignoreConditions :: (Monoid a, Monoid c) => CondTree v c a -> (a, c) instance Data.Traversable.Traversable (Distribution.Types.CondTree.CondTree v c) instance Data.Foldable.Foldable (Distribution.Types.CondTree.CondTree v c) instance GHC.Base.Functor (Distribution.Types.CondTree.CondTree v c) instance GHC.Generics.Generic (Distribution.Types.CondTree.CondTree v c a) instance (Data.Data.Data a, Data.Data.Data c, Data.Data.Data v) => Data.Data.Data (Distribution.Types.CondTree.CondTree v c a) instance (GHC.Classes.Eq v, GHC.Classes.Eq c, GHC.Classes.Eq a) => GHC.Classes.Eq (Distribution.Types.CondTree.CondTree v c a) instance (GHC.Show.Show v, GHC.Show.Show c, GHC.Show.Show a) => GHC.Show.Show (Distribution.Types.CondTree.CondTree v c a) instance Data.Traversable.Traversable (Distribution.Types.CondTree.CondBranch v c) instance GHC.Base.Functor (Distribution.Types.CondTree.CondBranch v c) instance GHC.Generics.Generic (Distribution.Types.CondTree.CondBranch v c a) instance (Data.Data.Data a, Data.Data.Data c, Data.Data.Data v) => Data.Data.Data (Distribution.Types.CondTree.CondBranch v c a) instance (GHC.Classes.Eq a, GHC.Classes.Eq c, GHC.Classes.Eq v) => GHC.Classes.Eq (Distribution.Types.CondTree.CondBranch v c a) instance (GHC.Show.Show a, GHC.Show.Show c, GHC.Show.Show v) => GHC.Show.Show (Distribution.Types.CondTree.CondBranch v c a) instance (Data.Binary.Class.Binary v, Data.Binary.Class.Binary c, Data.Binary.Class.Binary a) => Data.Binary.Class.Binary (Distribution.Types.CondTree.CondTree v c a) instance Data.Foldable.Foldable (Distribution.Types.CondTree.CondBranch v c) instance (Data.Binary.Class.Binary v, Data.Binary.Class.Binary c, Data.Binary.Class.Binary a) => Data.Binary.Class.Binary (Distribution.Types.CondTree.CondBranch v c a) module Distribution.Types.ExecutableScope data ExecutableScope ExecutableScopeUnknown :: ExecutableScope ExecutablePublic :: ExecutableScope ExecutablePrivate :: ExecutableScope instance Data.Data.Data Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Classes.Eq Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Read.Read Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Show.Show Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Generics.Generic Distribution.Types.ExecutableScope.ExecutableScope instance Distribution.Text.Text Distribution.Types.ExecutableScope.ExecutableScope instance Data.Binary.Class.Binary Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Base.Monoid Distribution.Types.ExecutableScope.ExecutableScope instance Data.Semigroup.Semigroup Distribution.Types.ExecutableScope.ExecutableScope module Distribution.Types.ForeignLibOption data ForeignLibOption -- | Merge in all dependent libraries (i.e., use ghc -shared -- -static rather than just record the dependencies, ala ghc -- -shared -dynamic). This option is compulsory on Windows and -- unsupported on other platforms. ForeignLibStandalone :: ForeignLibOption instance Data.Data.Data Distribution.Types.ForeignLibOption.ForeignLibOption instance GHC.Classes.Eq Distribution.Types.ForeignLibOption.ForeignLibOption instance GHC.Read.Read Distribution.Types.ForeignLibOption.ForeignLibOption instance GHC.Show.Show Distribution.Types.ForeignLibOption.ForeignLibOption instance GHC.Generics.Generic Distribution.Types.ForeignLibOption.ForeignLibOption instance Distribution.Text.Text Distribution.Types.ForeignLibOption.ForeignLibOption instance Data.Binary.Class.Binary Distribution.Types.ForeignLibOption.ForeignLibOption module Distribution.Types.ForeignLibType -- | What kind of foreign library is to be built? data ForeignLibType -- | A native shared library (.so on Linux, .dylib on -- OSX, or .dll on Windows). ForeignLibNativeShared :: ForeignLibType -- | A native static library (not currently supported.) ForeignLibNativeStatic :: ForeignLibType ForeignLibTypeUnknown :: ForeignLibType knownForeignLibTypes :: [ForeignLibType] foreignLibTypeIsShared :: ForeignLibType -> Bool instance Data.Data.Data Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Classes.Eq Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Read.Read Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Show.Show Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Generics.Generic Distribution.Types.ForeignLibType.ForeignLibType instance Distribution.Text.Text Distribution.Types.ForeignLibType.ForeignLibType instance Data.Binary.Class.Binary Distribution.Types.ForeignLibType.ForeignLibType instance Data.Semigroup.Semigroup Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Base.Monoid Distribution.Types.ForeignLibType.ForeignLibType module Distribution.Types.SourceRepo -- | Information about the source revision control system for a package. -- -- When specifying a repo it is useful to know the meaning or intention -- of the information as doing so enables automation. There are two -- obvious common purposes: one is to find the repo for the latest -- development version, the other is to find the repo for this specific -- release. The ReopKind specifies which one we mean (or another -- custom one). -- -- A package can specify one or the other kind or both. Most will specify -- just a head repo but some may want to specify a repo to reconstruct -- the sources for this package release. -- -- The required information is the RepoType which tells us if it's -- using Darcs, Git for example. The repoLocation -- and other details are interpreted according to the repo type. data SourceRepo SourceRepo :: RepoKind -> Maybe RepoType -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe FilePath -> SourceRepo -- | The kind of repo. This field is required. [repoKind] :: SourceRepo -> RepoKind -- | The type of the source repository system for this repo, eg -- Darcs or Git. This field is required. [repoType] :: SourceRepo -> Maybe RepoType -- | The location of the repository. For most RepoTypes this is a -- URL. This field is required. [repoLocation] :: SourceRepo -> Maybe String -- | CVS can put multiple "modules" on one server and requires a -- module name in addition to the location to identify a particular repo. -- Logically this is part of the location but unfortunately has to be -- specified separately. This field is required for the CVS -- RepoType and should not be given otherwise. [repoModule] :: SourceRepo -> Maybe String -- | The name or identifier of the branch, if any. Many source control -- systems have the notion of multiple branches in a repo that exist in -- the same location. For example Git and CVS use this -- while systems like Darcs use different locations for different -- branches. This field is optional but should be used if necessary to -- identify the sources, especially for the RepoThis repo kind. [repoBranch] :: SourceRepo -> Maybe String -- | The tag identify a particular state of the repository. This should be -- given for the RepoThis repo kind and not for RepoHead -- kind. [repoTag] :: SourceRepo -> Maybe String -- | Some repositories contain multiple projects in different -- subdirectories This field specifies the subdirectory where this -- packages sources can be found, eg the subdirectory containing the -- .cabal file. It is interpreted relative to the root of the -- repository. This field is optional. If not given the default is "." ie -- no subdirectory. [repoSubdir] :: SourceRepo -> Maybe FilePath -- | What this repo info is for, what it represents. data RepoKind -- | The repository for the "head" or development version of the project. -- This repo is where we should track the latest development activity or -- the usual repo people should get to contribute patches. RepoHead :: RepoKind -- | The repository containing the sources for this exact package version -- or release. For this kind of repo a tag should be given to give enough -- information to re-create the exact sources. RepoThis :: RepoKind RepoKindUnknown :: String -> RepoKind -- | An enumeration of common source control systems. The fields used in -- the SourceRepo depend on the type of repo. The tools and -- methods used to obtain and track the repo depend on the repo type. data RepoType Darcs :: RepoType Git :: RepoType SVN :: RepoType CVS :: RepoType Mercurial :: RepoType GnuArch :: RepoType Bazaar :: RepoType Monotone :: RepoType OtherRepoType :: String -> RepoType knownRepoTypes :: [RepoType] emptySourceRepo :: RepoKind -> SourceRepo classifyRepoType :: String -> RepoType classifyRepoKind :: String -> RepoKind instance Data.Data.Data Distribution.Types.SourceRepo.SourceRepo instance GHC.Show.Show Distribution.Types.SourceRepo.SourceRepo instance GHC.Read.Read Distribution.Types.SourceRepo.SourceRepo instance GHC.Generics.Generic Distribution.Types.SourceRepo.SourceRepo instance GHC.Classes.Eq Distribution.Types.SourceRepo.SourceRepo instance Data.Data.Data Distribution.Types.SourceRepo.RepoType instance GHC.Show.Show Distribution.Types.SourceRepo.RepoType instance GHC.Read.Read Distribution.Types.SourceRepo.RepoType instance GHC.Classes.Ord Distribution.Types.SourceRepo.RepoType instance GHC.Generics.Generic Distribution.Types.SourceRepo.RepoType instance GHC.Classes.Eq Distribution.Types.SourceRepo.RepoType instance Data.Data.Data Distribution.Types.SourceRepo.RepoKind instance GHC.Show.Show Distribution.Types.SourceRepo.RepoKind instance GHC.Read.Read Distribution.Types.SourceRepo.RepoKind instance GHC.Classes.Ord Distribution.Types.SourceRepo.RepoKind instance GHC.Generics.Generic Distribution.Types.SourceRepo.RepoKind instance GHC.Classes.Eq Distribution.Types.SourceRepo.RepoKind instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.SourceRepo instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.RepoType instance Distribution.Text.Text Distribution.Types.SourceRepo.RepoType instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.RepoKind instance Distribution.Text.Text Distribution.Types.SourceRepo.RepoKind 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.Utils.ShortText -- | Compact representation of short Strings -- -- The data is stored internally as UTF8 in an ShortByteString -- when compiled against bytestring >= 0.10.4, and otherwise -- the fallback is to use plain old non-compat '[Char]'. -- -- Note: This type is for internal uses (such as e.g. -- PackageName) and shall not be exposed in Cabal's API data ShortText -- | Construct ShortText from String toShortText :: String -> ShortText -- | Convert ShortText to String fromShortText :: ShortText -> String -- | Decode String from UTF8-encoded octets. -- -- Invalid data will be decoded as the replacement character -- (U+FFFD) -- -- See also encodeStringUtf8 decodeStringUtf8 :: [Word8] -> String -- | Encode String to a list of UTF8-encoded octets -- -- See also decodeUtf8 encodeStringUtf8 :: String -> [Word8] instance Data.Data.Data Distribution.Utils.ShortText.ShortText instance GHC.Generics.Generic Distribution.Utils.ShortText.ShortText instance GHC.Classes.Ord Distribution.Utils.ShortText.ShortText instance GHC.Classes.Eq Distribution.Utils.ShortText.ShortText instance Data.Binary.Class.Binary Distribution.Utils.ShortText.ShortText instance Control.DeepSeq.NFData Distribution.Utils.ShortText.ShortText instance GHC.Show.Show Distribution.Utils.ShortText.ShortText instance GHC.Read.Read Distribution.Utils.ShortText.ShortText instance Data.Semigroup.Semigroup Distribution.Utils.ShortText.ShortText instance GHC.Base.Monoid Distribution.Utils.ShortText.ShortText instance Data.String.IsString Distribution.Utils.ShortText.ShortText module Distribution.Types.PkgconfigName -- | A pkg-config library name -- -- This is parsed as any valid argument to the pkg-config utility. data PkgconfigName -- | Convert PkgconfigName to String unPkgconfigName :: PkgconfigName -> String -- | Construct a PkgconfigName from a String -- -- mkPkgconfigName is the inverse to unPkgconfigName -- -- Note: No validations are performed to ensure that the resulting -- PkgconfigName is valid mkPkgconfigName :: String -> PkgconfigName instance Data.Data.Data Distribution.Types.PkgconfigName.PkgconfigName instance GHC.Classes.Ord Distribution.Types.PkgconfigName.PkgconfigName instance GHC.Classes.Eq Distribution.Types.PkgconfigName.PkgconfigName instance GHC.Show.Show Distribution.Types.PkgconfigName.PkgconfigName instance GHC.Read.Read Distribution.Types.PkgconfigName.PkgconfigName instance GHC.Generics.Generic Distribution.Types.PkgconfigName.PkgconfigName instance Data.String.IsString Distribution.Types.PkgconfigName.PkgconfigName instance Data.Binary.Class.Binary Distribution.Types.PkgconfigName.PkgconfigName instance Distribution.Text.Text Distribution.Types.PkgconfigName.PkgconfigName instance Control.DeepSeq.NFData Distribution.Types.PkgconfigName.PkgconfigName module Distribution.Types.ComponentId -- | A ComponentId uniquely identifies the transitive source code -- closure of a component (i.e. libraries, executables). -- -- For non-Backpack components, this corresponds one to one with the -- UnitId, which serves as the basis for install paths, linker -- symbols, etc. -- -- Use mkComponentId and unComponentId to convert from/to a -- String. -- -- This type is opaque since Cabal-2.0 data ComponentId -- | Convert ComponentId to String unComponentId :: ComponentId -> String -- | Construct a ComponentId from a String -- -- mkComponentId is the inverse to unComponentId -- -- Note: No validations are performed to ensure that the resulting -- ComponentId is valid mkComponentId :: String -> ComponentId instance Data.Data.Data Distribution.Types.ComponentId.ComponentId instance GHC.Classes.Ord Distribution.Types.ComponentId.ComponentId instance GHC.Classes.Eq Distribution.Types.ComponentId.ComponentId instance GHC.Show.Show Distribution.Types.ComponentId.ComponentId instance GHC.Read.Read Distribution.Types.ComponentId.ComponentId instance GHC.Generics.Generic Distribution.Types.ComponentId.ComponentId instance Data.String.IsString Distribution.Types.ComponentId.ComponentId instance Data.Binary.Class.Binary Distribution.Types.ComponentId.ComponentId instance Distribution.Text.Text Distribution.Types.ComponentId.ComponentId instance Control.DeepSeq.NFData Distribution.Types.ComponentId.ComponentId module Distribution.Types.AbiHash -- | ABI Hashes -- -- Use mkAbiHash and unAbiHash to convert from/to a -- String. -- -- This type is opaque since Cabal-2.0 data AbiHash -- | Construct a AbiHash from a String -- -- mkAbiHash is the inverse to unAbiHash -- -- Note: No validations are performed to ensure that the resulting -- AbiHash is valid unAbiHash :: AbiHash -> String -- | Convert AbiHash to String mkAbiHash :: String -> AbiHash instance GHC.Generics.Generic Distribution.Types.AbiHash.AbiHash instance GHC.Read.Read Distribution.Types.AbiHash.AbiHash instance GHC.Show.Show Distribution.Types.AbiHash.AbiHash instance GHC.Classes.Eq Distribution.Types.AbiHash.AbiHash instance Data.String.IsString Distribution.Types.AbiHash.AbiHash instance Data.Binary.Class.Binary Distribution.Types.AbiHash.AbiHash instance Distribution.Text.Text Distribution.Types.AbiHash.AbiHash -- | Data type for Haskell module names. module Distribution.ModuleName -- | A valid Haskell module name. newtype ModuleName ModuleName :: ShortTextLst -> ModuleName fromString :: IsString a => String -> a -- | Construct a ModuleName from valid module components, i.e. parts -- separated by dots. fromComponents :: [String] -> ModuleName -- | The individual components of a hierarchical module name. For example -- --
--   components (fromString "A.B.C") = ["A", "B", "C"]
--   
components :: ModuleName -> [String] -- | Convert a module name to a file path, but without any file extension. -- For example: -- --
--   toFilePath (fromString "A.B.C") = "A/B/C"
--   
toFilePath :: ModuleName -> FilePath -- | The module name Main. main :: ModuleName -- | Deprecated: use ModuleName.fromString instead simple :: String -> ModuleName validModuleComponent :: String -> Bool instance Data.Data.Data Distribution.ModuleName.ModuleName instance GHC.Show.Show Distribution.ModuleName.ModuleName instance GHC.Read.Read Distribution.ModuleName.ModuleName instance GHC.Classes.Ord Distribution.ModuleName.ModuleName instance GHC.Generics.Generic Distribution.ModuleName.ModuleName instance GHC.Classes.Eq Distribution.ModuleName.ModuleName instance Data.Data.Data Distribution.ModuleName.ShortTextLst instance GHC.Classes.Ord Distribution.ModuleName.ShortTextLst instance GHC.Generics.Generic Distribution.ModuleName.ShortTextLst instance GHC.Classes.Eq Distribution.ModuleName.ShortTextLst instance Data.Binary.Class.Binary Distribution.ModuleName.ModuleName instance Control.DeepSeq.NFData Distribution.ModuleName.ModuleName instance Distribution.Text.Text Distribution.ModuleName.ModuleName instance Data.String.IsString Distribution.ModuleName.ModuleName instance Control.DeepSeq.NFData Distribution.ModuleName.ShortTextLst instance GHC.Show.Show Distribution.ModuleName.ShortTextLst instance GHC.Read.Read Distribution.ModuleName.ShortTextLst instance Data.Binary.Class.Binary Distribution.ModuleName.ShortTextLst module Distribution.Types.ModuleRenaming -- | Renaming applied to the modules provided by a package. The boolean -- indicates whether or not to also include all of the original names of -- modules. Thus, ModuleRenaming False [] is "don't expose any -- modules, and ModuleRenaming True [(Data.Bool, -- Bool)] is, "expose all modules, but also expose -- Data.Bool as Bool". If a renaming is omitted you get -- the DefaultRenaming. -- -- (NB: This is a list not a map so that we can preserve order.) data ModuleRenaming -- | A module renaming/thinning; e.g., (A as B, C as C) brings -- B and C into scope. ModuleRenaming :: [(ModuleName, ModuleName)] -> ModuleRenaming -- | The default renaming, bringing all exported modules into scope. DefaultRenaming :: ModuleRenaming -- | Hiding renaming, e.g., hiding (A, B), bringing all exported -- modules into scope except the hidden ones. HidingRenaming :: [ModuleName] -> ModuleRenaming -- | The default renaming, if something is specified in -- build-depends only. defaultRenaming :: ModuleRenaming -- | Tests if its the default renaming; we can use a more compact syntax in -- IncludeRenaming in this case. isDefaultRenaming :: ModuleRenaming -> Bool instance GHC.Generics.Generic Distribution.Types.ModuleRenaming.ModuleRenaming instance Data.Data.Data Distribution.Types.ModuleRenaming.ModuleRenaming instance GHC.Classes.Ord Distribution.Types.ModuleRenaming.ModuleRenaming instance GHC.Classes.Eq Distribution.Types.ModuleRenaming.ModuleRenaming instance GHC.Read.Read Distribution.Types.ModuleRenaming.ModuleRenaming instance GHC.Show.Show Distribution.Types.ModuleRenaming.ModuleRenaming instance Data.Binary.Class.Binary Distribution.Types.ModuleRenaming.ModuleRenaming instance Distribution.Text.Text Distribution.Types.ModuleRenaming.ModuleRenaming module Distribution.Types.IncludeRenaming -- | A renaming on an include: (provides renaming, requires renaming) data IncludeRenaming IncludeRenaming :: ModuleRenaming -> ModuleRenaming -> IncludeRenaming [includeProvidesRn] :: IncludeRenaming -> ModuleRenaming [includeRequiresRn] :: IncludeRenaming -> ModuleRenaming -- | The defaultIncludeRenaming applied when you only -- build-depends on a package. defaultIncludeRenaming :: IncludeRenaming -- | Is an IncludeRenaming the default one? isDefaultIncludeRenaming :: IncludeRenaming -> Bool instance GHC.Generics.Generic Distribution.Types.IncludeRenaming.IncludeRenaming instance Data.Data.Data Distribution.Types.IncludeRenaming.IncludeRenaming instance GHC.Classes.Ord Distribution.Types.IncludeRenaming.IncludeRenaming instance GHC.Classes.Eq Distribution.Types.IncludeRenaming.IncludeRenaming instance GHC.Read.Read Distribution.Types.IncludeRenaming.IncludeRenaming instance GHC.Show.Show Distribution.Types.IncludeRenaming.IncludeRenaming instance Data.Binary.Class.Binary Distribution.Types.IncludeRenaming.IncludeRenaming instance Distribution.Text.Text Distribution.Types.IncludeRenaming.IncludeRenaming -- | 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.Utils.Generic -- | Gets the contents of a file, but guarantee that it gets closed. -- -- The file is read lazily but if it is not fully consumed by the action -- then the remaining input is truncated and the file is closed. withFileContents :: FilePath -> (String -> NoCallStackIO a) -> NoCallStackIO a -- | Writes a file atomically. -- -- The file is either written successfully or an IO exception is raised -- and the original file is left unchanged. -- -- On windows it is not possible to delete a file that is open by a -- process. This case will give an IO exception but the atomic property -- is not affected. writeFileAtomic :: FilePath -> ByteString -> NoCallStackIO () fromUTF8 :: String -> String fromUTF8BS :: ByteString -> String fromUTF8LBS :: ByteString -> String toUTF8 :: String -> String -- | Reads a UTF8 encoded text file as a Unicode String -- -- Reads lazily using ordinary readFile. readUTF8File :: FilePath -> NoCallStackIO String -- | Reads a UTF8 encoded text file as a Unicode String -- -- Same behaviour as withFileContents. withUTF8FileContents :: FilePath -> (String -> IO a) -> IO a -- | Writes a Unicode String as a UTF8 encoded text file. -- -- Uses writeFileAtomic, so provides the same guarantees. writeUTF8File :: FilePath -> String -> NoCallStackIO () -- | Fix different systems silly line ending conventions normaliseLineEndings :: String -> String -- | Whether BOM is at the beginning of the input startsWithBOM :: String -> Bool -- | Check whether a file has Unicode byte order mark (BOM). fileHasBOM :: FilePath -> NoCallStackIO Bool -- | Ignore a Unicode byte order mark (BOM) at the beginning of the input ignoreBOM :: String -> String -- | dropWhileEndLE p is equivalent to reverse . dropWhile p . -- reverse, but quite a bit faster. The difference between -- "Data.List.dropWhileEnd" and this version is that the one in -- Data.List is strict in elements, but spine-lazy, while this one -- is spine-strict but lazy in elements. That's what LE stands -- for - "lazy in elements". -- -- Example: -- --
--   > tail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1]
--   *** Exception: Prelude.undefined
--   > tail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1]
--   [5,4,3]
--   > take 3 $ Data.List.dropWhileEnd (<3) [5, 4, 3, 2, 1, undefined]
--   [5,4,3]
--   > take 3 $ dropWhileEndLE (<3) [5, 4, 3, 2, 1, undefined]
--   *** Exception: Prelude.undefined
--   
dropWhileEndLE :: (a -> Bool) -> [a] -> [a] -- | takeWhileEndLE p is equivalent to reverse . takeWhile p . -- reverse, but is usually faster (as well as being easier to read). 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. -- -- Example: -- --
--   isInfixOf "Haskell" "I really like Haskell." == True
--   isInfixOf "Ial" "I really like Haskell." == False
--   
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 :: () => [a] -> [[a]] -> [a] lowercase :: String -> String -- | Like "Data.List.union", but has O(n log n) complexity instead -- of O(n^2). listUnion :: (Ord a) => [a] -> [a] -> [a] -- | A right-biased version of listUnion. -- -- Example: -- --
--   > listUnion [1,2,3,4,3] [2,1,1]
--   [1,2,3,4,3]
--   > listUnionRight [1,2,3,4,3] [2,1,1]
--   [4,3,2,1,1]
--   
listUnionRight :: (Ord a) => [a] -> [a] -> [a] -- | Like nub, but has O(n log n) complexity instead of -- O(n^2). Code for ordNub and listUnion taken -- from Niklas Hambüchen's ordnub package. ordNub :: Ord a => [a] -> [a] -- | Like ordNub and nubBy. Selects a key for each element -- and takes the nub based on that key. ordNubBy :: Ord b => (a -> b) -> [a] -> [a] -- | A right-biased version of ordNub. -- -- Example: -- --
--   > ordNub [1,2,1]
--   [1,2]
--   > ordNubRight [1,2,1]
--   [2,1]
--   
ordNubRight :: (Ord a) => [a] -> [a] -- | A total variant of tail. safeTail :: [a] -> [a] unintersperse :: Char -> String -> [String] -- | Wraps text to the default line width. Existing newlines are preserved. wrapText :: String -> String -- | Wraps a list of words to a list of lines of words of a particular -- width. wrapLine :: Int -> [String] -> [[String]] -- | isAbsoluteOnAnyPlatform and isRelativeOnAnyPlatform are -- like isAbsolute and isRelative but have platform -- independent heuristics. The System.FilePath exists in two versions, -- Windows and Posix. The two versions don't agree on what is a relative -- path and we don't know if we're given Windows or Posix paths. This -- results in false positives when running on Posix and inspecting -- Windows paths, like the hackage server does. -- System.FilePath.Posix.isAbsolute "C:\hello" == False -- System.FilePath.Windows.isAbsolute "/hello" == False This means that -- we would treat paths that start with "/" to be absolute. On Posix they -- are indeed absolute, while on Windows they are not. -- -- The portable versions should be used when we might deal with paths -- that are from another OS than the host OS. For example, the Hackage -- Server deals with both Windows and Posix paths while performing the -- PackageDescription checks. In contrast, when we run 'cabal configure' -- we do expect the paths to be correct for our OS and we should not have -- to use the platform independent heuristics. isAbsoluteOnAnyPlatform :: FilePath -> Bool -- |
--   isRelativeOnAnyPlatform = not . isAbsoluteOnAnyPlatform
--   
isRelativeOnAnyPlatform :: FilePath -> Bool -- | 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 silent :: Verbosity normal :: Verbosity verbose :: Verbosity deafening :: Verbosity moreVerbose :: Verbosity -> Verbosity lessVerbose :: Verbosity -> Verbosity -- | Test if we had called lessVerbose on the verbosity isVerboseQuiet :: Verbosity -> Bool intToVerbosity :: Int -> Maybe Verbosity flagToVerbosity :: ReadE Verbosity showForCabal :: Verbosity -> String showForGHC :: Verbosity -> String verboseNoFlags :: Verbosity -> Verbosity verboseHasFlags :: Verbosity -> Bool -- | 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 instance GHC.Generics.Generic Distribution.Verbosity.Verbosity instance GHC.Enum.Bounded Distribution.Verbosity.VerbosityFlag instance GHC.Enum.Enum Distribution.Verbosity.VerbosityFlag instance GHC.Classes.Ord Distribution.Verbosity.VerbosityFlag instance GHC.Classes.Eq Distribution.Verbosity.VerbosityFlag instance GHC.Read.Read Distribution.Verbosity.VerbosityFlag instance GHC.Show.Show Distribution.Verbosity.VerbosityFlag instance GHC.Generics.Generic Distribution.Verbosity.VerbosityFlag instance GHC.Enum.Bounded Distribution.Verbosity.VerbosityLevel instance GHC.Enum.Enum Distribution.Verbosity.VerbosityLevel instance GHC.Classes.Ord Distribution.Verbosity.VerbosityLevel instance GHC.Classes.Eq Distribution.Verbosity.VerbosityLevel instance GHC.Read.Read Distribution.Verbosity.VerbosityLevel instance GHC.Show.Show Distribution.Verbosity.VerbosityLevel instance GHC.Generics.Generic Distribution.Verbosity.VerbosityLevel instance GHC.Show.Show Distribution.Verbosity.Verbosity instance GHC.Read.Read 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 Data.Binary.Class.Binary Distribution.Verbosity.VerbosityFlag instance Data.Binary.Class.Binary Distribution.Verbosity.VerbosityLevel -- | Exports the Version type along with a parser and pretty -- printer. A version is something like "1.3.3". It also defines -- the VersionRange data types. Version ranges are like ">= -- 1.2 && < 2". module Distribution.Version -- | A Version represents the version of a software entity. -- -- Instances of Eq and Ord are provided, which gives exact -- equality and lexicographic ordering of the version number components -- (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.). -- -- This type is opaque and distinct from the Version type in -- Data.Version since Cabal-2.0. The difference extends -- to the Binary instance using a different (and more compact) -- encoding. data Version -- | Construct Version from list of version number components. -- -- For instance, mkVersion [3,2,1] constructs a Version -- representing the version 3.2.1. -- -- All version components must be non-negative. mkVersion [] -- currently represents the special null version; see also -- nullVersion. mkVersion :: [Int] -> Version -- | Variant of Version which converts a Data.Version -- Version into Cabal's Version type. mkVersion' :: Version -> Version -- | Unpack Version into list of version number components. -- -- This is the inverse to mkVersion, so the following holds: -- --
--   (versionNumbers . mkVersion) vs == vs
--   
versionNumbers :: Version -> [Int] -- | Constant representing the special null Version -- -- The nullVersion compares (via Ord) as less than every -- proper Version value. nullVersion :: Version -- | Apply function to list of version number components -- --
--   alterVersion f == mkVersion . f . versionNumbers
--   
alterVersion :: ([Int] -> [Int]) -> Version -> Version showVersion :: Version -> String data VersionRange -- | Deprecated: Use anyVersion, foldVersionRange or -- asVersionIntervals AnyVersion :: VersionRange -- | Deprecated: Use thisVersion, foldVersionRange or -- asVersionIntervals ThisVersion :: Version -> VersionRange -- | Deprecated: Use laterVersion, foldVersionRange or -- asVersionIntervals LaterVersion :: Version -> VersionRange -- | Deprecated: Use earlierVersion, foldVersionRange or -- asVersionIntervals EarlierVersion :: Version -> VersionRange -- | Deprecated: Use anyVersion, foldVersionRange or -- asVersionIntervals WildcardVersion :: Version -> VersionRange MajorBoundVersion :: Version -> VersionRange -- | Deprecated: Use unionVersionRanges, foldVersionRange -- or asVersionIntervals UnionVersionRanges :: VersionRange -> VersionRange -> VersionRange -- | Deprecated: Use intersectVersionRanges, -- foldVersionRange or asVersionIntervals IntersectVersionRanges :: VersionRange -> VersionRange -> VersionRange VersionRangeParens :: VersionRange -> VersionRange -- | The version range -any. That is, a version range containing -- all versions. -- --
--   withinRange v anyVersion = True
--   
anyVersion :: VersionRange -- | The empty version range, that is a version range containing no -- versions. -- -- This can be constructed using any unsatisfiable version range -- expression, for example > 1 && < 1. -- --
--   withinRange v noVersion = False
--   
noVersion :: VersionRange -- | The version range == v -- --
--   withinRange v' (thisVersion v) = v' == v
--   
thisVersion :: Version -> VersionRange -- | The version range || v -- --
--   withinRange v' (notThisVersion v) = v' /= v
--   
notThisVersion :: Version -> VersionRange -- | The version range > v -- --
--   withinRange v' (laterVersion v) = v' > v
--   
laterVersion :: Version -> VersionRange -- | The version range < v -- --
--   withinRange v' (earlierVersion v) = v' < v
--   
earlierVersion :: Version -> VersionRange -- | The version range >= v -- --
--   withinRange v' (orLaterVersion v) = v' >= v
--   
orLaterVersion :: Version -> VersionRange -- | The version range <= v -- --
--   withinRange v' (orEarlierVersion v) = v' <= v
--   
orEarlierVersion :: Version -> VersionRange -- | The version range vr1 || vr2 -- --
--     withinRange v' (unionVersionRanges vr1 vr2)
--   = withinRange v' vr1 || withinRange v' vr2
--   
unionVersionRanges :: VersionRange -> VersionRange -> VersionRange -- | The version range vr1 && vr2 -- --
--     withinRange v' (intersectVersionRanges vr1 vr2)
--   = withinRange v' vr1 && withinRange v' vr2
--   
intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange -- | The difference of two version ranges -- --
--     withinRange v' (differenceVersionRanges vr1 vr2)
--   = withinRange v' vr1 && not (withinRange v' vr2)
--   
differenceVersionRanges :: VersionRange -> VersionRange -> VersionRange -- | The inverse of a version range -- --
--     withinRange v' (invertVersionRange vr)
--   = not (withinRange v' vr)
--   
invertVersionRange :: VersionRange -> VersionRange -- | The version range == v.*. -- -- For example, for version 1.2, the version range == -- 1.2.* is the same as >= 1.2 && < 1.3 -- --
--   withinRange v' (laterVersion v) = v' >= v && v' < upper v
--     where
--       upper (Version lower t) = Version (init lower ++ [last lower + 1]) t
--   
withinVersion :: Version -> VersionRange -- | The version range ^>= v. -- -- For example, for version 1.2.3.4, the version range -- ^>= 1.2.3.4 is the same as >= 1.2.3.4 && -- < 1.3. -- -- Note that ^>= 1 is equivalent to >= 1 && -- < 1.1. -- --
--   since 2.0
--   
majorBoundVersion :: Version -> VersionRange -- | Deprecated: In practice this is not very useful because we normally -- use inclusive lower bounds and exclusive upper bounds betweenVersionsInclusive :: Version -> Version -> VersionRange -- | Does this version fall within the given range? -- -- This is the evaluation function for the VersionRange type. withinRange :: Version -> VersionRange -> Bool -- | Does this VersionRange place any restriction on the -- Version or is it in fact equivalent to AnyVersion. -- -- Note this is a semantic check, not simply a syntactic check. So for -- example the following is True (for all v). -- --
--   isAnyVersion (EarlierVersion v `UnionVersionRanges` orLaterVersion v)
--   
isAnyVersion :: VersionRange -> Bool -- | This is the converse of isAnyVersion. It check if the version -- range is empty, if there is no possible version that satisfies the -- version range. -- -- For example this is True (for all v): -- --
--   isNoVersion (EarlierVersion v `IntersectVersionRanges` LaterVersion v)
--   
isNoVersion :: VersionRange -> Bool -- | Is this version range in fact just a specific version? -- -- For example the version range ">= 3 && <= 3" -- contains only the version 3. isSpecificVersion :: VersionRange -> Maybe Version -- | Simplify a VersionRange expression. For non-empty version -- ranges this produces a canonical form. Empty or inconsistent version -- ranges are left as-is because that provides more information. -- -- If you need a canonical form use fromVersionIntervals . -- toVersionIntervals -- -- It satisfies the following properties: -- --
--   withinRange v (simplifyVersionRange r) = withinRange v r
--   
-- --
--       withinRange v r = withinRange v r'
--   ==> simplifyVersionRange r = simplifyVersionRange r'
--    || isNoVersion r
--    || isNoVersion r'
--   
simplifyVersionRange :: VersionRange -> VersionRange -- | Fold over the basic syntactic structure of a VersionRange. -- -- This provides a syntactic view of the expression defining the version -- range. The syntactic sugar ">= v", "<= v" and -- "== v.*" is presented in terms of the other basic syntax. -- -- For a semantic view use asVersionIntervals. foldVersionRange :: a -> (Version -> a) -> (Version -> a) -> (Version -> a) -> (a -> a -> a) -> (a -> a -> a) -> VersionRange -> a -- | An extended variant of foldVersionRange that also provides a -- view of the expression in which the syntactic sugar ">= -- v", "<= v" and "== v.*" is presented -- explicitly rather than in terms of the other basic syntax. foldVersionRange' :: a -> (Version -> a) -> (Version -> a) -> (Version -> a) -> (Version -> a) -> (Version -> a) -> (Version -> Version -> a) -> (Version -> Version -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> VersionRange -> a -- | Does the version range have an upper bound? hasUpperBound :: VersionRange -> Bool -- | Does the version range have an explicit lower bound? -- -- Note: this function only considers the user-specified lower bounds, -- but not the implicit >=0 lower bound. hasLowerBound :: VersionRange -> Bool -- | Given a version range, remove the highest upper bound. Example: -- (>= 1 && < 3) || (>= 4 && < 5) is -- converted to (>= 1 && || (= 4). removeUpperBound :: VersionRange -> VersionRange -- | Given a version range, remove the lowest lower bound. Example: -- (>= 1 && || (= 4 && < 5) is -- converted to (>= 0 && || (= 4 && < -- 5). removeLowerBound :: VersionRange -> VersionRange -- | View a VersionRange as a union of intervals. -- -- This provides a canonical view of the semantics of a -- VersionRange as opposed to the syntax of the expression used to -- define it. For the syntactic view use foldVersionRange. -- -- Each interval is non-empty. The sequence is in increasing order and no -- intervals overlap or touch. Therefore only the first and last can be -- unbounded. The sequence can be empty if the range is empty (e.g. a -- range expression like && 2). -- -- Other checks are trivial to implement using this view. For example: -- --
--   isNoVersion vr | [] <- asVersionIntervals vr = True
--                  | otherwise                   = False
--   
-- --
--   isSpecificVersion vr
--      | [(LowerBound v  InclusiveBound
--         ,UpperBound v' InclusiveBound)] <- asVersionIntervals vr
--      , v == v'   = Just v
--      | otherwise = Nothing
--   
asVersionIntervals :: VersionRange -> [VersionInterval] type VersionInterval = (LowerBound, UpperBound) data LowerBound LowerBound :: Version -> !Bound -> LowerBound data UpperBound NoUpperBound :: UpperBound UpperBound :: Version -> !Bound -> UpperBound data Bound ExclusiveBound :: Bound InclusiveBound :: Bound -- | A complementary representation of a VersionRange. Instead of a -- boolean version predicate it uses an increasing sequence of -- non-overlapping, non-empty intervals. -- -- The key point is that this representation gives a canonical -- representation for the semantics of VersionRanges. This makes -- it easier to check things like whether a version range is empty, -- covers all versions, or requires a certain minimum or maximum version. -- It also makes it easy to check equality or containment. It also makes -- it easier to identify 'simple' version predicates for translation into -- foreign packaging systems that do not support complex version range -- expressions. data VersionIntervals -- | Convert a VersionRange to a sequence of version intervals. toVersionIntervals :: VersionRange -> VersionIntervals -- | Convert a VersionIntervals value back into a -- VersionRange expression representing the version intervals. fromVersionIntervals :: VersionIntervals -> VersionRange -- | Test if a version falls within the version intervals. -- -- It exists mostly for completeness and testing. It satisfies the -- following properties: -- --
--   withinIntervals v (toVersionIntervals vr) = withinRange v vr
--   withinIntervals v ivs = withinRange v (fromVersionIntervals ivs)
--   
withinIntervals :: Version -> VersionIntervals -> Bool -- | Inspect the list of version intervals. versionIntervals :: VersionIntervals -> [VersionInterval] -- | Directly construct a VersionIntervals from a list of intervals. -- -- Each interval must be non-empty. The sequence must be in increasing -- order and no intervals may overlap or touch. If any of these -- conditions are not satisfied the function returns Nothing. mkVersionIntervals :: [VersionInterval] -> Maybe VersionIntervals unionVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals intersectVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals invertVersionIntervals :: VersionIntervals -> VersionIntervals instance GHC.Show.Show Distribution.Version.VersionIntervals instance GHC.Classes.Eq Distribution.Version.VersionIntervals instance GHC.Show.Show Distribution.Version.LowerBound instance GHC.Classes.Eq Distribution.Version.LowerBound instance GHC.Show.Show Distribution.Version.UpperBound instance GHC.Classes.Eq Distribution.Version.UpperBound instance GHC.Show.Show Distribution.Version.Bound instance GHC.Classes.Eq Distribution.Version.Bound instance GHC.Show.Show Distribution.Version.VersionRange instance GHC.Read.Read Distribution.Version.VersionRange instance GHC.Generics.Generic Distribution.Version.VersionRange instance GHC.Classes.Eq Distribution.Version.VersionRange instance Data.Data.Data Distribution.Version.VersionRange instance GHC.Generics.Generic Distribution.Version.Version instance GHC.Classes.Eq Distribution.Version.Version instance Data.Data.Data Distribution.Version.Version instance GHC.Classes.Ord Distribution.Version.LowerBound instance GHC.Classes.Ord Distribution.Version.UpperBound instance Data.Binary.Class.Binary Distribution.Version.VersionRange instance Control.DeepSeq.NFData Distribution.Version.VersionRange instance Distribution.Text.Text Distribution.Version.VersionRange instance GHC.Classes.Ord Distribution.Version.Version instance GHC.Show.Show Distribution.Version.Version instance GHC.Read.Read Distribution.Version.Version instance Data.Binary.Class.Binary Distribution.Version.Version instance Control.DeepSeq.NFData Distribution.Version.Version instance Distribution.Text.Text Distribution.Version.Version module Distribution.Types.TestType -- | The "test-type" field in the test suite stanza. data TestType -- | "type: exitcode-stdio-x.y" TestTypeExe :: Version -> TestType -- | "type: detailed-x.y" TestTypeLib :: Version -> TestType -- | Some unknown test type e.g. "type: foo" TestTypeUnknown :: String -> Version -> TestType knownTestTypes :: [TestType] instance Data.Data.Data Distribution.Types.TestType.TestType instance GHC.Classes.Eq Distribution.Types.TestType.TestType instance GHC.Read.Read Distribution.Types.TestType.TestType instance GHC.Show.Show Distribution.Types.TestType.TestType instance GHC.Generics.Generic Distribution.Types.TestType.TestType instance Data.Binary.Class.Binary Distribution.Types.TestType.TestType instance Distribution.Text.Text Distribution.Types.TestType.TestType module Distribution.Types.TestSuiteInterface -- | The test suite interfaces that are currently defined. Each test suite -- must specify which interface it supports. -- -- More interfaces may be defined in future, either new revisions or -- totally new interfaces. data TestSuiteInterface -- | Test interface "exitcode-stdio-1.0". The test-suite takes the form of -- an executable. It returns a zero exit code for success, non-zero for -- failure. The stdout and stderr channels may be logged. It takes no -- command line parameters and nothing on stdin. TestSuiteExeV10 :: Version -> FilePath -> TestSuiteInterface -- | Test interface "detailed-0.9". The test-suite takes the form of a -- library containing a designated module that exports "tests :: [Test]". TestSuiteLibV09 :: Version -> ModuleName -> TestSuiteInterface -- | A test suite that does not conform to one of the above interfaces for -- the given reason (e.g. unknown test type). TestSuiteUnsupported :: TestType -> TestSuiteInterface instance Data.Data.Data Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Show.Show Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Read.Read Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Generics.Generic Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Classes.Eq Distribution.Types.TestSuiteInterface.TestSuiteInterface instance Data.Binary.Class.Binary Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Base.Monoid Distribution.Types.TestSuiteInterface.TestSuiteInterface instance Data.Semigroup.Semigroup Distribution.Types.TestSuiteInterface.TestSuiteInterface module Distribution.Types.PkgconfigDependency -- | Describes a dependency on a pkg-config library data PkgconfigDependency PkgconfigDependency :: PkgconfigName -> VersionRange -> PkgconfigDependency instance Data.Data.Data Distribution.Types.PkgconfigDependency.PkgconfigDependency instance GHC.Classes.Eq Distribution.Types.PkgconfigDependency.PkgconfigDependency instance GHC.Show.Show Distribution.Types.PkgconfigDependency.PkgconfigDependency instance GHC.Read.Read Distribution.Types.PkgconfigDependency.PkgconfigDependency instance GHC.Generics.Generic Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Data.Binary.Class.Binary Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Control.DeepSeq.NFData Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Distribution.Text.Text Distribution.Types.PkgconfigDependency.PkgconfigDependency module Distribution.Types.BenchmarkType -- | The "benchmark-type" field in the benchmark stanza. data BenchmarkType -- | "type: exitcode-stdio-x.y" BenchmarkTypeExe :: Version -> BenchmarkType -- | Some unknown benchmark type e.g. "type: foo" BenchmarkTypeUnknown :: String -> Version -> BenchmarkType knownBenchmarkTypes :: [BenchmarkType] instance Data.Data.Data Distribution.Types.BenchmarkType.BenchmarkType instance GHC.Classes.Eq Distribution.Types.BenchmarkType.BenchmarkType instance GHC.Read.Read Distribution.Types.BenchmarkType.BenchmarkType instance GHC.Show.Show Distribution.Types.BenchmarkType.BenchmarkType instance GHC.Generics.Generic Distribution.Types.BenchmarkType.BenchmarkType instance Data.Binary.Class.Binary Distribution.Types.BenchmarkType.BenchmarkType instance Distribution.Text.Text Distribution.Types.BenchmarkType.BenchmarkType module Distribution.Types.BenchmarkInterface -- | The benchmark interfaces that are currently defined. Each benchmark -- must specify which interface it supports. -- -- More interfaces may be defined in future, either new revisions or -- totally new interfaces. data BenchmarkInterface -- | Benchmark interface "exitcode-stdio-1.0". The benchmark takes the form -- of an executable. It returns a zero exit code for success, non-zero -- for failure. The stdout and stderr channels may be logged. It takes no -- command line parameters and nothing on stdin. BenchmarkExeV10 :: Version -> FilePath -> BenchmarkInterface -- | A benchmark that does not conform to one of the above interfaces for -- the given reason (e.g. unknown benchmark type). BenchmarkUnsupported :: BenchmarkType -> BenchmarkInterface instance Data.Data.Data Distribution.Types.BenchmarkInterface.BenchmarkInterface instance GHC.Show.Show Distribution.Types.BenchmarkInterface.BenchmarkInterface instance GHC.Read.Read Distribution.Types.BenchmarkInterface.BenchmarkInterface instance GHC.Generics.Generic Distribution.Types.BenchmarkInterface.BenchmarkInterface instance GHC.Classes.Eq Distribution.Types.BenchmarkInterface.BenchmarkInterface instance Data.Binary.Class.Binary Distribution.Types.BenchmarkInterface.BenchmarkInterface instance GHC.Base.Monoid Distribution.Types.BenchmarkInterface.BenchmarkInterface instance Data.Semigroup.Semigroup Distribution.Types.BenchmarkInterface.BenchmarkInterface -- | Package descriptions contain fields for specifying the name of a -- software license and the name of the file containing the text of that -- license. While package authors may choose any license they like, Cabal -- provides an enumeration of a small set of common free and open source -- software licenses. This is done so that Hackage can recognise -- licenses, so that tools can detect licensing conflicts, and to -- deter license proliferation. -- -- It is recommended that all package authors use the -- license-file or license-files fields in their -- package descriptions. Further information about these fields can be -- found in the Cabal users guide. -- --

Additional resources

-- -- The following websites provide information about free and open source -- software licenses: -- -- -- --

Disclaimer

-- -- The descriptions of software licenses provided by this documentation -- are intended for informational purposes only and in no way constitute -- legal advice. Please read the text of the licenses and consult a -- lawyer for any advice regarding software licensing. module Distribution.License -- | Indicates the license under which a package's source code is released. -- Versions of the licenses not listed here will be rejected by Hackage -- and cause cabal check to issue a warning. data License -- | GNU General Public License, version 2 or version 3. GPL :: (Maybe Version) -> License -- | GNU Affero General Public License, version 3. AGPL :: (Maybe Version) -> License -- | GNU Lesser General Public License, version 2.1 or version -- 3. LGPL :: (Maybe Version) -> License -- | 2-clause BSD license. BSD2 :: License -- | 3-clause BSD license. BSD3 :: License -- | 4-clause BSD license. This license has not been approved by the -- OSI and is incompatible with the GNU GPL. It is provided for -- historical reasons and should be avoided. BSD4 :: License -- | MIT license. MIT :: License -- | ISC license ISC :: License -- | Mozilla Public License, version 2.0. MPL :: Version -> License -- | Apache License, version 2.0. Apache :: (Maybe Version) -> License -- | The author of a package disclaims any copyright to its source code and -- dedicates it to the public domain. This is not a software license. -- Please note that it is not possible to dedicate works to the public -- domain in every jurisdiction, nor is a work that is in the public -- domain in one jurisdiction necessarily in the public domain elsewhere. PublicDomain :: License -- | Explicitly 'All Rights Reserved', eg for proprietary software. The -- package may not be legally modified or redistributed by anyone but the -- rightsholder. AllRightsReserved :: License -- | No license specified which legally defaults to 'All Rights Reserved'. -- The package may not be legally modified or redistributed by anyone but -- the rightsholder. UnspecifiedLicense :: License -- | Any other software license. OtherLicense :: License -- | Indicates an erroneous license name. UnknownLicense :: String -> License -- | The list of all currently recognised licenses. knownLicenses :: [License] instance Data.Data.Data Distribution.License.License instance GHC.Classes.Eq Distribution.License.License instance GHC.Show.Show Distribution.License.License instance GHC.Read.Read Distribution.License.License instance GHC.Generics.Generic Distribution.License.License instance Data.Binary.Class.Binary Distribution.License.License instance Distribution.Text.Text Distribution.License.License -- | Haskell language dialects and extensions module Language.Haskell.Extension -- | This represents a Haskell language dialect. -- -- Language Extensions are interpreted relative to one of these -- base languages. data Language -- | The Haskell 98 language as defined by the Haskell 98 report. -- http://haskell.org/onlinereport/ Haskell98 :: Language -- | The Haskell 2010 language as defined by the Haskell 2010 report. -- http://www.haskell.org/onlinereport/haskell2010 Haskell2010 :: Language -- | An unknown language, identified by its name. UnknownLanguage :: String -> Language knownLanguages :: [Language] classifyLanguage :: String -> Language -- | This represents language extensions beyond a base Language -- definition (such as Haskell98) that are supported by some -- implementations, usually in some special mode. -- -- Where applicable, references are given to an implementation's official -- documentation. data Extension -- | Enable a known extension EnableExtension :: KnownExtension -> Extension -- | Disable a known extension DisableExtension :: KnownExtension -> Extension -- | An unknown extension, identified by the name of its LANGUAGE -- pragma. UnknownExtension :: String -> Extension data KnownExtension -- | Allow overlapping class instances, provided there is a unique most -- specific instance for each use. -- -- OverlappingInstances :: KnownExtension -- | Ignore structural rules guaranteeing the termination of class instance -- resolution. Termination is guaranteed by a fixed-depth recursion -- stack, and compilation may fail if this depth is exceeded. -- -- UndecidableInstances :: KnownExtension -- | Implies OverlappingInstances. Allow the implementation to -- choose an instance even when it is possible that further instantiation -- of types will lead to a more specific instance being applicable. -- -- IncoherentInstances :: KnownExtension -- | (deprecated) Allow recursive bindings in do blocks, -- using the rec keyword. See also RecursiveDo. DoRec :: KnownExtension -- | Allow recursive bindings using mdo, a variant of do. -- DoRec provides a different, preferred syntax. -- -- RecursiveDo :: KnownExtension -- | Provide syntax for writing list comprehensions which iterate over -- several lists together, like the zipWith family of functions. -- -- ParallelListComp :: KnownExtension -- | Allow multiple parameters in a type class. -- -- MultiParamTypeClasses :: KnownExtension -- | Enable the dreaded monomorphism restriction. -- -- MonomorphismRestriction :: KnownExtension -- | Allow a specification attached to a multi-parameter type class which -- indicates that some parameters are entirely determined by others. The -- implementation will check that this property holds for the declared -- instances, and will use this property to reduce ambiguity in instance -- resolution. -- -- FunctionalDependencies :: KnownExtension -- | Like RankNTypes but does not allow a higher-rank type to itself -- appear on the left of a function arrow. -- -- Rank2Types :: KnownExtension -- | Allow a universally-quantified type to occur on the left of a function -- arrow. -- -- RankNTypes :: KnownExtension -- | Allow data constructors to have polymorphic arguments. Unlike -- RankNTypes, does not allow this for ordinary functions. -- -- PolymorphicComponents :: KnownExtension -- | Allow existentially-quantified data constructors. -- -- ExistentialQuantification :: KnownExtension -- | Cause a type variable in a signature, which has an explicit -- forall quantifier, to scope over the definition of the -- accompanying value declaration. -- -- ScopedTypeVariables :: KnownExtension -- | Deprecated, use ScopedTypeVariables instead. PatternSignatures :: KnownExtension -- | Enable implicit function parameters with dynamic scope. -- -- ImplicitParams :: KnownExtension -- | Relax some restrictions on the form of the context of a type -- signature. -- -- FlexibleContexts :: KnownExtension -- | Relax some restrictions on the form of the context of an instance -- declaration. -- -- FlexibleInstances :: KnownExtension -- | Allow data type declarations with no constructors. -- -- EmptyDataDecls :: KnownExtension -- | Run the C preprocessor on Haskell source code. -- -- CPP :: KnownExtension -- | Allow an explicit kind signature giving the kind of types over which a -- type variable ranges. -- -- KindSignatures :: KnownExtension -- | Enable a form of pattern which forces evaluation before an attempted -- match, and a form of strict let/where binding. -- -- BangPatterns :: KnownExtension -- | Allow type synonyms in instance heads. -- -- TypeSynonymInstances :: KnownExtension -- | Enable Template Haskell, a system for compile-time metaprogramming. -- -- TemplateHaskell :: KnownExtension -- | Enable the Foreign Function Interface. In GHC, implements the standard -- Haskell 98 Foreign Function Interface Addendum, plus some GHC-specific -- extensions. -- -- ForeignFunctionInterface :: KnownExtension -- | Enable arrow notation. -- -- Arrows :: KnownExtension -- | (deprecated) Enable generic type classes, with default -- instances defined in terms of the algebraic structure of a type. -- -- Generics :: KnownExtension -- | Enable the implicit importing of the module Prelude. When -- disabled, when desugaring certain built-in syntax into ordinary -- identifiers, use whatever is in scope rather than the Prelude -- -- version. -- -- ImplicitPrelude :: KnownExtension -- | Enable syntax for implicitly binding local names corresponding to the -- field names of a record. Puns bind specific names, unlike -- RecordWildCards. -- -- NamedFieldPuns :: KnownExtension -- | Enable a form of guard which matches a pattern and binds variables. -- -- PatternGuards :: KnownExtension -- | Allow a type declared with newtype to use deriving -- for any class with an instance for the underlying type. -- -- GeneralizedNewtypeDeriving :: KnownExtension -- | Enable the "Trex" extensible records system. -- -- ExtensibleRecords :: KnownExtension -- | Enable type synonyms which are transparent in some definitions and -- opaque elsewhere, as a way of implementing abstract datatypes. -- -- RestrictedTypeSynonyms :: KnownExtension -- | Enable an alternate syntax for string literals, with string -- templating. -- -- HereDocuments :: KnownExtension -- | Allow the character # as a postfix modifier on identifiers. -- Also enables literal syntax for unboxed values. -- -- MagicHash :: KnownExtension -- | Allow data types and type synonyms which are indexed by types, i.e. -- ad-hoc polymorphism for types. -- -- TypeFamilies :: KnownExtension -- | Allow a standalone declaration which invokes the type class -- deriving mechanism. -- -- StandaloneDeriving :: KnownExtension -- | Allow certain Unicode characters to stand for certain ASCII character -- sequences, e.g. keywords and punctuation. -- -- UnicodeSyntax :: KnownExtension -- | Allow the use of unboxed types as foreign types, e.g. in foreign -- import and foreign export. -- -- UnliftedFFITypes :: KnownExtension -- | Enable interruptible FFI. -- -- InterruptibleFFI :: KnownExtension -- | Allow use of CAPI FFI calling convention (foreign import -- capi). -- -- CApiFFI :: KnownExtension -- | Defer validity checking of types until after expanding type synonyms, -- relaxing the constraints on how synonyms may be used. -- -- LiberalTypeSynonyms :: KnownExtension -- | Allow the name of a type constructor, type class, or type variable to -- be an infix operator. TypeOperators :: KnownExtension -- | Enable syntax for implicitly binding local names corresponding to the -- field names of a record. A wildcard binds all unmentioned names, -- unlike NamedFieldPuns. -- -- RecordWildCards :: KnownExtension -- | Deprecated, use NamedFieldPuns instead. RecordPuns :: KnownExtension -- | Allow a record field name to be disambiguated by the type of the -- record it's in. -- -- DisambiguateRecordFields :: KnownExtension -- | Enable traditional record syntax (as supported by Haskell 98) -- -- TraditionalRecordSyntax :: KnownExtension -- | Enable overloading of string literals using a type class, much like -- integer literals. -- -- OverloadedStrings :: KnownExtension -- | Enable generalized algebraic data types, in which type variables may -- be instantiated on a per-constructor basis. Implies GADTSyntax. -- -- GADTs :: KnownExtension -- | Enable GADT syntax for declaring ordinary algebraic datatypes. -- -- GADTSyntax :: KnownExtension -- | Make pattern bindings monomorphic. -- -- MonoPatBinds :: KnownExtension -- | Relax the requirements on mutually-recursive polymorphic functions. -- -- RelaxedPolyRec :: KnownExtension -- | Allow default instantiation of polymorphic types in more situations. -- -- ExtendedDefaultRules :: KnownExtension -- | Enable unboxed tuples. -- -- UnboxedTuples :: KnownExtension -- | Enable deriving for classes Typeable and Data. -- -- DeriveDataTypeable :: KnownExtension -- | Enable deriving for Generic and Generic1. -- -- DeriveGeneric :: KnownExtension -- | Enable support for default signatures. -- -- DefaultSignatures :: KnownExtension -- | Allow type signatures to be specified in instance declarations. -- -- InstanceSigs :: KnownExtension -- | Allow a class method's type to place additional constraints on a class -- type variable. -- -- ConstrainedClassMethods :: KnownExtension -- | Allow imports to be qualified by the package name the module is -- intended to be imported from, e.g. -- --
--   import "network" Network.Socket
--   
-- -- PackageImports :: KnownExtension -- | (deprecated) Allow a type variable to be instantiated at a -- polymorphic type. -- -- ImpredicativeTypes :: KnownExtension -- | (deprecated) Change the syntax for qualified infix operators. -- -- NewQualifiedOperators :: KnownExtension -- | Relax the interpretation of left operator sections to allow unary -- postfix operators. -- -- PostfixOperators :: KnownExtension -- | Enable quasi-quotation, a mechanism for defining new concrete syntax -- for expressions and patterns. -- -- QuasiQuotes :: KnownExtension -- | Enable generalized list comprehensions, supporting operations such as -- sorting and grouping. -- -- TransformListComp :: KnownExtension -- | Enable monad comprehensions, which generalise the list comprehension -- syntax to work for any monad. -- -- MonadComprehensions :: KnownExtension -- | Enable view patterns, which match a value by applying a function and -- matching on the result. -- -- ViewPatterns :: KnownExtension -- | Allow concrete XML syntax to be used in expressions and patterns, as -- per the Haskell Server Pages extension language: -- http://www.haskell.org/haskellwiki/HSP. The ideas behind it are -- discussed in the paper "Haskell Server Pages through Dynamic Loading" -- by Niklas Broberg, from Haskell Workshop '05. XmlSyntax :: KnownExtension -- | Allow regular pattern matching over lists, as discussed in the paper -- "Regular Expression Patterns" by Niklas Broberg, Andreas Farre and -- Josef Svenningsson, from ICFP '04. RegularPatterns :: KnownExtension -- | Enable the use of tuple sections, e.g. (, True) desugars into -- x -> (x, True). -- -- TupleSections :: KnownExtension -- | Allow GHC primops, written in C--, to be imported into a Haskell file. GHCForeignImportPrim :: KnownExtension -- | Support for patterns of the form n + k, where k is -- an integer literal. -- -- NPlusKPatterns :: KnownExtension -- | Improve the layout rule when if expressions are used in a -- do block. DoAndIfThenElse :: KnownExtension -- | Enable support for multi-way if-expressions. -- -- MultiWayIf :: KnownExtension -- | Enable support lambda-case expressions. -- -- LambdaCase :: KnownExtension -- | Makes much of the Haskell sugar be desugared into calls to the -- function with a particular name that is in scope. -- -- RebindableSyntax :: KnownExtension -- | Make forall a keyword in types, which can be used to give the -- generalisation explicitly. -- -- ExplicitForAll :: KnownExtension -- | Allow contexts to be put on datatypes, e.g. the Eq a in -- data Eq a => Set a = NilSet | ConsSet a (Set a). -- -- DatatypeContexts :: KnownExtension -- | Local (let and where) bindings are monomorphic. -- -- MonoLocalBinds :: KnownExtension -- | Enable deriving for the Functor class. -- -- DeriveFunctor :: KnownExtension -- | Enable deriving for the Traversable class. -- -- DeriveTraversable :: KnownExtension -- | Enable deriving for the Foldable class. -- -- DeriveFoldable :: KnownExtension -- | Enable non-decreasing indentation for do blocks. -- -- NondecreasingIndentation :: KnownExtension -- | Allow imports to be qualified with a safe keyword that requires the -- imported module be trusted as according to the Safe Haskell definition -- of trust. -- --
--   import safe Network.Socket
--   
-- -- SafeImports :: KnownExtension -- | Compile a module in the Safe, Safe Haskell mode -- a restricted form -- of the Haskell language to ensure type safety. -- -- Safe :: KnownExtension -- | Compile a module in the Trustworthy, Safe Haskell mode -- no -- restrictions apply but the module is marked as trusted as long as the -- package the module resides in is trusted. -- -- Trustworthy :: KnownExtension -- | Compile a module in the Unsafe, Safe Haskell mode so that modules -- compiled using Safe, Safe Haskell mode can't import it. -- -- Unsafe :: KnownExtension -- | Allow type classimplicit parameterequality constraints to be -- used as types with the special kind constraint. Also generalise the -- (ctxt => ty) syntax so that any type of kind constraint -- can occur before the arrow. -- -- ConstraintKinds :: KnownExtension -- | Enable kind polymorphism. -- -- PolyKinds :: KnownExtension -- | Enable datatype promotion. -- -- DataKinds :: KnownExtension -- | Enable parallel arrays syntax ([:, :]) for Data -- Parallel Haskell. -- -- ParallelArrays :: KnownExtension -- | Enable explicit role annotations, like in (type role Foo -- representational representational). -- -- RoleAnnotations :: KnownExtension -- | Enable overloading of list literals, arithmetic sequences and list -- patterns using the IsList type class. -- -- OverloadedLists :: KnownExtension -- | Enable case expressions that have no alternatives. Also applies to -- lambda-case expressions if they are enabled. -- -- EmptyCase :: KnownExtension -- | Triggers the generation of derived Typeable instances for every -- datatype and type class declaration. -- -- AutoDeriveTypeable :: KnownExtension -- | Desugars negative literals directly (without using negate). -- -- NegativeLiterals :: KnownExtension -- | Allow the use of binary integer literal syntax (e.g. -- 0b11001001 to denote 201). -- -- BinaryLiterals :: KnownExtension -- | Allow the use of floating literal syntax for all instances of -- Num, including Int and Integer. -- -- NumDecimals :: KnownExtension -- | Enable support for type classes with no type parameter. -- -- NullaryTypeClasses :: KnownExtension -- | Enable explicit namespaces in module import/export lists. -- -- ExplicitNamespaces :: KnownExtension -- | Allow the user to write ambiguous types, and the type inference engine -- to infer them. -- -- AllowAmbiguousTypes :: KnownExtension -- | Enable foreign import javascript. JavaScriptFFI :: KnownExtension -- | Allow giving names to and abstracting over patterns. -- -- PatternSynonyms :: KnownExtension -- | Allow anonymous placeholders (underscore) inside type signatures. The -- type inference engine will generate a message describing the type -- inferred at the hole's location. -- -- PartialTypeSignatures :: KnownExtension -- | Allow named placeholders written with a leading underscore inside type -- signatures. Wildcards with the same name unify to the same type. -- -- NamedWildCards :: KnownExtension -- | Enable deriving for any class. -- -- DeriveAnyClass :: KnownExtension -- | Enable deriving for the Lift class. -- -- DeriveLift :: KnownExtension -- | Enable support for 'static pointers' (and the static keyword) -- to refer to globally stable names, even across different programs. -- -- StaticPointers :: KnownExtension -- | Switches data type declarations to be strict by default (as if they -- had a bang using BangPatterns), and allow opt-in field -- laziness using ~. StrictData :: KnownExtension -- | Switches all pattern bindings to be strict by default (as if they had -- a bang using BangPatterns), ordinary patterns are recovered -- using ~. Implies StrictData. Strict :: KnownExtension -- | Allows do-notation for types that are -- Applicative as well as Monad. When -- enabled, desugaring do notation tries to use -- (*) and fmap and -- join as far as possible. ApplicativeDo :: KnownExtension -- | Allow records to use duplicated field labels for accessors. DuplicateRecordFields :: KnownExtension -- | Enable explicit type applications with the syntax id @Int. TypeApplications :: KnownExtension -- | Dissolve the distinction between types and kinds, allowing the -- compiler to reason about kind equality and therefore enabling GADTs to -- be promoted to the type-level. TypeInType :: KnownExtension -- | Allow recursive (and therefore undecideable) super-class -- relationships. UndecidableSuperClasses :: KnownExtension -- | A temporary extension to help library authors check if their code will -- compile with the new planned desugaring of fail. MonadFailDesugaring :: KnownExtension -- | A subset of TemplateHaskell including only quasi-quoting. TemplateHaskellQuotes :: KnownExtension -- | Allows use of the #label syntax. OverloadedLabels :: KnownExtension -- | Allow functional dependency annotations on type families to declare -- them as injective. TypeFamilyDependencies :: KnownExtension -- | Deprecated: KnownExtension is an instance of Enum and Bounded, use -- those instead. knownExtensions :: [KnownExtension] -- | Extensions that have been deprecated, possibly paired with another -- extension that replaces it. deprecatedExtensions :: [(Extension, Maybe Extension)] classifyExtension :: String -> Extension instance Data.Data.Data Language.Haskell.Extension.Extension instance GHC.Classes.Ord Language.Haskell.Extension.Extension instance GHC.Classes.Eq Language.Haskell.Extension.Extension instance GHC.Read.Read Language.Haskell.Extension.Extension instance GHC.Show.Show Language.Haskell.Extension.Extension instance GHC.Generics.Generic Language.Haskell.Extension.Extension instance Data.Data.Data Language.Haskell.Extension.KnownExtension instance GHC.Enum.Bounded Language.Haskell.Extension.KnownExtension instance GHC.Enum.Enum Language.Haskell.Extension.KnownExtension instance GHC.Classes.Ord Language.Haskell.Extension.KnownExtension instance GHC.Classes.Eq Language.Haskell.Extension.KnownExtension instance GHC.Read.Read Language.Haskell.Extension.KnownExtension instance GHC.Show.Show Language.Haskell.Extension.KnownExtension instance GHC.Generics.Generic Language.Haskell.Extension.KnownExtension instance Data.Data.Data Language.Haskell.Extension.Language instance GHC.Classes.Eq Language.Haskell.Extension.Language instance GHC.Read.Read Language.Haskell.Extension.Language instance GHC.Show.Show Language.Haskell.Extension.Language instance GHC.Generics.Generic Language.Haskell.Extension.Language instance Data.Binary.Class.Binary Language.Haskell.Extension.Extension instance Distribution.Text.Text Language.Haskell.Extension.Extension instance Data.Binary.Class.Binary Language.Haskell.Extension.KnownExtension instance Distribution.Text.Text Language.Haskell.Extension.KnownExtension instance Data.Binary.Class.Binary Language.Haskell.Extension.Language instance Distribution.Text.Text Language.Haskell.Extension.Language -- | This has an enumeration of the various compilers that Cabal knows -- about. It also specifies the default compiler. Sadly you'll often see -- code that does case analysis on this compiler flavour enumeration -- like: -- --
--   case compilerFlavor comp of
--     GHC -> GHC.getInstalledPackages verbosity packageDb progdb
--     JHC -> JHC.getInstalledPackages verbosity packageDb progdb
--   
-- -- Obviously it would be better to use the proper Compiler -- abstraction because that would keep all the compiler-specific code -- together. Unfortunately we cannot make this change yet without -- breaking the UserHooks api, which would break all custom -- Setup.hs files, so for the moment we just have to live with -- this deficiency. If you're interested, see ticket #57. module Distribution.Compiler data CompilerFlavor GHC :: CompilerFlavor GHCJS :: CompilerFlavor NHC :: CompilerFlavor YHC :: CompilerFlavor Hugs :: CompilerFlavor HBC :: CompilerFlavor Helium :: CompilerFlavor JHC :: CompilerFlavor LHC :: CompilerFlavor UHC :: CompilerFlavor HaskellSuite :: String -> CompilerFlavor OtherCompiler :: String -> CompilerFlavor buildCompilerId :: CompilerId buildCompilerFlavor :: CompilerFlavor -- | The default compiler flavour to pick when compiling stuff. This -- defaults to the compiler used to build the Cabal lib. -- -- However if it's not a recognised compiler then it's Nothing and -- the user will have to specify which compiler they want. defaultCompilerFlavor :: Maybe CompilerFlavor -- | Like classifyCompilerFlavor but compatible with the old ReadS -- parser. -- -- It is compatible in the sense that it accepts only the same strings, -- eg GHC but not "ghc". However other strings get mapped to -- OtherCompiler. The point of this is that we do not allow extra -- valid values that would upset older Cabal versions that had a stricter -- parser however we cope with new values more gracefully so that we'll -- be able to introduce new value in future without breaking things so -- much. parseCompilerFlavorCompat :: ReadP r CompilerFlavor classifyCompilerFlavor :: String -> CompilerFlavor data CompilerId CompilerId :: CompilerFlavor -> Version -> CompilerId -- | Compiler information used for resolving configurations. Some fields -- can be set to Nothing to indicate that the information is unknown. data CompilerInfo CompilerInfo :: CompilerId -> AbiTag -> Maybe [CompilerId] -> Maybe [Language] -> Maybe [Extension] -> CompilerInfo -- | Compiler flavour and version. [compilerInfoId] :: CompilerInfo -> CompilerId -- | Tag for distinguishing incompatible ABI's on the same architecture/os. [compilerInfoAbiTag] :: CompilerInfo -> AbiTag -- | Other implementations that this compiler claims to be compatible with, -- if known. [compilerInfoCompat] :: CompilerInfo -> Maybe [CompilerId] -- | Supported language standards, if known. [compilerInfoLanguages] :: CompilerInfo -> Maybe [Language] -- | Supported extensions, if known. [compilerInfoExtensions] :: CompilerInfo -> Maybe [Extension] -- | Make a CompilerInfo of which only the known information is its -- CompilerId, its AbiTag and that it does not claim to be compatible -- with other compiler id's. unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo data AbiTag NoAbiTag :: AbiTag AbiTag :: String -> AbiTag abiTagString :: AbiTag -> String instance GHC.Read.Read Distribution.Compiler.CompilerInfo instance GHC.Show.Show Distribution.Compiler.CompilerInfo instance GHC.Generics.Generic Distribution.Compiler.CompilerInfo instance GHC.Read.Read Distribution.Compiler.AbiTag instance GHC.Show.Show Distribution.Compiler.AbiTag instance GHC.Generics.Generic Distribution.Compiler.AbiTag instance GHC.Classes.Eq Distribution.Compiler.AbiTag instance GHC.Show.Show Distribution.Compiler.CompilerId instance GHC.Read.Read Distribution.Compiler.CompilerId instance GHC.Classes.Ord Distribution.Compiler.CompilerId instance GHC.Generics.Generic Distribution.Compiler.CompilerId instance GHC.Classes.Eq Distribution.Compiler.CompilerId instance Data.Data.Data Distribution.Compiler.CompilerFlavor instance GHC.Classes.Ord Distribution.Compiler.CompilerFlavor instance GHC.Classes.Eq Distribution.Compiler.CompilerFlavor instance GHC.Read.Read Distribution.Compiler.CompilerFlavor instance GHC.Show.Show Distribution.Compiler.CompilerFlavor instance GHC.Generics.Generic Distribution.Compiler.CompilerFlavor instance Data.Binary.Class.Binary Distribution.Compiler.CompilerInfo instance Data.Binary.Class.Binary Distribution.Compiler.AbiTag instance Distribution.Text.Text Distribution.Compiler.AbiTag instance Data.Binary.Class.Binary Distribution.Compiler.CompilerId instance Distribution.Text.Text Distribution.Compiler.CompilerId instance Data.Binary.Class.Binary Distribution.Compiler.CompilerFlavor instance Distribution.Text.Text Distribution.Compiler.CompilerFlavor module Distribution.Types.PackageName -- | A package name. -- -- Use mkPackageName and unPackageName to convert from/to a -- String. -- -- This type is opaque since Cabal-2.0 data PackageName -- | Convert PackageName to String unPackageName :: PackageName -> String -- | Construct a PackageName from a String -- -- mkPackageName is the inverse to unPackageName -- -- Note: No validations are performed to ensure that the resulting -- PackageName is valid mkPackageName :: String -> PackageName instance Data.Data.Data Distribution.Types.PackageName.PackageName instance GHC.Classes.Ord Distribution.Types.PackageName.PackageName instance GHC.Classes.Eq Distribution.Types.PackageName.PackageName instance GHC.Show.Show Distribution.Types.PackageName.PackageName instance GHC.Read.Read Distribution.Types.PackageName.PackageName instance GHC.Generics.Generic Distribution.Types.PackageName.PackageName instance Data.String.IsString Distribution.Types.PackageName.PackageName instance Data.Binary.Class.Binary Distribution.Types.PackageName.PackageName instance Distribution.Text.Text Distribution.Types.PackageName.PackageName instance Control.DeepSeq.NFData Distribution.Types.PackageName.PackageName module Distribution.Types.UnqualComponentName -- | An unqualified component name, for any kind of component. -- -- This is distinguished from a ComponentName and -- ComponentId. The former also states which of a library, -- executable, etc the name refers too. The later uniquely identifiers a -- component and its closure. data UnqualComponentName -- | Convert UnqualComponentName to String unUnqualComponentName :: UnqualComponentName -> String -- | Construct a UnqualComponentName from a String -- -- mkUnqualComponentName is the inverse to -- unUnqualComponentName -- -- Note: No validations are performed to ensure that the resulting -- UnqualComponentName is valid mkUnqualComponentName :: String -> UnqualComponentName -- | Converts a package name to an unqualified component name -- -- Useful in legacy situations where a package name may refer to an -- internal component, if one is defined with that name. packageNameToUnqualComponentName :: PackageName -> UnqualComponentName -- | Converts an unqualified component name to a package name -- -- packageNameToUnqualComponentName is the inverse of -- unqualComponentNameToPackageName. -- -- Useful in legacy situations where a package name may refer to an -- internal component, if one is defined with that name. unqualComponentNameToPackageName :: UnqualComponentName -> PackageName instance GHC.Base.Monoid Distribution.Types.UnqualComponentName.UnqualComponentName instance Data.Semigroup.Semigroup Distribution.Types.UnqualComponentName.UnqualComponentName instance Data.Data.Data Distribution.Types.UnqualComponentName.UnqualComponentName instance GHC.Classes.Ord Distribution.Types.UnqualComponentName.UnqualComponentName instance GHC.Classes.Eq Distribution.Types.UnqualComponentName.UnqualComponentName instance GHC.Show.Show Distribution.Types.UnqualComponentName.UnqualComponentName instance GHC.Read.Read Distribution.Types.UnqualComponentName.UnqualComponentName instance GHC.Generics.Generic Distribution.Types.UnqualComponentName.UnqualComponentName instance Data.String.IsString Distribution.Types.UnqualComponentName.UnqualComponentName instance Data.Binary.Class.Binary Distribution.Types.UnqualComponentName.UnqualComponentName instance Distribution.Text.Text Distribution.Types.UnqualComponentName.UnqualComponentName instance Control.DeepSeq.NFData Distribution.Types.UnqualComponentName.UnqualComponentName module Distribution.Types.ComponentName data ComponentName CLibName :: ComponentName CSubLibName :: UnqualComponentName -> ComponentName CFLibName :: UnqualComponentName -> ComponentName CExeName :: UnqualComponentName -> ComponentName CTestName :: UnqualComponentName -> ComponentName CBenchName :: UnqualComponentName -> ComponentName defaultLibName :: ComponentName -- | Convert the UnqualComponentName of a library into a -- ComponentName. libraryComponentName :: Maybe UnqualComponentName -> ComponentName showComponentName :: ComponentName -> String componentNameStanza :: ComponentName -> String -- | This gets the underlying unqualified component name. In fact, it is -- guaranteed to uniquely identify a component, returning -- Nothing if the ComponentName was for the public -- library. componentNameString :: ComponentName -> Maybe UnqualComponentName instance GHC.Show.Show Distribution.Types.ComponentName.ComponentName instance GHC.Read.Read Distribution.Types.ComponentName.ComponentName instance GHC.Classes.Ord Distribution.Types.ComponentName.ComponentName instance GHC.Generics.Generic Distribution.Types.ComponentName.ComponentName instance GHC.Classes.Eq Distribution.Types.ComponentName.ComponentName instance Data.Binary.Class.Binary Distribution.Types.ComponentName.ComponentName instance Distribution.Text.Text Distribution.Types.ComponentName.ComponentName module Distribution.Types.PackageId -- | The name and version of a package. data PackageIdentifier PackageIdentifier :: PackageName -> Version -> PackageIdentifier -- | The name of this package, eg. foo [pkgName] :: PackageIdentifier -> PackageName -- | the version of this package, eg 1.2 [pkgVersion] :: PackageIdentifier -> Version -- | Type alias so we can use the shorter name PackageId. type PackageId = PackageIdentifier instance Data.Data.Data Distribution.Types.PackageId.PackageIdentifier instance GHC.Classes.Ord Distribution.Types.PackageId.PackageIdentifier instance GHC.Classes.Eq Distribution.Types.PackageId.PackageIdentifier instance GHC.Show.Show Distribution.Types.PackageId.PackageIdentifier instance GHC.Read.Read Distribution.Types.PackageId.PackageIdentifier instance GHC.Generics.Generic Distribution.Types.PackageId.PackageIdentifier instance Data.Binary.Class.Binary Distribution.Types.PackageId.PackageIdentifier instance Distribution.Text.Text Distribution.Types.PackageId.PackageIdentifier instance Control.DeepSeq.NFData Distribution.Types.PackageId.PackageIdentifier module Distribution.Types.UnitId -- | A unit identifier identifies a (possibly instantiated) -- package/component that can be installed the installed package -- database. There are several types of components that can be installed: -- -- -- -- A unit is a component plus the additional information on how the holes -- are filled in. Thus there is a one to many relationship: for a -- particular component there are many different ways of filling in the -- holes, and each different combination is a unit (and has a separate -- UnitId). -- -- UnitId is distinct from OpenUnitId, in that it is -- always installed, whereas OpenUnitId are intermediate unit -- identities that arise during mixin linking, and don't necessarily -- correspond to any actually installed unit. Since the mapping is not -- actually recorded in a UnitId, you can't actually substitute -- over them (but you can substitute over OpenUnitId). See also -- Distribution.Backpack.FullUnitId for a mechanism for expanding -- an instantiated UnitId to retrieve its mapping. -- -- Backwards compatibility note: if you need to get the string -- representation of a UnitId to pass, e.g., as a -package-id -- flag, use the display function, which will work on all versions -- of Cabal. data UnitId -- | If you need backwards compatibility, consider using display -- instead, which is supported by all versions of Cabal. unUnitId :: UnitId -> String mkUnitId :: String -> UnitId -- | A UnitId for a definite package. The DefUnitId invariant -- says that a UnitId identified this way is definite; i.e., it -- has no unfilled holes. data DefUnitId -- | Unsafely create a DefUnitId from a UnitId. Your -- responsibility is to ensure that the DefUnitId invariant holds. unsafeMkDefUnitId :: UnitId -> DefUnitId unDefUnitId :: DefUnitId -> UnitId -- | Create a unit identity with no associated hash directly from a -- ComponentId. newSimpleUnitId :: ComponentId -> UnitId -- | Make an old-style UnitId from a package identifier. Assumed to be for -- the public library mkLegacyUnitId :: PackageId -> UnitId -- | Returns library name prefixed with HS, suitable for filenames getHSLibraryName :: UnitId -> String -- | Deprecated: Use UnitId instead type InstalledPackageId = UnitId instance Distribution.Text.Text Distribution.Types.UnitId.DefUnitId instance Control.DeepSeq.NFData Distribution.Types.UnitId.DefUnitId instance Data.Binary.Class.Binary Distribution.Types.UnitId.DefUnitId instance Data.Data.Data Distribution.Types.UnitId.DefUnitId instance GHC.Classes.Ord Distribution.Types.UnitId.DefUnitId instance GHC.Classes.Eq Distribution.Types.UnitId.DefUnitId instance GHC.Show.Show Distribution.Types.UnitId.DefUnitId instance GHC.Read.Read Distribution.Types.UnitId.DefUnitId instance GHC.Generics.Generic Distribution.Types.UnitId.DefUnitId instance Control.DeepSeq.NFData Distribution.Types.UnitId.UnitId instance Data.Data.Data Distribution.Types.UnitId.UnitId instance GHC.Classes.Ord Distribution.Types.UnitId.UnitId instance GHC.Classes.Eq Distribution.Types.UnitId.UnitId instance GHC.Show.Show Distribution.Types.UnitId.UnitId instance GHC.Read.Read Distribution.Types.UnitId.UnitId instance GHC.Generics.Generic Distribution.Types.UnitId.UnitId instance Data.Binary.Class.Binary Distribution.Types.UnitId.UnitId instance Distribution.Text.Text Distribution.Types.UnitId.UnitId instance Data.String.IsString Distribution.Types.UnitId.UnitId module Distribution.Types.Module -- | A module identity uniquely identifies a Haskell module by qualifying a -- ModuleName with the UnitId which defined it. This type -- distinguishes between two packages which provide a module with the -- same name, or a module from the same package compiled with different -- dependencies. There are a few cases where Cabal needs to know about -- module identities, e.g., when writing out reexported modules in the -- InstalledPackageInfo. data Module Module :: DefUnitId -> ModuleName -> Module instance Data.Data.Data Distribution.Types.Module.Module instance GHC.Classes.Ord Distribution.Types.Module.Module instance GHC.Classes.Eq Distribution.Types.Module.Module instance GHC.Show.Show Distribution.Types.Module.Module instance GHC.Read.Read Distribution.Types.Module.Module instance GHC.Generics.Generic Distribution.Types.Module.Module instance Data.Binary.Class.Binary Distribution.Types.Module.Module instance Distribution.Text.Text Distribution.Types.Module.Module instance Control.DeepSeq.NFData Distribution.Types.Module.Module -- | This module defines the core data types for Backpack. For more -- details, see: -- -- -- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst module Distribution.Backpack -- | An OpenUnitId describes a (possibly partially) instantiated -- Backpack component, with a description of how the holes are filled in. -- Unlike OpenUnitId, the ModuleSubst is kept in a -- structured form that allows for substitution (which fills in holes.) -- This form of unit cannot be installed. It must first be converted to a -- UnitId. -- -- In the absence of Backpack, there are no holes to fill, so any such -- component always has an empty module substitution; thus we can lossly -- represent it as an 'OpenUnitId uid'. -- -- For a source component using Backpack, however, there is more -- structure as components may be parametrized over some signatures, and -- these "holes" may be partially or wholly filled. -- -- OpenUnitId plays an important role when we are mix-in linking, and is -- recorded to the installed packaged database for indefinite packages; -- however, for compiled packages that are fully instantiated, we -- instantiate OpenUnitId into UnitId. -- -- For more details see the Backpack spec -- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst data OpenUnitId -- | Identifies a component which may have some unfilled holes; specifying -- its ComponentId and its OpenModuleSubst. TODO: Invariant -- that OpenModuleSubst is non-empty? See also the Text instance. IndefFullUnitId :: ComponentId -> OpenModuleSubst -> OpenUnitId -- | Identifies a fully instantiated component, which has been compiled and -- abbreviated as a hash. The embedded UnitId MUST NOT be for an -- indefinite component; an OpenUnitId is guaranteed not to have -- any holes. DefiniteUnitId :: DefUnitId -> OpenUnitId -- | Get the set of holes (ModuleVar) embedded in a UnitId. openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName -- | Safe constructor from a UnitId. The only way to do this safely is if -- the instantiation is provided. mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId -- | A UnitId for a definite package. The DefUnitId invariant -- says that a UnitId identified this way is definite; i.e., it -- has no unfilled holes. data DefUnitId unDefUnitId :: DefUnitId -> UnitId -- | Create a DefUnitId from a ComponentId and an -- instantiation with no holes. mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId -- | Unlike a Module, an OpenModule is either an ordinary -- module from some unit, OR an OpenModuleVar, representing a hole -- that needs to be filled in. Substitutions are over module variables. data OpenModule OpenModule :: OpenUnitId -> ModuleName -> OpenModule OpenModuleVar :: ModuleName -> OpenModule -- | Get the set of holes (ModuleVar) embedded in a Module. openModuleFreeHoles :: OpenModule -> Set ModuleName -- | An explicit substitution on modules. -- -- NB: These substitutions are NOT idempotent, for example, a valid -- substitution is (A -> B, B -> A). type OpenModuleSubst = Map ModuleName OpenModule -- | Pretty-print the entries of a module substitution, suitable for -- embedding into a OpenUnitId or passing to GHC via -- --instantiate-with. dispOpenModuleSubst :: OpenModuleSubst -> Doc -- | Pretty-print a single entry of a module substitution. dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Doc -- | Inverse to dispModSubst. parseOpenModuleSubst :: ReadP r OpenModuleSubst -- | Inverse to dispModSubstEntry. parseOpenModuleSubstEntry :: ReadP r (ModuleName, OpenModule) -- | Get the set of holes (ModuleVar) embedded in a -- OpenModuleSubst. This is NOT the domain of the substitution. openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName -- | When typechecking, we don't demand that a freshly instantiated -- IndefFullUnitId be compiled; instead, we just depend on the -- installed indefinite unit installed at the ComponentId. abstractUnitId :: OpenUnitId -> UnitId -- | Take a module substitution and hash it into a string suitable for -- UnitId. Note that since this takes Module, not -- OpenModule, you are responsible for recursively converting -- OpenModule into Module. See also -- Distribution.Backpack.ReadyComponent. hashModuleSubst :: Map ModuleName Module -> Maybe String instance Data.Data.Data Distribution.Backpack.OpenUnitId instance GHC.Classes.Ord Distribution.Backpack.OpenUnitId instance GHC.Classes.Eq Distribution.Backpack.OpenUnitId instance GHC.Show.Show Distribution.Backpack.OpenUnitId instance GHC.Read.Read Distribution.Backpack.OpenUnitId instance GHC.Generics.Generic Distribution.Backpack.OpenUnitId instance Data.Data.Data Distribution.Backpack.OpenModule instance GHC.Classes.Ord Distribution.Backpack.OpenModule instance GHC.Classes.Eq Distribution.Backpack.OpenModule instance GHC.Show.Show Distribution.Backpack.OpenModule instance GHC.Read.Read Distribution.Backpack.OpenModule instance GHC.Generics.Generic Distribution.Backpack.OpenModule instance Data.Binary.Class.Binary Distribution.Backpack.OpenUnitId instance Control.DeepSeq.NFData Distribution.Backpack.OpenUnitId instance Distribution.Text.Text Distribution.Backpack.OpenUnitId instance Data.Binary.Class.Binary Distribution.Backpack.OpenModule instance Control.DeepSeq.NFData Distribution.Backpack.OpenModule instance Distribution.Text.Text Distribution.Backpack.OpenModule -- | 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) 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 module Distribution.Types.ModuleReexport data ModuleReexport ModuleReexport :: Maybe PackageName -> ModuleName -> ModuleName -> ModuleReexport [moduleReexportOriginalPackage] :: ModuleReexport -> Maybe PackageName [moduleReexportOriginalName] :: ModuleReexport -> ModuleName [moduleReexportName] :: ModuleReexport -> ModuleName instance Data.Data.Data Distribution.Types.ModuleReexport.ModuleReexport instance GHC.Show.Show Distribution.Types.ModuleReexport.ModuleReexport instance GHC.Read.Read Distribution.Types.ModuleReexport.ModuleReexport instance GHC.Generics.Generic Distribution.Types.ModuleReexport.ModuleReexport instance GHC.Classes.Eq Distribution.Types.ModuleReexport.ModuleReexport instance Data.Binary.Class.Binary Distribution.Types.ModuleReexport.ModuleReexport instance Distribution.Text.Text Distribution.Types.ModuleReexport.ModuleReexport module Distribution.Types.Mixin data Mixin Mixin :: PackageName -> IncludeRenaming -> Mixin [mixinPackageName] :: Mixin -> PackageName [mixinIncludeRenaming] :: Mixin -> IncludeRenaming instance GHC.Generics.Generic Distribution.Types.Mixin.Mixin instance Data.Data.Data Distribution.Types.Mixin.Mixin instance GHC.Classes.Ord Distribution.Types.Mixin.Mixin instance GHC.Classes.Eq Distribution.Types.Mixin.Mixin instance GHC.Read.Read Distribution.Types.Mixin.Mixin instance GHC.Show.Show Distribution.Types.Mixin.Mixin instance Data.Binary.Class.Binary Distribution.Types.Mixin.Mixin instance Distribution.Text.Text Distribution.Types.Mixin.Mixin module Distribution.Types.ExeDependency -- | Describes a dependency on an executable from a package data ExeDependency ExeDependency :: PackageName -> UnqualComponentName -> VersionRange -> ExeDependency qualifiedExeName :: ExeDependency -> ComponentName instance Data.Data.Data Distribution.Types.ExeDependency.ExeDependency instance GHC.Classes.Eq Distribution.Types.ExeDependency.ExeDependency instance GHC.Show.Show Distribution.Types.ExeDependency.ExeDependency instance GHC.Read.Read Distribution.Types.ExeDependency.ExeDependency instance GHC.Generics.Generic Distribution.Types.ExeDependency.ExeDependency instance Data.Binary.Class.Binary Distribution.Types.ExeDependency.ExeDependency instance Control.DeepSeq.NFData Distribution.Types.ExeDependency.ExeDependency instance Distribution.Text.Text Distribution.Types.ExeDependency.ExeDependency module Distribution.Types.Dependency -- | Describes a dependency on a source package (API) data Dependency Dependency :: PackageName -> VersionRange -> Dependency depPkgName :: Dependency -> PackageName depVerRange :: Dependency -> VersionRange thisPackageVersion :: PackageIdentifier -> Dependency notThisPackageVersion :: PackageIdentifier -> Dependency -- | Simplify the VersionRange expression in a Dependency. -- See simplifyVersionRange. simplifyDependency :: Dependency -> Dependency instance Data.Data.Data Distribution.Types.Dependency.Dependency instance GHC.Classes.Eq Distribution.Types.Dependency.Dependency instance GHC.Show.Show Distribution.Types.Dependency.Dependency instance GHC.Read.Read Distribution.Types.Dependency.Dependency instance GHC.Generics.Generic Distribution.Types.Dependency.Dependency instance Data.Binary.Class.Binary Distribution.Types.Dependency.Dependency instance Control.DeepSeq.NFData Distribution.Types.Dependency.Dependency instance Distribution.Text.Text Distribution.Types.Dependency.Dependency module Distribution.Types.SetupBuildInfo data SetupBuildInfo SetupBuildInfo :: [Dependency] -> Bool -> SetupBuildInfo [setupDepends] :: SetupBuildInfo -> [Dependency] -- | Is this a default 'custom-setup' section added by the cabal-install -- code (as opposed to user-provided)? This field is only used -- internally, and doesn't correspond to anything in the .cabal file. See -- #3199. [defaultSetupDepends] :: SetupBuildInfo -> Bool instance Data.Data.Data Distribution.Types.SetupBuildInfo.SetupBuildInfo instance GHC.Read.Read Distribution.Types.SetupBuildInfo.SetupBuildInfo instance GHC.Classes.Eq Distribution.Types.SetupBuildInfo.SetupBuildInfo instance GHC.Show.Show Distribution.Types.SetupBuildInfo.SetupBuildInfo instance GHC.Generics.Generic Distribution.Types.SetupBuildInfo.SetupBuildInfo instance Data.Binary.Class.Binary Distribution.Types.SetupBuildInfo.SetupBuildInfo instance GHC.Base.Monoid Distribution.Types.SetupBuildInfo.SetupBuildInfo instance Data.Semigroup.Semigroup Distribution.Types.SetupBuildInfo.SetupBuildInfo module Distribution.Types.DependencyMap -- | A map of dependencies. Newtyped since the default monoid instance is -- not appropriate. The monoid instance uses -- intersectVersionRanges. data DependencyMap toDepMap :: [Dependency] -> DependencyMap fromDepMap :: DependencyMap -> [Dependency] constrainBy :: DependencyMap -> DependencyMap -> DependencyMap instance GHC.Read.Read Distribution.Types.DependencyMap.DependencyMap instance GHC.Show.Show Distribution.Types.DependencyMap.DependencyMap instance GHC.Base.Monoid Distribution.Types.DependencyMap.DependencyMap instance Data.Semigroup.Semigroup Distribution.Types.DependencyMap.DependencyMap module Distribution.Types.MungedPackageName -- | A combination of a package and component name used in various legacy -- interfaces, chiefly bundled with a version as -- MungedPackageId. It's generally better to use a -- UnitId to opaquely refer to some compilation/packing unit, -- but that doesn't always work, e.g. where a "name" is needed, in which -- case this can be used as a fallback. -- -- Use mkMungedPackageName and unMungedPackageName to -- convert from/to a String. data MungedPackageName -- | Convert MungedPackageName to String unMungedPackageName :: MungedPackageName -> String -- | Construct a MungedPackageName from a String -- -- mkMungedPackageName is the inverse to -- unMungedPackageName -- -- Note: No validations are performed to ensure that the resulting -- MungedPackageName is valid mkMungedPackageName :: String -> MungedPackageName -- | Computes the package name for a library. If this is the public -- library, it will just be the original package name; otherwise, it will -- be a munged package name recording the original package name as well -- as the name of the internal library. -- -- A lot of tooling in the Haskell ecosystem assumes that if something is -- installed to the package database with the package name foo, -- then it actually is an entry for the (only public) library in package -- foo. With internal packages, this is not necessarily true: a -- public library as well as arbitrarily many internal libraries may come -- from the same package. To prevent tools from getting confused in this -- case, the package name of these internal libraries is munged so that -- they do not conflict the public library proper. A particular case -- where this matters is ghc-pkg: if we don't munge the package name, the -- inplace registration will OVERRIDE a different internal library. -- -- We munge into a reserved namespace, "z-", and encode both the -- component name and the package name of an internal library using the -- following format: -- -- compat-pkg-name ::= "z-" package-name "-z-" library-name -- -- where package-name and library-name have "-" ( "z" + ) "-" segments -- encoded by adding an extra "z". -- -- When we have the public library, the compat-pkg-name is just the -- package-name, no surprises there! computeCompatPackageName :: PackageName -> Maybe UnqualComponentName -> MungedPackageName decodeCompatPackageName :: MungedPackageName -> (PackageName, Maybe UnqualComponentName) instance Data.Data.Data Distribution.Types.MungedPackageName.MungedPackageName instance GHC.Classes.Ord Distribution.Types.MungedPackageName.MungedPackageName instance GHC.Classes.Eq Distribution.Types.MungedPackageName.MungedPackageName instance GHC.Show.Show Distribution.Types.MungedPackageName.MungedPackageName instance GHC.Read.Read Distribution.Types.MungedPackageName.MungedPackageName instance GHC.Generics.Generic Distribution.Types.MungedPackageName.MungedPackageName instance Data.String.IsString Distribution.Types.MungedPackageName.MungedPackageName instance Data.Binary.Class.Binary Distribution.Types.MungedPackageName.MungedPackageName instance Distribution.Text.Text Distribution.Types.MungedPackageName.MungedPackageName instance Control.DeepSeq.NFData Distribution.Types.MungedPackageName.MungedPackageName module Distribution.Types.MungedPackageId -- | A simple pair of a MungedPackageName and Version. -- MungedPackageName is to MungedPackageId as -- PackageName is to PackageId. See -- MungedPackageName for more info. data MungedPackageId MungedPackageId :: MungedPackageName -> Version -> MungedPackageId -- | The combined package and component name. see documentation for -- MungedPackageName. [mungedName] :: MungedPackageId -> MungedPackageName -- | The version of this package / component, eg 1.2 [mungedVersion] :: MungedPackageId -> Version -- | See docs for computeCompatPackageId. this is a thin wrapper -- around that. computeCompatPackageId :: PackageId -> Maybe UnqualComponentName -> MungedPackageId instance Data.Data.Data Distribution.Types.MungedPackageId.MungedPackageId instance GHC.Classes.Ord Distribution.Types.MungedPackageId.MungedPackageId instance GHC.Classes.Eq Distribution.Types.MungedPackageId.MungedPackageId instance GHC.Show.Show Distribution.Types.MungedPackageId.MungedPackageId instance GHC.Read.Read Distribution.Types.MungedPackageId.MungedPackageId instance GHC.Generics.Generic Distribution.Types.MungedPackageId.MungedPackageId instance Data.Binary.Class.Binary Distribution.Types.MungedPackageId.MungedPackageId instance Distribution.Text.Text Distribution.Types.MungedPackageId.MungedPackageId instance Control.DeepSeq.NFData Distribution.Types.MungedPackageId.MungedPackageId -- | Defines a package identifier along with a parser and pretty printer -- for it. PackageIdentifiers consist of a name and an exact -- version. It also defines a Dependency data type. A dependency -- is a package name and a version range, like "foo >= 1.2 -- && < 2". module Distribution.Package -- | Class of things that have a PackageIdentifier -- -- Types in this class are all notions of a package. This allows us to -- have different types for the different phases that packages go though, -- from simple name/id, package description, configured or installed -- packages. -- -- Not all kinds of packages can be uniquely identified by a -- PackageIdentifier. In particular, installed packages cannot, -- there may be many installed instances of the same source package. class Package pkg packageId :: Package pkg => pkg -> PackageIdentifier packageName :: Package pkg => pkg -> PackageName packageVersion :: Package pkg => pkg -> Version class HasMungedPackageId pkg mungedId :: HasMungedPackageId pkg => pkg -> MungedPackageId mungedName' :: HasMungedPackageId pkg => pkg -> MungedPackageName mungedVersion' :: HasMungedPackageId munged => munged -> Version -- | Packages that have an installed unit ID class Package pkg => HasUnitId pkg installedUnitId :: HasUnitId pkg => pkg -> UnitId -- | Compatibility wrapper for Cabal pre-1.24. -- | Deprecated: Use installedUnitId instead installedPackageId :: HasUnitId pkg => pkg -> UnitId -- | Class of installed packages. -- -- The primary data type which is an instance of this package is -- InstalledPackageInfo, but when we are doing install plans in -- Cabal install we may have other, installed package-like things which -- contain more metadata. Installed packages have exact dependencies -- installedDepends. class (HasUnitId pkg) => PackageInstalled pkg installedDepends :: PackageInstalled pkg => pkg -> [UnitId] instance Distribution.Package.HasMungedPackageId Distribution.Types.MungedPackageId.MungedPackageId instance Distribution.Package.Package Distribution.Types.PackageId.PackageIdentifier 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. 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.Show.Show id => GHC.Show.Show (Distribution.Types.AnnotatedId.AnnotatedId id) instance Distribution.Package.Package (Distribution.Types.AnnotatedId.AnnotatedId id) instance GHC.Base.Functor Distribution.Types.AnnotatedId.AnnotatedId 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 -- | 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 -- | 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, $arch-$os-$compiler-$abitag 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.PathTemplate instance GHC.Classes.Ord Distribution.Simple.InstallDirs.PathTemplate instance GHC.Classes.Eq Distribution.Simple.InstallDirs.PathTemplate instance GHC.Generics.Generic Distribution.Simple.InstallDirs.PathComponent instance GHC.Classes.Ord Distribution.Simple.InstallDirs.PathComponent instance GHC.Classes.Eq Distribution.Simple.InstallDirs.PathComponent instance GHC.Generics.Generic Distribution.Simple.InstallDirs.PathTemplateVariable instance GHC.Classes.Ord Distribution.Simple.InstallDirs.PathTemplateVariable instance GHC.Classes.Eq Distribution.Simple.InstallDirs.PathTemplateVariable instance GHC.Show.Show Distribution.Simple.InstallDirs.CopyDest instance GHC.Classes.Eq Distribution.Simple.InstallDirs.CopyDest 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 Data.Binary.Class.Binary 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.PathComponent instance GHC.Show.Show Distribution.Simple.InstallDirs.PathComponent instance GHC.Read.Read Distribution.Simple.InstallDirs.PathComponent instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.PathTemplateVariable instance GHC.Show.Show Distribution.Simple.InstallDirs.PathTemplateVariable instance GHC.Read.Read Distribution.Simple.InstallDirs.PathTemplateVariable instance Data.Binary.Class.Binary dir => Data.Binary.Class.Binary (Distribution.Simple.InstallDirs.InstallDirs dir) instance (Data.Semigroup.Semigroup dir, GHC.Base.Monoid dir) => GHC.Base.Monoid (Distribution.Simple.InstallDirs.InstallDirs dir) instance Data.Semigroup.Semigroup dir => Data.Semigroup.Semigroup (Distribution.Simple.InstallDirs.InstallDirs dir) module Distribution.Types.LegacyExeDependency -- | Describes a legacy `build-tools`-style dependency on an executable -- -- It is "legacy" because we do not know what the build-tool referred to. -- It could refer to a pkg-config executable (PkgconfigName), or an -- internal executable (UnqualComponentName). Thus the name is stringly -- typed. data LegacyExeDependency LegacyExeDependency :: String -> VersionRange -> LegacyExeDependency instance Data.Data.Data Distribution.Types.LegacyExeDependency.LegacyExeDependency instance GHC.Classes.Eq Distribution.Types.LegacyExeDependency.LegacyExeDependency instance GHC.Show.Show Distribution.Types.LegacyExeDependency.LegacyExeDependency instance GHC.Read.Read Distribution.Types.LegacyExeDependency.LegacyExeDependency instance GHC.Generics.Generic Distribution.Types.LegacyExeDependency.LegacyExeDependency instance Data.Binary.Class.Binary Distribution.Types.LegacyExeDependency.LegacyExeDependency instance Control.DeepSeq.NFData Distribution.Types.LegacyExeDependency.LegacyExeDependency instance Distribution.Text.Text Distribution.Types.LegacyExeDependency.LegacyExeDependency module Distribution.Types.BuildInfo data BuildInfo BuildInfo :: Bool -> [LegacyExeDependency] -> [ExeDependency] -> [String] -> [String] -> [String] -> [PkgconfigDependency] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [ModuleName] -> [ModuleName] -> Maybe Language -> [Language] -> [Extension] -> [Extension] -> [Extension] -> [String] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])] -> [(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo -- | component is buildable here | Tools needed to build this bit. -- -- This is a legacy field that "build-tool-depends" larely supersedes. -- -- Unless use are very sure what you are doing, use the functions in -- BuildToolDepends rather than accessing this field directly. [buildable] :: BuildInfo -> Bool [buildTools] :: BuildInfo -> [LegacyExeDependency] -- | Haskell tools needed to build this bit -- -- This field is better than "build-tools" because it allows one to -- precisely specify an executable in a package. -- -- Unless use are very sure what you are doing, use the functions in -- BuildToolDepends rather than accessing this field directly. [buildToolDepends] :: BuildInfo -> [ExeDependency] -- | options for pre-processing Haskell code [cppOptions] :: BuildInfo -> [String] -- | options for C compiler [ccOptions] :: BuildInfo -> [String] -- | options for linker [ldOptions] :: BuildInfo -> [String] -- | pkg-config packages that are used [pkgconfigDepends] :: BuildInfo -> [PkgconfigDependency] -- | support frameworks for Mac OS X [frameworks] :: BuildInfo -> [String] -- | extra locations to find frameworks. [extraFrameworkDirs] :: BuildInfo -> [String] [cSources] :: BuildInfo -> [FilePath] [jsSources] :: BuildInfo -> [FilePath] -- | where to look for the Haskell module hierarchy [hsSourceDirs] :: BuildInfo -> [FilePath] -- | non-exposed or non-main modules [otherModules] :: BuildInfo -> [ModuleName] -- | not present on sdist, Paths_* or user-generated with a custom Setup.hs [autogenModules] :: BuildInfo -> [ModuleName] -- | language used when not explicitly specified [defaultLanguage] :: BuildInfo -> Maybe Language -- | other languages used within the package [otherLanguages] :: BuildInfo -> [Language] -- | language extensions used by all modules [defaultExtensions] :: BuildInfo -> [Extension] -- | other language extensions used within the package [otherExtensions] :: BuildInfo -> [Extension] -- | the old extensions field, treated same as defaultExtensions [oldExtensions] :: BuildInfo -> [Extension] -- | what libraries to link with when compiling a program that uses your -- package [extraLibs] :: BuildInfo -> [String] -- | if present, overrides extraLibs when package is loaded with GHCi. [extraGHCiLibs] :: BuildInfo -> [String] [extraLibDirs] :: BuildInfo -> [String] -- | directories to find .h files [includeDirs] :: BuildInfo -> [FilePath] -- | The .h files to be found in includeDirs [includes] :: BuildInfo -> [FilePath] -- | .h files to install with the package [installIncludes] :: BuildInfo -> [FilePath] [options] :: BuildInfo -> [(CompilerFlavor, [String])] [profOptions] :: BuildInfo -> [(CompilerFlavor, [String])] [sharedOptions] :: BuildInfo -> [(CompilerFlavor, [String])] -- | Custom fields starting with x-, stored in a simple assoc-list. [customFieldsBI] :: BuildInfo -> [(String, String)] -- | Dependencies specific to a library or executable target [targetBuildDepends] :: BuildInfo -> [Dependency] [mixins] :: BuildInfo -> [Mixin] emptyBuildInfo :: BuildInfo -- | The Languages used by this component allLanguages :: BuildInfo -> [Language] -- | The Extensions that are used somewhere by this component allExtensions :: BuildInfo -> [Extension] -- | The Extensions that are used by all modules in this component usedExtensions :: BuildInfo -> [Extension] -- | Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> BuildInfo -> [String] hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] hcSharedOptions :: CompilerFlavor -> BuildInfo -> [String] instance Data.Data.Data Distribution.Types.BuildInfo.BuildInfo instance GHC.Classes.Eq Distribution.Types.BuildInfo.BuildInfo instance GHC.Read.Read Distribution.Types.BuildInfo.BuildInfo instance GHC.Show.Show Distribution.Types.BuildInfo.BuildInfo instance GHC.Generics.Generic Distribution.Types.BuildInfo.BuildInfo instance Data.Binary.Class.Binary Distribution.Types.BuildInfo.BuildInfo instance GHC.Base.Monoid Distribution.Types.BuildInfo.BuildInfo instance Data.Semigroup.Semigroup Distribution.Types.BuildInfo.BuildInfo module Distribution.Types.TestSuite -- | A "test-suite" stanza in a cabal file. data TestSuite TestSuite :: UnqualComponentName -> TestSuiteInterface -> BuildInfo -> TestSuite [testName] :: TestSuite -> UnqualComponentName [testInterface] :: TestSuite -> TestSuiteInterface [testBuildInfo] :: TestSuite -> BuildInfo emptyTestSuite :: TestSuite testType :: TestSuite -> TestType -- | Get all the module names from a test suite. testModules :: TestSuite -> [ModuleName] -- | Get all the auto generated module names from a test suite. This are a -- subset of testModules. testModulesAutogen :: TestSuite -> [ModuleName] instance Data.Data.Data Distribution.Types.TestSuite.TestSuite instance GHC.Classes.Eq Distribution.Types.TestSuite.TestSuite instance GHC.Read.Read Distribution.Types.TestSuite.TestSuite instance GHC.Show.Show Distribution.Types.TestSuite.TestSuite instance GHC.Generics.Generic Distribution.Types.TestSuite.TestSuite instance Data.Binary.Class.Binary Distribution.Types.TestSuite.TestSuite instance GHC.Base.Monoid Distribution.Types.TestSuite.TestSuite instance Data.Semigroup.Semigroup Distribution.Types.TestSuite.TestSuite module Distribution.Types.Library data Library Library :: Maybe UnqualComponentName -> [ModuleName] -> [ModuleReexport] -> [ModuleName] -> Bool -> BuildInfo -> Library [libName] :: Library -> Maybe UnqualComponentName [exposedModules] :: Library -> [ModuleName] [reexportedModules] :: Library -> [ModuleReexport] -- | What sigs need implementations? [signatures] :: Library -> [ModuleName] -- | Is the lib to be exposed by default? [libExposed] :: Library -> Bool [libBuildInfo] :: Library -> BuildInfo emptyLibrary :: Library -- | Get all the module names from the library (exposed and internal -- modules) which are explicitly listed in the package description which -- would need to be compiled. (This does not include reexports, which do -- not need to be compiled.) This may not include all modules for which -- GHC generated interface files (i.e., implicit modules.) explicitLibModules :: Library -> [ModuleName] -- | Get all the auto generated module names from the library, exposed or -- not. This are a subset of libModules. libModulesAutogen :: Library -> [ModuleName] -- | Backwards-compatibility shim for explicitLibModules. In most -- cases, you actually want allLibModules, which returns all -- modules that will actually be compiled, as opposed to those which are -- explicitly listed in the package description -- (explicitLibModules); unfortunately, the type signature for -- allLibModules is incompatible since we need a -- ComponentLocalBuildInfo. -- | Deprecated: If you want all modules that are built with a library, -- use allLibModules. Otherwise, use explicitLibModules -- for ONLY the modules explicitly mentioned in the package -- description. libModules :: Library -> [ModuleName] instance Data.Data.Data Distribution.Types.Library.Library instance GHC.Read.Read Distribution.Types.Library.Library instance GHC.Classes.Eq Distribution.Types.Library.Library instance GHC.Show.Show Distribution.Types.Library.Library instance GHC.Generics.Generic Distribution.Types.Library.Library instance Data.Binary.Class.Binary Distribution.Types.Library.Library instance GHC.Base.Monoid Distribution.Types.Library.Library instance Data.Semigroup.Semigroup Distribution.Types.Library.Library module Distribution.Types.HookedBuildInfo -- | HookedBuildInfo is mechanism that hooks can use to override the -- BuildInfos inside packages. One example use-case (which is used -- in core libraries today) is as a way of passing flags which are -- computed by a configure script into Cabal. In this case, the autoconf -- build type adds hooks to read in a textual HookedBuildInfo -- format prior to doing any operations. -- -- Quite honestly, this mechanism is a massive hack since we shouldn't be -- editing the PackageDescription data structure (it's easy to -- assume that this data structure shouldn't change and run into bugs, -- see for example 1c20a6328579af9e37677d507e2e9836ef70ab9d). But it's a -- bit convenient, because there isn't another data structure that allows -- adding extra BuildInfo style things. -- -- In any case, a lot of care has to be taken to make sure the -- HookedBuildInfo is applied to the PackageDescription. -- In general this process occurs in Distribution.Simple, which is -- responsible for orchestrating the hooks mechanism. The general -- strategy: -- --
    --
  1. We run the pre-hook, which produces a HookedBuildInfo -- (e.g., in the Autoconf case, it reads it out from a file).
  2. --
  3. We sanity-check the hooked build info with -- sanityCheckHookedBuildInfo.
  4. --
  5. We update our PackageDescription (either freshly read or -- cached from LocalBuildInfo) with -- updatePackageDescription.
  6. --
-- -- In principle, we are also supposed to update the copy of the -- PackageDescription stored in LocalBuildInfo at -- localPkgDescr. Unfortunately, in practice, there are lots of -- Custom setup scripts which fail to update localPkgDescr so -- you really shouldn't rely on it. It's not DEPRECATED because there are -- legitimate uses for it, but... yeah. Sharp knife. See -- https://github.com/haskell/cabal/issues/3606 for more -- information on the issue. -- -- It is not well-specified whether or not a HookedBuildInfo -- applied at configure time is persistent to the -- LocalBuildInfo. The fact that HookedBuildInfo is -- passed to confHook MIGHT SUGGEST that the -- HookedBuildInfo is applied at this time, but actually since -- 9317b67e6122ab14e53f81b573bd0ecb388eca5a it has been ONLY used to -- create a modified package description that we check for problems: it -- is never actually saved to the LBI. Since HookedBuildInfo is -- applied monoidally to the existing build infos (and it is not an -- idempotent monoid), it could break things to save it, since we are -- obligated to apply any new HookedBuildInfo and then we'd get -- the effect twice. But this does mean we have to re-apply it every -- time. Hey, it's more flexibility. type HookedBuildInfo = (Maybe BuildInfo, [(UnqualComponentName, BuildInfo)]) emptyHookedBuildInfo :: HookedBuildInfo module Distribution.Types.ForeignLib -- | A foreign library stanza is like a library stanza, except that the -- built code is intended for consumption by a non-Haskell client. data ForeignLib ForeignLib :: UnqualComponentName -> ForeignLibType -> [ForeignLibOption] -> BuildInfo -> Maybe LibVersionInfo -> Maybe Version -> [FilePath] -> ForeignLib -- | Name of the foreign library [foreignLibName] :: ForeignLib -> UnqualComponentName -- | What kind of foreign library is this (static or dynamic). [foreignLibType] :: ForeignLib -> ForeignLibType -- | What options apply to this foreign library (e.g., are we merging in -- all foreign dependencies.) [foreignLibOptions] :: ForeignLib -> [ForeignLibOption] -- | Build information for this foreign library. [foreignLibBuildInfo] :: ForeignLib -> BuildInfo -- | Libtool-style version-info data to compute library version. Refer to -- the libtool documentation on the current:revision:age versioning -- scheme. [foreignLibVersionInfo] :: ForeignLib -> Maybe LibVersionInfo -- | Linux library version [foreignLibVersionLinux] :: ForeignLib -> Maybe Version -- | (Windows-specific) module definition files -- -- This is a list rather than a maybe field so that we can flatten the -- condition trees (for instance, when creating an sdist) [foreignLibModDefFile] :: ForeignLib -> [FilePath] -- | An empty foreign library. emptyForeignLib :: ForeignLib -- | Modules defined by a foreign library. foreignLibModules :: ForeignLib -> [ModuleName] -- | Is the foreign library shared? foreignLibIsShared :: ForeignLib -> Bool -- | Get a version number for a foreign library. If we're on Linux, and a -- Linux version is specified, use that. If we're on Linux, and -- libtool-style version-info is specified, translate that field into -- appropriate version numbers. Otherwise, this feature is unsupported so -- we don't return any version data. foreignLibVersion :: ForeignLib -> OS -> [Int] data LibVersionInfo -- | Construct LibVersionInfo from (current, revision, age) -- numbers. -- -- For instance, mkLibVersionInfo (3,0,0) constructs a -- LibVersionInfo representing the version-info 3:0:0. -- -- All version components must be non-negative. mkLibVersionInfo :: (Int, Int, Int) -> LibVersionInfo -- | From a given LibVersionInfo, extract the (current, -- revision, age) numbers. libVersionInfoCRA :: LibVersionInfo -> (Int, Int, Int) -- | Given a version-info field, produce a major.minor.build -- version libVersionNumber :: LibVersionInfo -> (Int, Int, Int) -- | Given a version-info field, return "major.minor.build" as a -- String libVersionNumberShow :: LibVersionInfo -> String -- | Return the major version of a version-info field. libVersionMajor :: LibVersionInfo -> Int instance Data.Data.Data Distribution.Types.ForeignLib.ForeignLib instance GHC.Classes.Eq Distribution.Types.ForeignLib.ForeignLib instance GHC.Read.Read Distribution.Types.ForeignLib.ForeignLib instance GHC.Show.Show Distribution.Types.ForeignLib.ForeignLib instance GHC.Generics.Generic Distribution.Types.ForeignLib.ForeignLib instance GHC.Generics.Generic Distribution.Types.ForeignLib.LibVersionInfo instance GHC.Classes.Eq Distribution.Types.ForeignLib.LibVersionInfo instance Data.Data.Data Distribution.Types.ForeignLib.LibVersionInfo instance Data.Binary.Class.Binary Distribution.Types.ForeignLib.ForeignLib instance Data.Semigroup.Semigroup Distribution.Types.ForeignLib.ForeignLib instance GHC.Base.Monoid Distribution.Types.ForeignLib.ForeignLib instance GHC.Classes.Ord Distribution.Types.ForeignLib.LibVersionInfo instance GHC.Show.Show Distribution.Types.ForeignLib.LibVersionInfo instance GHC.Read.Read Distribution.Types.ForeignLib.LibVersionInfo instance Data.Binary.Class.Binary Distribution.Types.ForeignLib.LibVersionInfo instance Distribution.Text.Text Distribution.Types.ForeignLib.LibVersionInfo module Distribution.Types.Executable data Executable Executable :: UnqualComponentName -> FilePath -> ExecutableScope -> BuildInfo -> Executable [exeName] :: Executable -> UnqualComponentName [modulePath] :: Executable -> FilePath [exeScope] :: Executable -> ExecutableScope [buildInfo] :: Executable -> BuildInfo emptyExecutable :: Executable -- | Get all the module names from an exe exeModules :: Executable -> [ModuleName] -- | Get all the auto generated module names from an exe This are a subset -- of exeModules. exeModulesAutogen :: Executable -> [ModuleName] instance Data.Data.Data Distribution.Types.Executable.Executable instance GHC.Classes.Eq Distribution.Types.Executable.Executable instance GHC.Read.Read Distribution.Types.Executable.Executable instance GHC.Show.Show Distribution.Types.Executable.Executable instance GHC.Generics.Generic Distribution.Types.Executable.Executable instance Data.Binary.Class.Binary Distribution.Types.Executable.Executable instance GHC.Base.Monoid Distribution.Types.Executable.Executable instance Data.Semigroup.Semigroup Distribution.Types.Executable.Executable module Distribution.Types.Benchmark -- | A "benchmark" stanza in a cabal file. data Benchmark Benchmark :: UnqualComponentName -> BenchmarkInterface -> BuildInfo -> Benchmark [benchmarkName] :: Benchmark -> UnqualComponentName [benchmarkInterface] :: Benchmark -> BenchmarkInterface [benchmarkBuildInfo] :: Benchmark -> BuildInfo emptyBenchmark :: Benchmark benchmarkType :: Benchmark -> BenchmarkType -- | Get all the module names from a benchmark. benchmarkModules :: Benchmark -> [ModuleName] -- | Get all the auto generated module names from a benchmark. This are a -- subset of benchmarkModules. benchmarkModulesAutogen :: Benchmark -> [ModuleName] instance Data.Data.Data Distribution.Types.Benchmark.Benchmark instance GHC.Classes.Eq Distribution.Types.Benchmark.Benchmark instance GHC.Read.Read Distribution.Types.Benchmark.Benchmark instance GHC.Show.Show Distribution.Types.Benchmark.Benchmark instance GHC.Generics.Generic Distribution.Types.Benchmark.Benchmark instance Data.Binary.Class.Binary Distribution.Types.Benchmark.Benchmark instance GHC.Base.Monoid Distribution.Types.Benchmark.Benchmark instance Data.Semigroup.Semigroup Distribution.Types.Benchmark.Benchmark module Distribution.Types.Component data Component CLib :: Library -> Component CFLib :: ForeignLib -> Component CExe :: Executable -> Component CTest :: TestSuite -> Component CBench :: Benchmark -> Component foldComponent :: (Library -> a) -> (ForeignLib -> a) -> (Executable -> a) -> (TestSuite -> a) -> (Benchmark -> a) -> Component -> a componentBuildInfo :: Component -> BuildInfo -- | Is a component buildable (i.e., not marked with buildable: -- False)? See also this note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components. componentBuildable :: Component -> Bool componentName :: Component -> ComponentName partitionComponents :: [Component] -> ([Library], [ForeignLib], [Executable], [TestSuite], [Benchmark]) instance GHC.Read.Read Distribution.Types.Component.Component instance GHC.Classes.Eq Distribution.Types.Component.Component instance GHC.Show.Show Distribution.Types.Component.Component instance Data.Semigroup.Semigroup Distribution.Types.Component.Component module Distribution.Types.ComponentRequestedSpec -- | Describes what components are enabled by user-interaction. See also -- this note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components. data ComponentRequestedSpec ComponentRequestedSpec :: Bool -> Bool -> ComponentRequestedSpec [testsRequested] :: ComponentRequestedSpec -> Bool [benchmarksRequested] :: ComponentRequestedSpec -> Bool OneComponentRequestedSpec :: ComponentName -> ComponentRequestedSpec -- | A reason explaining why a component is disabled. data ComponentDisabledReason DisabledComponent :: ComponentDisabledReason DisabledAllTests :: ComponentDisabledReason DisabledAllBenchmarks :: ComponentDisabledReason DisabledAllButOne :: String -> ComponentDisabledReason -- | The default set of enabled components. Historically tests and -- benchmarks are NOT enabled by default. defaultComponentRequestedSpec :: ComponentRequestedSpec -- | Is this component name enabled? See also this note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components. componentNameRequested :: ComponentRequestedSpec -> ComponentName -> Bool -- | Is this component enabled? See also this note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components. componentEnabled :: ComponentRequestedSpec -> Component -> Bool -- | Is this component disabled, and if so, why? componentDisabledReason :: ComponentRequestedSpec -> Component -> Maybe ComponentDisabledReason instance GHC.Classes.Eq Distribution.Types.ComponentRequestedSpec.ComponentRequestedSpec instance GHC.Show.Show Distribution.Types.ComponentRequestedSpec.ComponentRequestedSpec instance GHC.Read.Read Distribution.Types.ComponentRequestedSpec.ComponentRequestedSpec instance GHC.Generics.Generic Distribution.Types.ComponentRequestedSpec.ComponentRequestedSpec instance Data.Binary.Class.Binary Distribution.Types.ComponentRequestedSpec.ComponentRequestedSpec -- | This defines the data structure for the .cabal file format. -- There are several parts to this structure. It has top level info and -- then Library, Executable, TestSuite, and -- Benchmark sections each of which have associated -- BuildInfo data that's used to build the library, exe, test, or -- benchmark. To further complicate things there is both a -- PackageDescription and a GenericPackageDescription. -- This distinction relates to cabal configurations. When we initially -- read a .cabal file we get a -- GenericPackageDescription which has all the conditional -- sections. Before actually building a package we have to decide on each -- conditional. Once we've done that we get a PackageDescription. -- It was done this way initially to avoid breaking too much stuff when -- the feature was introduced. It could probably do with being -- rationalised at some point to make it simpler. module Distribution.Types.PackageDescription -- | This data type is the internal representation of the file -- pkg.cabal. It contains two kinds of information about the -- package: information which is needed for all packages, such as the -- package name and version, and information which is needed for the -- simple build system only, such as the compiler options and library -- name. data PackageDescription PackageDescription :: PackageIdentifier -> License -> [FilePath] -> String -> String -> String -> String -> [(CompilerFlavor, VersionRange)] -> String -> String -> String -> [SourceRepo] -> String -> String -> String -> [(String, String)] -> [Dependency] -> Either Version VersionRange -> Maybe BuildType -> Maybe SetupBuildInfo -> Maybe Library -> [Library] -> [Executable] -> [ForeignLib] -> [TestSuite] -> [Benchmark] -> [FilePath] -> FilePath -> [FilePath] -> [FilePath] -> [FilePath] -> PackageDescription [package] :: PackageDescription -> PackageIdentifier [license] :: PackageDescription -> License [licenseFiles] :: PackageDescription -> [FilePath] [copyright] :: PackageDescription -> String [maintainer] :: PackageDescription -> String [author] :: PackageDescription -> String [stability] :: PackageDescription -> String [testedWith] :: PackageDescription -> [(CompilerFlavor, VersionRange)] [homepage] :: PackageDescription -> String [pkgUrl] :: PackageDescription -> String [bugReports] :: PackageDescription -> String [sourceRepos] :: PackageDescription -> [SourceRepo] -- | A one-line summary of this package [synopsis] :: PackageDescription -> String -- | A more verbose description of this package [description] :: PackageDescription -> String [category] :: PackageDescription -> String -- | Custom fields starting with x-, stored in a simple assoc-list. [customFieldsPD] :: PackageDescription -> [(String, String)] -- | YOU PROBABLY DON'T WANT TO USE THIS FIELD. This field is special! -- Depending on how far along processing the PackageDescription we are, -- the contents of this field are either nonsense, or the collected -- dependencies of *all* the components in this package. buildDepends is -- initialized by finalizePD and -- flattenPackageDescription; prior to that, dependency info is -- stored in the CondTree built around a -- GenericPackageDescription. When this resolution is done, -- dependency info is written to the inner BuildInfo and this -- field. This is all horrible, and #2066 tracks progress to get rid of -- this field. [buildDepends] :: PackageDescription -> [Dependency] -- | The version of the Cabal spec that this package description uses. For -- historical reasons this is specified with a version range but only -- ranges of the form >= v make sense. We are in the process -- of transitioning to specifying just a single version, not a range. [specVersionRaw] :: PackageDescription -> Either Version VersionRange [buildType] :: PackageDescription -> Maybe BuildType [setupBuildInfo] :: PackageDescription -> Maybe SetupBuildInfo [library] :: PackageDescription -> Maybe Library [subLibraries] :: PackageDescription -> [Library] [executables] :: PackageDescription -> [Executable] [foreignLibs] :: PackageDescription -> [ForeignLib] [testSuites] :: PackageDescription -> [TestSuite] [benchmarks] :: PackageDescription -> [Benchmark] [dataFiles] :: PackageDescription -> [FilePath] [dataDir] :: PackageDescription -> FilePath [extraSrcFiles] :: PackageDescription -> [FilePath] [extraTmpFiles] :: PackageDescription -> [FilePath] [extraDocFiles] :: PackageDescription -> [FilePath] -- | The version of the Cabal spec that this package should be interpreted -- against. -- -- Historically we used a version range but we are switching to using a -- single version. Currently we accept either. This function converts -- into a single version by ignoring upper bounds in the version range. specVersion :: PackageDescription -> Version -- | The range of versions of the Cabal tools that this package is intended -- to work with. -- -- This function is deprecated and should not be used for new purposes, -- only to support old packages that rely on the old interpretation. -- | Deprecated: Use specVersion instead descCabalVersion :: PackageDescription -> VersionRange emptyPackageDescription :: PackageDescription -- | Does this package have a buildable PUBLIC library? hasPublicLib :: PackageDescription -> Bool -- | Does this package have any libraries? hasLibs :: PackageDescription -> Bool allLibraries :: PackageDescription -> [Library] -- | If the package description has a buildable library section, call the -- given function with the library build info as argument. You probably -- want withLibLBI if you have a LocalBuildInfo, see -- the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withLib :: PackageDescription -> (Library -> IO ()) -> IO () -- | does this package have any executables? hasExes :: PackageDescription -> Bool -- | Perform the action on each buildable Executable in the package -- description. You probably want withExeLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withExe :: PackageDescription -> (Executable -> IO ()) -> IO () -- | Does this package have any test suites? hasTests :: PackageDescription -> Bool -- | Perform an action on each buildable TestSuite in a package. You -- probably want withTestLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO () -- | Does this package have any benchmarks? hasBenchmarks :: PackageDescription -> Bool -- | Perform an action on each buildable Benchmark in a package. You -- probably want withBenchLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO () -- | Does this package have any foreign libraries? hasForeignLibs :: PackageDescription -> Bool -- | Perform the action on each buildable ForeignLib in the package -- description. withForeignLib :: PackageDescription -> (ForeignLib -> IO ()) -> IO () -- | The BuildInfo for the library (if there is one and it's -- buildable), and all buildable executables, test suites and benchmarks. -- Useful for gathering dependencies. allBuildInfo :: PackageDescription -> [BuildInfo] -- | Return all of the BuildInfos of enabled components, i.e., all -- of the ones that would be built if you run ./Setup build. enabledBuildInfos :: PackageDescription -> ComponentRequestedSpec -> [BuildInfo] updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription -- | All the components in the package. pkgComponents :: PackageDescription -> [Component] -- | A list of all components in the package that are buildable, i.e., were -- not marked with buildable: False. This does NOT indicate if -- we are actually going to build the component, see -- enabledComponents instead. pkgBuildableComponents :: PackageDescription -> [Component] -- | A list of all components in the package that are enabled. enabledComponents :: PackageDescription -> ComponentRequestedSpec -> [Component] lookupComponent :: PackageDescription -> ComponentName -> Maybe Component getComponent :: PackageDescription -> ComponentName -> Component instance Data.Data.Data Distribution.Types.PackageDescription.PackageDescription instance GHC.Classes.Eq Distribution.Types.PackageDescription.PackageDescription instance GHC.Read.Read Distribution.Types.PackageDescription.PackageDescription instance GHC.Show.Show Distribution.Types.PackageDescription.PackageDescription instance GHC.Generics.Generic Distribution.Types.PackageDescription.PackageDescription instance Data.Binary.Class.Binary Distribution.Types.PackageDescription.PackageDescription instance Distribution.Package.Package Distribution.Types.PackageDescription.PackageDescription module Distribution.Types.GenericPackageDescription data GenericPackageDescription GenericPackageDescription :: PackageDescription -> [Flag] -> Maybe (CondTree ConfVar [Dependency] Library) -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> GenericPackageDescription [packageDescription] :: GenericPackageDescription -> PackageDescription [genPackageFlags] :: GenericPackageDescription -> [Flag] [condLibrary] :: GenericPackageDescription -> Maybe (CondTree ConfVar [Dependency] Library) [condSubLibraries] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] [condForeignLibs] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] [condExecutables] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] [condTestSuites] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] [condBenchmarks] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -- | A flag can represent a feature to be included, or a way of linking a -- target against its dependencies, or in fact whatever you can think of. data Flag MkFlag :: FlagName -> String -> Bool -> Bool -> Flag [flagName] :: Flag -> FlagName [flagDescription] :: Flag -> String [flagDefault] :: Flag -> Bool [flagManual] :: Flag -> Bool -- | A Flag initialized with default parameters. emptyFlag :: FlagName -> Flag -- | A FlagName is the name of a user-defined configuration flag -- -- Use mkFlagName and unFlagName to convert from/to a -- String. -- -- This type is opaque since Cabal-2.0 data FlagName -- | Construct a FlagName from a String -- -- mkFlagName is the inverse to unFlagName -- -- Note: No validations are performed to ensure that the resulting -- FlagName is valid mkFlagName :: String -> FlagName -- | Convert FlagName to String unFlagName :: FlagName -> String -- | A FlagAssignment is a total or partial mapping of -- FlagNames to Bool flag values. It represents the flags -- chosen by the user or discovered during configuration. For example -- --flags=foo --flags=-bar becomes [("foo", True), ("bar", -- False)] type FlagAssignment = [(FlagName, Bool)] -- | String representation of a flag-value pair. showFlagValue :: (FlagName, Bool) -> String -- | Pretty-prints a flag assignment. dispFlagAssignment :: FlagAssignment -> Doc -- | Parses a flag assignment. parseFlagAssignment :: ReadP r FlagAssignment -- | A ConfVar represents the variable type used. data ConfVar OS :: OS -> ConfVar Arch :: Arch -> ConfVar Flag :: FlagName -> ConfVar Impl :: CompilerFlavor -> VersionRange -> ConfVar instance GHC.Generics.Generic Distribution.Types.GenericPackageDescription.GenericPackageDescription instance Data.Data.Data Distribution.Types.GenericPackageDescription.GenericPackageDescription instance GHC.Classes.Eq Distribution.Types.GenericPackageDescription.GenericPackageDescription instance GHC.Show.Show Distribution.Types.GenericPackageDescription.GenericPackageDescription instance GHC.Generics.Generic Distribution.Types.GenericPackageDescription.ConfVar instance Data.Data.Data Distribution.Types.GenericPackageDescription.ConfVar instance GHC.Show.Show Distribution.Types.GenericPackageDescription.ConfVar instance GHC.Classes.Eq Distribution.Types.GenericPackageDescription.ConfVar instance GHC.Generics.Generic Distribution.Types.GenericPackageDescription.Flag instance Data.Data.Data Distribution.Types.GenericPackageDescription.Flag instance GHC.Classes.Eq Distribution.Types.GenericPackageDescription.Flag instance GHC.Show.Show Distribution.Types.GenericPackageDescription.Flag instance Data.Data.Data Distribution.Types.GenericPackageDescription.FlagName instance GHC.Read.Read Distribution.Types.GenericPackageDescription.FlagName instance GHC.Show.Show Distribution.Types.GenericPackageDescription.FlagName instance GHC.Classes.Ord Distribution.Types.GenericPackageDescription.FlagName instance GHC.Generics.Generic Distribution.Types.GenericPackageDescription.FlagName instance GHC.Classes.Eq Distribution.Types.GenericPackageDescription.FlagName instance Distribution.Package.Package Distribution.Types.GenericPackageDescription.GenericPackageDescription instance Data.Binary.Class.Binary Distribution.Types.GenericPackageDescription.GenericPackageDescription instance Data.Binary.Class.Binary Distribution.Types.GenericPackageDescription.ConfVar instance Data.Binary.Class.Binary Distribution.Types.GenericPackageDescription.Flag instance Data.String.IsString Distribution.Types.GenericPackageDescription.FlagName instance Data.Binary.Class.Binary Distribution.Types.GenericPackageDescription.FlagName -- | Backwards compatibility reexport of everything you need to know about -- .cabal files. module Distribution.PackageDescription -- | This data type is the internal representation of the file -- pkg.cabal. It contains two kinds of information about the -- package: information which is needed for all packages, such as the -- package name and version, and information which is needed for the -- simple build system only, such as the compiler options and library -- name. data PackageDescription PackageDescription :: PackageIdentifier -> License -> [FilePath] -> String -> String -> String -> String -> [(CompilerFlavor, VersionRange)] -> String -> String -> String -> [SourceRepo] -> String -> String -> String -> [(String, String)] -> [Dependency] -> Either Version VersionRange -> Maybe BuildType -> Maybe SetupBuildInfo -> Maybe Library -> [Library] -> [Executable] -> [ForeignLib] -> [TestSuite] -> [Benchmark] -> [FilePath] -> FilePath -> [FilePath] -> [FilePath] -> [FilePath] -> PackageDescription [package] :: PackageDescription -> PackageIdentifier [license] :: PackageDescription -> License [licenseFiles] :: PackageDescription -> [FilePath] [copyright] :: PackageDescription -> String [maintainer] :: PackageDescription -> String [author] :: PackageDescription -> String [stability] :: PackageDescription -> String [testedWith] :: PackageDescription -> [(CompilerFlavor, VersionRange)] [homepage] :: PackageDescription -> String [pkgUrl] :: PackageDescription -> String [bugReports] :: PackageDescription -> String [sourceRepos] :: PackageDescription -> [SourceRepo] -- | A one-line summary of this package [synopsis] :: PackageDescription -> String -- | A more verbose description of this package [description] :: PackageDescription -> String [category] :: PackageDescription -> String -- | Custom fields starting with x-, stored in a simple assoc-list. [customFieldsPD] :: PackageDescription -> [(String, String)] -- | YOU PROBABLY DON'T WANT TO USE THIS FIELD. This field is special! -- Depending on how far along processing the PackageDescription we are, -- the contents of this field are either nonsense, or the collected -- dependencies of *all* the components in this package. buildDepends is -- initialized by finalizePD and -- flattenPackageDescription; prior to that, dependency info is -- stored in the CondTree built around a -- GenericPackageDescription. When this resolution is done, -- dependency info is written to the inner BuildInfo and this -- field. This is all horrible, and #2066 tracks progress to get rid of -- this field. [buildDepends] :: PackageDescription -> [Dependency] -- | The version of the Cabal spec that this package description uses. For -- historical reasons this is specified with a version range but only -- ranges of the form >= v make sense. We are in the process -- of transitioning to specifying just a single version, not a range. [specVersionRaw] :: PackageDescription -> Either Version VersionRange [buildType] :: PackageDescription -> Maybe BuildType [setupBuildInfo] :: PackageDescription -> Maybe SetupBuildInfo [library] :: PackageDescription -> Maybe Library [subLibraries] :: PackageDescription -> [Library] [executables] :: PackageDescription -> [Executable] [foreignLibs] :: PackageDescription -> [ForeignLib] [testSuites] :: PackageDescription -> [TestSuite] [benchmarks] :: PackageDescription -> [Benchmark] [dataFiles] :: PackageDescription -> [FilePath] [dataDir] :: PackageDescription -> FilePath [extraSrcFiles] :: PackageDescription -> [FilePath] [extraTmpFiles] :: PackageDescription -> [FilePath] [extraDocFiles] :: PackageDescription -> [FilePath] emptyPackageDescription :: PackageDescription -- | The version of the Cabal spec that this package should be interpreted -- against. -- -- Historically we used a version range but we are switching to using a -- single version. Currently we accept either. This function converts -- into a single version by ignoring upper bounds in the version range. specVersion :: PackageDescription -> Version -- | The range of versions of the Cabal tools that this package is intended -- to work with. -- -- This function is deprecated and should not be used for new purposes, -- only to support old packages that rely on the old interpretation. -- | Deprecated: Use specVersion instead descCabalVersion :: PackageDescription -> VersionRange -- | The type of build system used by this package. data BuildType -- | calls Distribution.Simple.defaultMain Simple :: BuildType -- | calls Distribution.Simple.defaultMainWithHooks -- defaultUserHooks, which invokes configure to generate -- additional build information used by later phases. Configure :: BuildType -- | calls Distribution.Make.defaultMain Make :: BuildType -- | uses user-supplied Setup.hs or Setup.lhs (default) Custom :: BuildType -- | a package that uses an unknown build type cannot actually be built. -- Doing it this way rather than just giving a parse error means we get -- better error messages and allows you to inspect the rest of the -- package description. UnknownBuildType :: String -> BuildType knownBuildTypes :: [BuildType] allLibraries :: PackageDescription -> [Library] -- | Renaming applied to the modules provided by a package. The boolean -- indicates whether or not to also include all of the original names of -- modules. Thus, ModuleRenaming False [] is "don't expose any -- modules, and ModuleRenaming True [(Data.Bool, -- Bool)] is, "expose all modules, but also expose -- Data.Bool as Bool". If a renaming is omitted you get -- the DefaultRenaming. -- -- (NB: This is a list not a map so that we can preserve order.) data ModuleRenaming -- | A module renaming/thinning; e.g., (A as B, C as C) brings -- B and C into scope. ModuleRenaming :: [(ModuleName, ModuleName)] -> ModuleRenaming -- | The default renaming, bringing all exported modules into scope. DefaultRenaming :: ModuleRenaming -- | Hiding renaming, e.g., hiding (A, B), bringing all exported -- modules into scope except the hidden ones. HidingRenaming :: [ModuleName] -> ModuleRenaming -- | The default renaming, if something is specified in -- build-depends only. defaultRenaming :: ModuleRenaming data Library Library :: Maybe UnqualComponentName -> [ModuleName] -> [ModuleReexport] -> [ModuleName] -> Bool -> BuildInfo -> Library [libName] :: Library -> Maybe UnqualComponentName [exposedModules] :: Library -> [ModuleName] [reexportedModules] :: Library -> [ModuleReexport] -- | What sigs need implementations? [signatures] :: Library -> [ModuleName] -- | Is the lib to be exposed by default? [libExposed] :: Library -> Bool [libBuildInfo] :: Library -> BuildInfo data ModuleReexport ModuleReexport :: Maybe PackageName -> ModuleName -> ModuleName -> ModuleReexport [moduleReexportOriginalPackage] :: ModuleReexport -> Maybe PackageName [moduleReexportOriginalName] :: ModuleReexport -> ModuleName [moduleReexportName] :: ModuleReexport -> ModuleName emptyLibrary :: Library -- | If the package description has a buildable library section, call the -- given function with the library build info as argument. You probably -- want withLibLBI if you have a LocalBuildInfo, see -- the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withLib :: PackageDescription -> (Library -> IO ()) -> IO () -- | Does this package have a buildable PUBLIC library? hasPublicLib :: PackageDescription -> Bool -- | Does this package have any libraries? hasLibs :: PackageDescription -> Bool -- | Get all the module names from the library (exposed and internal -- modules) which are explicitly listed in the package description which -- would need to be compiled. (This does not include reexports, which do -- not need to be compiled.) This may not include all modules for which -- GHC generated interface files (i.e., implicit modules.) explicitLibModules :: Library -> [ModuleName] -- | Get all the auto generated module names from the library, exposed or -- not. This are a subset of libModules. libModulesAutogen :: Library -> [ModuleName] -- | Backwards-compatibility shim for explicitLibModules. In most -- cases, you actually want allLibModules, which returns all -- modules that will actually be compiled, as opposed to those which are -- explicitly listed in the package description -- (explicitLibModules); unfortunately, the type signature for -- allLibModules is incompatible since we need a -- ComponentLocalBuildInfo. -- | Deprecated: If you want all modules that are built with a library, -- use allLibModules. Otherwise, use explicitLibModules -- for ONLY the modules explicitly mentioned in the package -- description. libModules :: Library -> [ModuleName] data Executable Executable :: UnqualComponentName -> FilePath -> ExecutableScope -> BuildInfo -> Executable [exeName] :: Executable -> UnqualComponentName [modulePath] :: Executable -> FilePath [exeScope] :: Executable -> ExecutableScope [buildInfo] :: Executable -> BuildInfo emptyExecutable :: Executable -- | Perform the action on each buildable Executable in the package -- description. You probably want withExeLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withExe :: PackageDescription -> (Executable -> IO ()) -> IO () -- | does this package have any executables? hasExes :: PackageDescription -> Bool -- | Get all the module names from an exe exeModules :: Executable -> [ModuleName] -- | Get all the auto generated module names from an exe This are a subset -- of exeModules. exeModulesAutogen :: Executable -> [ModuleName] -- | A "test-suite" stanza in a cabal file. data TestSuite TestSuite :: UnqualComponentName -> TestSuiteInterface -> BuildInfo -> TestSuite [testName] :: TestSuite -> UnqualComponentName [testInterface] :: TestSuite -> TestSuiteInterface [testBuildInfo] :: TestSuite -> BuildInfo -- | The test suite interfaces that are currently defined. Each test suite -- must specify which interface it supports. -- -- More interfaces may be defined in future, either new revisions or -- totally new interfaces. data TestSuiteInterface -- | Test interface "exitcode-stdio-1.0". The test-suite takes the form of -- an executable. It returns a zero exit code for success, non-zero for -- failure. The stdout and stderr channels may be logged. It takes no -- command line parameters and nothing on stdin. TestSuiteExeV10 :: Version -> FilePath -> TestSuiteInterface -- | Test interface "detailed-0.9". The test-suite takes the form of a -- library containing a designated module that exports "tests :: [Test]". TestSuiteLibV09 :: Version -> ModuleName -> TestSuiteInterface -- | A test suite that does not conform to one of the above interfaces for -- the given reason (e.g. unknown test type). TestSuiteUnsupported :: TestType -> TestSuiteInterface -- | The "test-type" field in the test suite stanza. data TestType -- | "type: exitcode-stdio-x.y" TestTypeExe :: Version -> TestType -- | "type: detailed-x.y" TestTypeLib :: Version -> TestType -- | Some unknown test type e.g. "type: foo" TestTypeUnknown :: String -> Version -> TestType testType :: TestSuite -> TestType knownTestTypes :: [TestType] emptyTestSuite :: TestSuite -- | Does this package have any test suites? hasTests :: PackageDescription -> Bool -- | Perform an action on each buildable TestSuite in a package. You -- probably want withTestLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO () -- | Get all the module names from a test suite. testModules :: TestSuite -> [ModuleName] -- | Get all the auto generated module names from a test suite. This are a -- subset of testModules. testModulesAutogen :: TestSuite -> [ModuleName] -- | A "benchmark" stanza in a cabal file. data Benchmark Benchmark :: UnqualComponentName -> BenchmarkInterface -> BuildInfo -> Benchmark [benchmarkName] :: Benchmark -> UnqualComponentName [benchmarkInterface] :: Benchmark -> BenchmarkInterface [benchmarkBuildInfo] :: Benchmark -> BuildInfo -- | The benchmark interfaces that are currently defined. Each benchmark -- must specify which interface it supports. -- -- More interfaces may be defined in future, either new revisions or -- totally new interfaces. data BenchmarkInterface -- | Benchmark interface "exitcode-stdio-1.0". The benchmark takes the form -- of an executable. It returns a zero exit code for success, non-zero -- for failure. The stdout and stderr channels may be logged. It takes no -- command line parameters and nothing on stdin. BenchmarkExeV10 :: Version -> FilePath -> BenchmarkInterface -- | A benchmark that does not conform to one of the above interfaces for -- the given reason (e.g. unknown benchmark type). BenchmarkUnsupported :: BenchmarkType -> BenchmarkInterface -- | The "benchmark-type" field in the benchmark stanza. data BenchmarkType -- | "type: exitcode-stdio-x.y" BenchmarkTypeExe :: Version -> BenchmarkType -- | Some unknown benchmark type e.g. "type: foo" BenchmarkTypeUnknown :: String -> Version -> BenchmarkType benchmarkType :: Benchmark -> BenchmarkType knownBenchmarkTypes :: [BenchmarkType] emptyBenchmark :: Benchmark -- | Does this package have any benchmarks? hasBenchmarks :: PackageDescription -> Bool -- | Perform an action on each buildable Benchmark in a package. You -- probably want withBenchLBI if you have a -- LocalBuildInfo, see the note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components -- for more information. withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO () -- | Get all the module names from a benchmark. benchmarkModules :: Benchmark -> [ModuleName] -- | Get all the auto generated module names from a benchmark. This are a -- subset of benchmarkModules. benchmarkModulesAutogen :: Benchmark -> [ModuleName] data BuildInfo BuildInfo :: Bool -> [LegacyExeDependency] -> [ExeDependency] -> [String] -> [String] -> [String] -> [PkgconfigDependency] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [ModuleName] -> [ModuleName] -> Maybe Language -> [Language] -> [Extension] -> [Extension] -> [Extension] -> [String] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])] -> [(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo -- | component is buildable here | Tools needed to build this bit. -- -- This is a legacy field that "build-tool-depends" larely supersedes. -- -- Unless use are very sure what you are doing, use the functions in -- BuildToolDepends rather than accessing this field directly. [buildable] :: BuildInfo -> Bool [buildTools] :: BuildInfo -> [LegacyExeDependency] -- | Haskell tools needed to build this bit -- -- This field is better than "build-tools" because it allows one to -- precisely specify an executable in a package. -- -- Unless use are very sure what you are doing, use the functions in -- BuildToolDepends rather than accessing this field directly. [buildToolDepends] :: BuildInfo -> [ExeDependency] -- | options for pre-processing Haskell code [cppOptions] :: BuildInfo -> [String] -- | options for C compiler [ccOptions] :: BuildInfo -> [String] -- | options for linker [ldOptions] :: BuildInfo -> [String] -- | pkg-config packages that are used [pkgconfigDepends] :: BuildInfo -> [PkgconfigDependency] -- | support frameworks for Mac OS X [frameworks] :: BuildInfo -> [String] -- | extra locations to find frameworks. [extraFrameworkDirs] :: BuildInfo -> [String] [cSources] :: BuildInfo -> [FilePath] [jsSources] :: BuildInfo -> [FilePath] -- | where to look for the Haskell module hierarchy [hsSourceDirs] :: BuildInfo -> [FilePath] -- | non-exposed or non-main modules [otherModules] :: BuildInfo -> [ModuleName] -- | not present on sdist, Paths_* or user-generated with a custom Setup.hs [autogenModules] :: BuildInfo -> [ModuleName] -- | language used when not explicitly specified [defaultLanguage] :: BuildInfo -> Maybe Language -- | other languages used within the package [otherLanguages] :: BuildInfo -> [Language] -- | language extensions used by all modules [defaultExtensions] :: BuildInfo -> [Extension] -- | other language extensions used within the package [otherExtensions] :: BuildInfo -> [Extension] -- | the old extensions field, treated same as defaultExtensions [oldExtensions] :: BuildInfo -> [Extension] -- | what libraries to link with when compiling a program that uses your -- package [extraLibs] :: BuildInfo -> [String] -- | if present, overrides extraLibs when package is loaded with GHCi. [extraGHCiLibs] :: BuildInfo -> [String] [extraLibDirs] :: BuildInfo -> [String] -- | directories to find .h files [includeDirs] :: BuildInfo -> [FilePath] -- | The .h files to be found in includeDirs [includes] :: BuildInfo -> [FilePath] -- | .h files to install with the package [installIncludes] :: BuildInfo -> [FilePath] [options] :: BuildInfo -> [(CompilerFlavor, [String])] [profOptions] :: BuildInfo -> [(CompilerFlavor, [String])] [sharedOptions] :: BuildInfo -> [(CompilerFlavor, [String])] -- | Custom fields starting with x-, stored in a simple assoc-list. [customFieldsBI] :: BuildInfo -> [(String, String)] -- | Dependencies specific to a library or executable target [targetBuildDepends] :: BuildInfo -> [Dependency] [mixins] :: BuildInfo -> [Mixin] emptyBuildInfo :: BuildInfo -- | The BuildInfo for the library (if there is one and it's -- buildable), and all buildable executables, test suites and benchmarks. -- Useful for gathering dependencies. allBuildInfo :: PackageDescription -> [BuildInfo] -- | The Languages used by this component allLanguages :: BuildInfo -> [Language] -- | The Extensions that are used somewhere by this component allExtensions :: BuildInfo -> [Extension] -- | The Extensions that are used by all modules in this component usedExtensions :: BuildInfo -> [Extension] -- | Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> BuildInfo -> [String] hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] hcSharedOptions :: CompilerFlavor -> BuildInfo -> [String] data ComponentName CLibName :: ComponentName CSubLibName :: UnqualComponentName -> ComponentName CFLibName :: UnqualComponentName -> ComponentName CExeName :: UnqualComponentName -> ComponentName CTestName :: UnqualComponentName -> ComponentName CBenchName :: UnqualComponentName -> ComponentName defaultLibName :: ComponentName -- | HookedBuildInfo is mechanism that hooks can use to override the -- BuildInfos inside packages. One example use-case (which is used -- in core libraries today) is as a way of passing flags which are -- computed by a configure script into Cabal. In this case, the autoconf -- build type adds hooks to read in a textual HookedBuildInfo -- format prior to doing any operations. -- -- Quite honestly, this mechanism is a massive hack since we shouldn't be -- editing the PackageDescription data structure (it's easy to -- assume that this data structure shouldn't change and run into bugs, -- see for example 1c20a6328579af9e37677d507e2e9836ef70ab9d). But it's a -- bit convenient, because there isn't another data structure that allows -- adding extra BuildInfo style things. -- -- In any case, a lot of care has to be taken to make sure the -- HookedBuildInfo is applied to the PackageDescription. -- In general this process occurs in Distribution.Simple, which is -- responsible for orchestrating the hooks mechanism. The general -- strategy: -- --
    --
  1. We run the pre-hook, which produces a HookedBuildInfo -- (e.g., in the Autoconf case, it reads it out from a file).
  2. --
  3. We sanity-check the hooked build info with -- sanityCheckHookedBuildInfo.
  4. --
  5. We update our PackageDescription (either freshly read or -- cached from LocalBuildInfo) with -- updatePackageDescription.
  6. --
-- -- In principle, we are also supposed to update the copy of the -- PackageDescription stored in LocalBuildInfo at -- localPkgDescr. Unfortunately, in practice, there are lots of -- Custom setup scripts which fail to update localPkgDescr so -- you really shouldn't rely on it. It's not DEPRECATED because there are -- legitimate uses for it, but... yeah. Sharp knife. See -- https://github.com/haskell/cabal/issues/3606 for more -- information on the issue. -- -- It is not well-specified whether or not a HookedBuildInfo -- applied at configure time is persistent to the -- LocalBuildInfo. The fact that HookedBuildInfo is -- passed to confHook MIGHT SUGGEST that the -- HookedBuildInfo is applied at this time, but actually since -- 9317b67e6122ab14e53f81b573bd0ecb388eca5a it has been ONLY used to -- create a modified package description that we check for problems: it -- is never actually saved to the LBI. Since HookedBuildInfo is -- applied monoidally to the existing build infos (and it is not an -- idempotent monoid), it could break things to save it, since we are -- obligated to apply any new HookedBuildInfo and then we'd get -- the effect twice. But this does mean we have to re-apply it every -- time. Hey, it's more flexibility. type HookedBuildInfo = (Maybe BuildInfo, [(UnqualComponentName, BuildInfo)]) emptyHookedBuildInfo :: HookedBuildInfo updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription data GenericPackageDescription GenericPackageDescription :: PackageDescription -> [Flag] -> Maybe (CondTree ConfVar [Dependency] Library) -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> GenericPackageDescription [packageDescription] :: GenericPackageDescription -> PackageDescription [genPackageFlags] :: GenericPackageDescription -> [Flag] [condLibrary] :: GenericPackageDescription -> Maybe (CondTree ConfVar [Dependency] Library) [condSubLibraries] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] [condForeignLibs] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] [condExecutables] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] [condTestSuites] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] [condBenchmarks] :: GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -- | A flag can represent a feature to be included, or a way of linking a -- target against its dependencies, or in fact whatever you can think of. data Flag MkFlag :: FlagName -> String -> Bool -> Bool -> Flag [flagName] :: Flag -> FlagName [flagDescription] :: Flag -> String [flagDefault] :: Flag -> Bool [flagManual] :: Flag -> Bool -- | A Flag initialized with default parameters. emptyFlag :: FlagName -> Flag -- | A FlagName is the name of a user-defined configuration flag -- -- Use mkFlagName and unFlagName to convert from/to a -- String. -- -- This type is opaque since Cabal-2.0 data FlagName -- | Construct a FlagName from a String -- -- mkFlagName is the inverse to unFlagName -- -- Note: No validations are performed to ensure that the resulting -- FlagName is valid mkFlagName :: String -> FlagName -- | Convert FlagName to String unFlagName :: FlagName -> String -- | A FlagAssignment is a total or partial mapping of -- FlagNames to Bool flag values. It represents the flags -- chosen by the user or discovered during configuration. For example -- --flags=foo --flags=-bar becomes [("foo", True), ("bar", -- False)] type FlagAssignment = [(FlagName, Bool)] -- | String representation of a flag-value pair. showFlagValue :: (FlagName, Bool) -> String -- | Pretty-prints a flag assignment. dispFlagAssignment :: FlagAssignment -> Doc -- | Parses a flag assignment. parseFlagAssignment :: ReadP r FlagAssignment -- | A CondTree is used to represent the conditional structure of a -- Cabal file, reflecting a syntax element subject to constraints, and -- then any number of sub-elements which may be enabled subject to some -- condition. Both a and c are usually Monoids. -- -- To be more concrete, consider the following fragment of a -- Cabal file: -- --
--   build-depends: base >= 4.0
--   if flag(extra)
--       build-depends: base >= 4.2
--   
-- -- One way to represent this is to have CondTree -- ConfVar [Dependency] BuildInfo. Here, -- condTreeData represents the actual fields which are not behind -- any conditional, while condTreeComponents recursively records -- any further fields which are behind a conditional. -- condTreeConstraints records the constraints (in this case, -- base >= 4.0) which would be applied if you use this -- syntax; in general, this is derived off of targetBuildInfo -- (perhaps a good refactoring would be to convert this into an opaque -- type, with a smart constructor that pre-computes the dependencies.) data CondTree v c a CondNode :: a -> c -> [CondBranch v c a] -> CondTree v c a [condTreeData] :: CondTree v c a -> a [condTreeConstraints] :: CondTree v c a -> c [condTreeComponents] :: CondTree v c a -> [CondBranch v c a] -- | A ConfVar represents the variable type used. data ConfVar OS :: OS -> ConfVar Arch :: Arch -> ConfVar Flag :: FlagName -> ConfVar Impl :: CompilerFlavor -> VersionRange -> ConfVar -- | A boolean expression parameterized over the variable type used. data Condition c Var :: c -> Condition c Lit :: Bool -> Condition c CNot :: (Condition c) -> Condition c COr :: (Condition c) -> (Condition c) -> Condition c CAnd :: (Condition c) -> (Condition c) -> Condition c -- | Boolean negation of a Condition value. cNot :: Condition a -> Condition a -- | Boolean AND of two Condtion values. cAnd :: Condition a -> Condition a -> Condition a -- | Boolean OR of two Condition values. cOr :: Eq v => Condition v -> Condition v -> Condition v -- | Information about the source revision control system for a package. -- -- When specifying a repo it is useful to know the meaning or intention -- of the information as doing so enables automation. There are two -- obvious common purposes: one is to find the repo for the latest -- development version, the other is to find the repo for this specific -- release. The ReopKind specifies which one we mean (or another -- custom one). -- -- A package can specify one or the other kind or both. Most will specify -- just a head repo but some may want to specify a repo to reconstruct -- the sources for this package release. -- -- The required information is the RepoType which tells us if it's -- using Darcs, Git for example. The repoLocation -- and other details are interpreted according to the repo type. data SourceRepo SourceRepo :: RepoKind -> Maybe RepoType -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe FilePath -> SourceRepo -- | The kind of repo. This field is required. [repoKind] :: SourceRepo -> RepoKind -- | The type of the source repository system for this repo, eg -- Darcs or Git. This field is required. [repoType] :: SourceRepo -> Maybe RepoType -- | The location of the repository. For most RepoTypes this is a -- URL. This field is required. [repoLocation] :: SourceRepo -> Maybe String -- | CVS can put multiple "modules" on one server and requires a -- module name in addition to the location to identify a particular repo. -- Logically this is part of the location but unfortunately has to be -- specified separately. This field is required for the CVS -- RepoType and should not be given otherwise. [repoModule] :: SourceRepo -> Maybe String -- | The name or identifier of the branch, if any. Many source control -- systems have the notion of multiple branches in a repo that exist in -- the same location. For example Git and CVS use this -- while systems like Darcs use different locations for different -- branches. This field is optional but should be used if necessary to -- identify the sources, especially for the RepoThis repo kind. [repoBranch] :: SourceRepo -> Maybe String -- | The tag identify a particular state of the repository. This should be -- given for the RepoThis repo kind and not for RepoHead -- kind. [repoTag] :: SourceRepo -> Maybe String -- | Some repositories contain multiple projects in different -- subdirectories This field specifies the subdirectory where this -- packages sources can be found, eg the subdirectory containing the -- .cabal file. It is interpreted relative to the root of the -- repository. This field is optional. If not given the default is "." ie -- no subdirectory. [repoSubdir] :: SourceRepo -> Maybe FilePath -- | What this repo info is for, what it represents. data RepoKind -- | The repository for the "head" or development version of the project. -- This repo is where we should track the latest development activity or -- the usual repo people should get to contribute patches. RepoHead :: RepoKind -- | The repository containing the sources for this exact package version -- or release. For this kind of repo a tag should be given to give enough -- information to re-create the exact sources. RepoThis :: RepoKind RepoKindUnknown :: String -> RepoKind -- | An enumeration of common source control systems. The fields used in -- the SourceRepo depend on the type of repo. The tools and -- methods used to obtain and track the repo depend on the repo type. data RepoType Darcs :: RepoType Git :: RepoType SVN :: RepoType CVS :: RepoType Mercurial :: RepoType GnuArch :: RepoType Bazaar :: RepoType Monotone :: RepoType OtherRepoType :: String -> RepoType knownRepoTypes :: [RepoType] emptySourceRepo :: RepoKind -> SourceRepo data SetupBuildInfo SetupBuildInfo :: [Dependency] -> Bool -> SetupBuildInfo [setupDepends] :: SetupBuildInfo -> [Dependency] -- | Is this a default 'custom-setup' section added by the cabal-install -- code (as opposed to user-provided)? This field is only used -- internally, and doesn't correspond to anything in the .cabal file. See -- #3199. [defaultSetupDepends] :: SetupBuildInfo -> Bool -- | 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 -- | Desugar a "build-tools" entry into proper a executable dependency if -- possible. -- -- An entry can be so desguared in two cases: -- --
    --
  1. The name in build-tools matches a locally defined executable. The -- executable dependency produced is on that exe in the current -- package.
  2. --
  3. 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.
  4. --
-- -- 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] -- | This is the information about an installed package that is -- communicated to the ghc-pkg program in order to register a -- package. ghc-pkg now consumes this package format (as of -- version 6.4). This is specific to GHC at the moment. -- -- The .cabal file format is for describing a package that is -- not yet installed. It has a lot of flexibility, like conditionals and -- dependency ranges. As such, that format is not at all suitable for -- describing a package that has already been built and installed. By the -- time we get to that stage, we have resolved all conditionals and -- resolved dependency version constraints to exact versions of dependent -- packages. So, this module defines the InstalledPackageInfo data -- structure that contains all the info we keep about an installed -- package. There is a parser and pretty printer. The textual format is -- rather simpler than the .cabal format: there are no sections, -- for example. module Distribution.InstalledPackageInfo data InstalledPackageInfo InstalledPackageInfo :: PackageId -> UnitId -> ComponentId -> [(ModuleName, OpenModule)] -> Maybe UnqualComponentName -> String -> License -> String -> String -> String -> String -> String -> String -> String -> String -> String -> AbiHash -> Bool -> Bool -> [ExposedModule] -> [ModuleName] -> Bool -> [FilePath] -> [FilePath] -> [FilePath] -> FilePath -> [String] -> [String] -> [String] -> [FilePath] -> [String] -> [UnitId] -> [AbiDependency] -> [String] -> [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> Maybe FilePath -> InstalledPackageInfo [sourcePackageId] :: InstalledPackageInfo -> PackageId [installedUnitId] :: InstalledPackageInfo -> UnitId [installedComponentId_] :: InstalledPackageInfo -> ComponentId [instantiatedWith] :: InstalledPackageInfo -> [(ModuleName, OpenModule)] [sourceLibName] :: InstalledPackageInfo -> Maybe UnqualComponentName [compatPackageKey] :: InstalledPackageInfo -> String [license] :: InstalledPackageInfo -> License [copyright] :: InstalledPackageInfo -> String [maintainer] :: InstalledPackageInfo -> String [author] :: InstalledPackageInfo -> String [stability] :: InstalledPackageInfo -> String [homepage] :: InstalledPackageInfo -> String [pkgUrl] :: InstalledPackageInfo -> String [synopsis] :: InstalledPackageInfo -> String [description] :: InstalledPackageInfo -> String [category] :: InstalledPackageInfo -> String [abiHash] :: InstalledPackageInfo -> AbiHash [indefinite] :: InstalledPackageInfo -> Bool [exposed] :: InstalledPackageInfo -> Bool [exposedModules] :: InstalledPackageInfo -> [ExposedModule] [hiddenModules] :: InstalledPackageInfo -> [ModuleName] [trusted] :: InstalledPackageInfo -> Bool [importDirs] :: InstalledPackageInfo -> [FilePath] [libraryDirs] :: InstalledPackageInfo -> [FilePath] -- | overrides libraryDirs [libraryDynDirs] :: InstalledPackageInfo -> [FilePath] [dataDir] :: InstalledPackageInfo -> FilePath [hsLibraries] :: InstalledPackageInfo -> [String] [extraLibraries] :: InstalledPackageInfo -> [String] [extraGHCiLibraries] :: InstalledPackageInfo -> [String] [includeDirs] :: InstalledPackageInfo -> [FilePath] [includes] :: InstalledPackageInfo -> [String] [depends] :: InstalledPackageInfo -> [UnitId] [abiDepends] :: InstalledPackageInfo -> [AbiDependency] [ccOptions] :: InstalledPackageInfo -> [String] [ldOptions] :: InstalledPackageInfo -> [String] [frameworkDirs] :: InstalledPackageInfo -> [FilePath] [frameworks] :: InstalledPackageInfo -> [String] [haddockInterfaces] :: InstalledPackageInfo -> [FilePath] [haddockHTMLs] :: InstalledPackageInfo -> [FilePath] [pkgRoot] :: InstalledPackageInfo -> Maybe FilePath -- | Backwards compatibility with Cabal pre-1.24. -- -- This type synonym is slightly awful because in cabal-install we define -- an InstalledPackageId but it's a ComponentId, not a UnitId! -- | Deprecated: Use installedUnitId instead installedPackageId :: InstalledPackageInfo -> UnitId installedComponentId :: InstalledPackageInfo -> ComponentId -- | Get the indefinite unit identity representing this package. This IS -- NOT guaranteed to give you a substitution; for instantiated packages -- you will get DefiniteUnitId (installedUnitId ipi). For -- indefinite libraries, however, you will correctly get an -- OpenUnitId with the appropriate OpenModuleSubst. installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId sourceComponentName :: InstalledPackageInfo -> ComponentName -- | Returns the set of module names which need to be filled for an -- indefinite package, or the empty set if the package is definite. requiredSignatures :: InstalledPackageInfo -> Set ModuleName data ExposedModule ExposedModule :: ModuleName -> Maybe OpenModule -> ExposedModule [exposedName] :: ExposedModule -> ModuleName [exposedReexport] :: ExposedModule -> Maybe OpenModule -- | An ABI dependency is a dependency on a library which also records the -- ABI hash (abiHash) of the library it depends on. -- -- The primary utility of this is to enable an extra sanity when GHC -- loads libraries: it can check if the dependency has a matching ABI and -- if not, refuse to load this library. This information is critical if -- we are shadowing libraries; differences in the ABI hash let us know -- what packages get shadowed by the new version of a package. data AbiDependency AbiDependency :: UnitId -> AbiHash -> AbiDependency [depUnitId] :: AbiDependency -> UnitId [depAbiHash] :: AbiDependency -> AbiHash data ParseResult a ParseFailed :: PError -> ParseResult a ParseOk :: [PWarning] -> a -> ParseResult a data PError AmbiguousParse :: String -> LineNo -> PError NoParse :: String -> LineNo -> PError TabsError :: LineNo -> PError FromString :: String -> (Maybe LineNo) -> PError data PWarning emptyInstalledPackageInfo :: InstalledPackageInfo parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo showInstalledPackageInfo :: InstalledPackageInfo -> String showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo] instance GHC.Show.Show Distribution.InstalledPackageInfo.InstalledPackageInfo instance GHC.Read.Read Distribution.InstalledPackageInfo.InstalledPackageInfo instance GHC.Generics.Generic Distribution.InstalledPackageInfo.InstalledPackageInfo instance GHC.Classes.Eq Distribution.InstalledPackageInfo.InstalledPackageInfo instance GHC.Show.Show Distribution.InstalledPackageInfo.AbiDependency instance GHC.Read.Read Distribution.InstalledPackageInfo.AbiDependency instance GHC.Generics.Generic Distribution.InstalledPackageInfo.AbiDependency instance GHC.Classes.Eq Distribution.InstalledPackageInfo.AbiDependency instance GHC.Show.Show Distribution.InstalledPackageInfo.ExposedModule instance GHC.Read.Read Distribution.InstalledPackageInfo.ExposedModule instance GHC.Generics.Generic Distribution.InstalledPackageInfo.ExposedModule instance GHC.Classes.Eq Distribution.InstalledPackageInfo.ExposedModule instance Data.Binary.Class.Binary Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.HasMungedPackageId Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.Package Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.HasUnitId Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.PackageInstalled Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Compat.Graph.IsNode Distribution.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Text.Text Distribution.InstalledPackageInfo.AbiDependency instance Data.Binary.Class.Binary Distribution.InstalledPackageInfo.AbiDependency instance Distribution.Text.Text Distribution.InstalledPackageInfo.ExposedModule instance Data.Binary.Class.Binary Distribution.InstalledPackageInfo.ExposedModule 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.Compat.Graph.IsNode Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo 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 Distribution.Compat.Graph.IsNode Distribution.Types.TargetInfo.TargetInfo -- | 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.Backpack.ModSubst.ModSubst Distribution.Backpack.ModuleShape.ModuleShape -- | 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 -- | Deprecated: Messages thrown with die can't be controlled with -- Verbosity; use die' instead, or dieNoVerbosity if Verbosity truly is -- not available die :: String -> IO a -- | Deprecated: Messages thrown with dieWithLocation can't be -- controlled with Verbosity; use dieWithLocation' instead dieWithLocation :: FilePath -> Maybe Int -> String -> IO a dieNoVerbosity :: String -> IO a die' :: Verbosity -> String -> 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 () -- | 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 printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO () printRawCommandAndArgsAndEnv :: Verbosity -> FilePath -> [String] -> Maybe [(String, String)] -> IO () -- | Run an IO computation, returning e if it raises a "file does -- not exist" error. handleDoesNotExist :: a -> NoCallStackIO a -> NoCallStackIO a rawSystemExit :: Verbosity -> FilePath -> [String] -> IO () rawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode rawSystemExitWithEnv :: Verbosity -> FilePath -> [String] -> [(String, String)] -> IO () -- | Run a command and return its output. -- -- The output is assumed to be text in the locale encoding. rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO String -- | Run a command and return its output, errors and exit status. -- Optionally also supply some input. Also provides control over whether -- the binary/text mode of the input and output. rawSystemStdInOut :: Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> Maybe (String, Bool) -> Bool -> IO (String, String, ExitCode) rawSystemIOWithEnv :: Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> Maybe Handle -> Maybe Handle -> Maybe Handle -> IO ExitCode createProcessWithEnv :: Verbosity -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> StdStream -> StdStream -> StdStream -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) 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 on the path. -- | Deprecated: No longer used within Cabal, try -- findProgramOnSearchPath findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath) -- | 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) -- | Deprecated: Use findModuleFiles and copyFiles or -- installOrdinaryFiles smartCopySources :: Verbosity -> [FilePath] -> FilePath -> [ModuleName] -> [String] -> IO () -- | 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 () -- | Deprecated: You probably want installDirectoryContents instead copyDirectoryRecursiveVerbose :: 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 () -- | 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 -> NoCallStackIO Bool setFileOrdinary :: FilePath -> NoCallStackIO () setFileExecutable :: FilePath -> NoCallStackIO () -- | The path name that represents the current directory. In Unix, it's -- ".", but this is system-specific. (E.g. AmigaOS uses the -- empty string "" for the current directory.) currentDir :: FilePath 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 platform. exeExtensions :: [String] -- | Find a file by looking in a search path. The file path must match -- exactly. findFile :: [FilePath] -> FilePath -> IO FilePath findFirstFile :: (a -> FilePath) -> [a] -> NoCallStackIO (Maybe a) -- | 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 :: [String] -> [FilePath] -> FilePath -> NoCallStackIO (Maybe FilePath) -- | 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' :: [String] -> [FilePath] -> FilePath -> NoCallStackIO (Maybe (FilePath, FilePath)) findAllFilesWithExtension :: [String] -> [FilePath] -> FilePath -> NoCallStackIO [FilePath] -- | 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. findModuleFile :: [FilePath] -> [String] -> ModuleName -> IO (FilePath, FilePath) -- | Finds the files corresponding to a list of Haskell module names. -- -- As findModuleFile but for a list of module names. findModuleFiles :: [FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)] -- | 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 -> NoCallStackIO Bool addLibraryPath :: OS -> [FilePath] -> [(String, String)] -> [(String, String)] matchFileGlob :: FilePath -> IO [FilePath] matchDirFileGlob :: FilePath -> FilePath -> IO [FilePath] parseFileGlob :: FilePath -> Maybe FileGlob data FileGlob -- | No glob at all, just an ordinary file NoGlob :: FilePath -> FileGlob -- | dir prefix and extension, like "foo/bar/*.baz" corresponds to -- FileGlob "foo/bar" ".baz" FileGlob :: FilePath -> String -> FileGlob -- | 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 -> NoCallStackIO Bool -- | Like moreRecentFile, but also checks that the first file -- exists. existsAndIsMoreRecentThan :: FilePath -> FilePath -> NoCallStackIO 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 -- | A version of withTempFile that additionally takes a -- TempFileOptions argument. withTempFileEx :: TempFileOptions -> FilePath -> String -> (FilePath -> 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 -- | A version of withTempDirectory that additionally takes a -- TempFileOptions argument. withTempDirectoryEx :: Verbosity -> TempFileOptions -> FilePath -> String -> (FilePath -> IO a) -> IO a -- | Package description file (pkgname.cabal) defaultPackageDesc :: Verbosity -> IO FilePath -- | Find a package description file in the given directory. Looks for -- .cabal files. findPackageDesc :: FilePath -> NoCallStackIO (Either String FilePath) -- | Like findPackageDesc, but calls die in case of error. tryFindPackageDesc :: FilePath -> IO FilePath -- | Optional auxiliary package information file -- (pkgname.buildinfo) defaultHookedPackageDesc :: IO (Maybe FilePath) -- | Find auxiliary package information in the given directory. Looks for -- .buildinfo files. findHookedPackageDesc :: FilePath -> IO (Maybe FilePath) -- | Gets the contents of a file, but guarantee that it gets closed. -- -- The file is read lazily but if it is not fully consumed by the action -- then the remaining input is truncated and the file is closed. withFileContents :: FilePath -> (String -> NoCallStackIO a) -> NoCallStackIO a -- | Writes a file atomically. -- -- The file is either written successfully or an IO exception is raised -- and the original file is left unchanged. -- -- On windows it is not possible to delete a file that is open by a -- process. This case will give an IO exception but the atomic property -- is not affected. writeFileAtomic :: FilePath -> ByteString -> NoCallStackIO () -- | See rewriteFileEx -- -- This function is provided for backwards-compatibility rewriteFile :: FilePath -> String -> 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: the file is assumed to be ASCII-encoded. rewriteFileEx :: Verbosity -> FilePath -> String -> IO () fromUTF8 :: String -> String fromUTF8BS :: ByteString -> String fromUTF8LBS :: ByteString -> String toUTF8 :: String -> String -- | Reads a UTF8 encoded text file as a Unicode String -- -- Reads lazily using ordinary readFile. readUTF8File :: FilePath -> NoCallStackIO String -- | Reads a UTF8 encoded text file as a Unicode String -- -- Same behaviour as withFileContents. withUTF8FileContents :: FilePath -> (String -> IO a) -> IO a -- | Writes a Unicode String as a UTF8 encoded text file. -- -- Uses writeFileAtomic, so provides the same guarantees. writeUTF8File :: FilePath -> String -> NoCallStackIO () -- | Fix different systems silly line ending conventions normaliseLineEndings :: String -> String -- | Whether BOM is at the beginning of the input startsWithBOM :: String -> Bool -- | Check whether a file has Unicode byte order mark (BOM). fileHasBOM :: FilePath -> NoCallStackIO Bool -- | Ignore a Unicode byte order mark (BOM) at the beginning of the input ignoreBOM :: String -> String -- | dropWhileEndLE p is equivalent to reverse . dropWhile p . -- reverse, but quite a bit faster. The difference between -- "Data.List.dropWhileEnd" and this version is that the one in -- Data.List is strict in elements, but spine-lazy, while this one -- is spine-strict but lazy in elements. That's what LE stands -- for - "lazy in elements". -- -- Example: -- --
--   > tail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1]
--   *** Exception: Prelude.undefined
--   > tail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1]
--   [5,4,3]
--   > take 3 $ Data.List.dropWhileEnd (<3) [5, 4, 3, 2, 1, undefined]
--   [5,4,3]
--   > take 3 $ dropWhileEndLE (<3) [5, 4, 3, 2, 1, undefined]
--   *** Exception: Prelude.undefined
--   
dropWhileEndLE :: (a -> Bool) -> [a] -> [a] -- | takeWhileEndLE p is equivalent to reverse . takeWhile p . -- reverse, but is usually faster (as well as being easier to read). 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. -- -- Example: -- --
--   isInfixOf "Haskell" "I really like Haskell." == True
--   isInfixOf "Ial" "I really like Haskell." == False
--   
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 :: () => [a] -> [[a]] -> [a] lowercase :: String -> String -- | Like "Data.List.union", but has O(n log n) complexity instead -- of O(n^2). listUnion :: (Ord a) => [a] -> [a] -> [a] -- | A right-biased version of listUnion. -- -- Example: -- --
--   > listUnion [1,2,3,4,3] [2,1,1]
--   [1,2,3,4,3]
--   > listUnionRight [1,2,3,4,3] [2,1,1]
--   [4,3,2,1,1]
--   
listUnionRight :: (Ord a) => [a] -> [a] -> [a] -- | Like nub, but has O(n log n) complexity instead of -- O(n^2). Code for ordNub and listUnion taken -- from Niklas Hambüchen's ordnub package. ordNub :: Ord a => [a] -> [a] -- | Like ordNub and nubBy. Selects a key for each element -- and takes the nub based on that key. ordNubBy :: Ord b => (a -> b) -> [a] -> [a] -- | A right-biased version of ordNub. -- -- Example: -- --
--   > ordNub [1,2,1]
--   [1,2]
--   > ordNubRight [1,2,1]
--   [2,1]
--   
ordNubRight :: (Ord a) => [a] -> [a] -- | A total variant of tail. safeTail :: [a] -> [a] unintersperse :: Char -> String -> [String] -- | Wraps text to the default line width. Existing newlines are preserved. wrapText :: String -> String -- | Wraps a list of words to a list of lines of words of a particular -- width. wrapLine :: Int -> [String] -> [[String]] -- | isAbsoluteOnAnyPlatform and isRelativeOnAnyPlatform are -- like isAbsolute and isRelative but have platform -- independent heuristics. The System.FilePath exists in two versions, -- Windows and Posix. The two versions don't agree on what is a relative -- path and we don't know if we're given Windows or Posix paths. This -- results in false positives when running on Posix and inspecting -- Windows paths, like the hackage server does. -- System.FilePath.Posix.isAbsolute "C:\hello" == False -- System.FilePath.Windows.isAbsolute "/hello" == False This means that -- we would treat paths that start with "/" to be absolute. On Posix they -- are indeed absolute, while on Windows they are not. -- -- The portable versions should be used when we might deal with paths -- that are from another OS than the host OS. For example, the Hackage -- Server deals with both Windows and Posix paths while performing the -- PackageDescription checks. In contrast, when we run 'cabal configure' -- we do expect the paths to be correct for our OS and we should not have -- to use the platform independent heuristics. isAbsoluteOnAnyPlatform :: FilePath -> Bool -- |
--   isRelativeOnAnyPlatform = not . isAbsoluteOnAnyPlatform
--   
isRelativeOnAnyPlatform :: FilePath -> Bool instance GHC.Classes.Eq Distribution.Simple.Utils.TraceWhen 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.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubListR a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubList a) instance GHC.Classes.Ord a => GHC.Base.Monoid (Distribution.Utils.NubList.NubListR a) instance GHC.Classes.Ord a => Data.Semigroup.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 => Data.Semigroup.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) 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 -> NoCallStackIO 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 -- | 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]
--   
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 -> NoCallStackIO String -- | 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 :: NoCallStackIO [FilePath] instance GHC.Generics.Generic Distribution.Simple.Program.Find.ProgramSearchPathEntry instance GHC.Classes.Eq Distribution.Simple.Program.Find.ProgramSearchPathEntry instance Data.Binary.Class.Binary Distribution.Simple.Program.Find.ProgramSearchPathEntry -- | 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) -> 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 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]
--   
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 -- | 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.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.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.Program instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ConfiguredProgram instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ProgramLocation -- | 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)] -> [FilePath] -> Maybe FilePath -> Maybe String -> IOEncoding -> IOEncoding -> ProgramInvocation [progInvokePath] :: ProgramInvocation -> FilePath [progInvokeArgs] :: ProgramInvocation -> [String] [progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)] [progInvokePathEnv] :: ProgramInvocation -> [FilePath] [progInvokeCwd] :: ProgramInvocation -> Maybe FilePath [progInvokeInput] :: ProgramInvocation -> Maybe String [progInvokeInputEncoding] :: ProgramInvocation -> IOEncoding [progInvokeOutputEncoding] :: ProgramInvocation -> IOEncoding data IOEncoding IOEncodingText :: IOEncoding IOEncodingUTF8 :: IOEncoding emptyProgramInvocation :: ProgramInvocation simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation programInvocation :: 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 -- | 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)] -> NoCallStackIO (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 -- | 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 -> ConfiguredProgram -> FilePath -> [FilePath] -> IO () -- | 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 :: ConfiguredProgram -> Version -> Verbosity -> FilePath -> [FilePath] -> FilePath -> [ModuleName] -> IO () union :: ConfiguredProgram -> Verbosity -> [FilePath] -> FilePath -> [ModuleName] -> IO () -- | 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 lhcProgram :: Program lhcPkgProgram :: 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 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. -- -- 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 -- | 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 -- | Update a configured program in the database. updateProgram :: ConfiguredProgram -> ProgramDb -> ProgramDb -- | List all configured programs. configuredPrograms :: ProgramDb -> [ConfiguredProgram] -- | 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. 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 -- | 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 String (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) 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 -- | 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) -> 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 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]
--   
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 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)] -> [FilePath] -> Maybe FilePath -> Maybe String -> IOEncoding -> IOEncoding -> ProgramInvocation [progInvokePath] :: ProgramInvocation -> FilePath [progInvokeArgs] :: ProgramInvocation -> [String] [progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)] [progInvokePathEnv] :: ProgramInvocation -> [FilePath] [progInvokeCwd] :: ProgramInvocation -> Maybe FilePath [progInvokeInput] :: ProgramInvocation -> Maybe String [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 -- | 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. -- -- 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 String (ConfiguredProgram, Version, ProgramDb)) -- | Update a configured program in the database. updateProgram :: ConfiguredProgram -> ProgramDb -> 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. 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) -- | 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. getDbProgramOutput :: Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO String ghcProgram :: Program ghcPkgProgram :: Program ghcjsProgram :: Program ghcjsPkgProgram :: Program lhcProgram :: Program lhcPkgProgram :: 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 -- | Deprecated: use ProgramDb instead type ProgramConfiguration = ProgramDb -- | Deprecated: use emptyProgramDb instead emptyProgramConfiguration :: ProgramConfiguration -- | Deprecated: use defaultProgramDb instead defaultProgramConfiguration :: ProgramConfiguration -- | Deprecated: use restoreProgramDb instead restoreProgramConfiguration :: [Program] -> ProgramConfiguration -> ProgramConfiguration -- | Deprecated: use runProgram instead rawSystemProgram :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO () -- | Deprecated: use getProgramOutput instead rawSystemProgramStdout :: Verbosity -> ConfiguredProgram -> [ProgArg] -> IO String -- | Deprecated: use runDbProgram instead rawSystemProgramConf :: Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO () -- | Deprecated: use getDbProgramOutput instead rawSystemProgramStdoutConf :: Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO String -- | Deprecated: use findProgramOnSearchPath instead findProgramOnPath :: String -> Verbosity -> IO (Maybe FilePath) -- | Look for a program on the path. -- | Deprecated: No longer used within Cabal, try -- findProgramOnSearchPath findProgramLocation :: Verbosity -> FilePath -> IO (Maybe FilePath) -- | 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 () -- | 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: -- -- -- -- 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 -> Dependency -> [(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 -> Dependency -> Maybe UnqualComponentName -> [(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] -- | 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, Maybe UnqualComponentName), [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. -- -- dependencyClosure :: InstalledPackageIndex -> [UnitId] -> Either (InstalledPackageIndex) [(InstalledPackageInfo, [UnitId])] -- | Takes the transitive closure of the packages reverse dependencies. -- -- 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] -- | Backwards compatibility wrapper for Cabal pre-1.24. -- | Deprecated: Use deleteUnitId instead deleteInstalledPackageId :: UnitId -> InstalledPackageIndex -> InstalledPackageIndex -- | Backwards compatibility for Cabal pre-1.24. -- | Deprecated: Use lookupUnitId instead lookupInstalledPackageId :: PackageIndex a -> UnitId -> Maybe a 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 GHC.Base.Monoid (Distribution.Simple.PackageIndex.PackageIndex Distribution.InstalledPackageInfo.InstalledPackageInfo) instance Data.Semigroup.Semigroup (Distribution.Simple.PackageIndex.PackageIndex Distribution.InstalledPackageInfo.InstalledPackageInfo) -- | This should be a much more sophisticated abstraction than it is. -- Currently it's just a bit of data about the compiler, like it's -- 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, Flag)] -> [(Extension, Flag)] -> 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, Flag)] -- | Supported extensions. [compilerExtensions] :: Compiler -> [(Extension, Flag)] -- | 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 -- | 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 isloated environments of packages, -- for example to build a collection of related packages without -- installing them globally. data PackageDB GlobalPackageDB :: PackageDB UserPackageDB :: PackageDB SpecificPackageDB :: FilePath -> PackageDB -- | 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 PackageDBStack = [PackageDB] -- | Return the package that we should register into. This is the package -- db at the top of the stack. registrationPackageDB :: PackageDBStack -> PackageDB -- | Make package paths absolute absolutePackageDBPaths :: PackageDBStack -> NoCallStackIO PackageDBStack absolutePackageDBPath :: PackageDB -> NoCallStackIO PackageDB -- | 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 Flag = String languageToFlags :: Compiler -> Maybe Language -> [Flag] unsupportedLanguages :: Compiler -> [Language] -> [Language] -- | For the given compiler, return the flags for the supported extensions. extensionsToFlags :: Compiler -> [Extension] -> [Flag] -- | 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 -- | Does this compiler support Backpack? backpackSupported :: Compiler -> Bool -- | Does this compiler support a package database entry with: -- "dynamic-library-dirs"? libraryDynDirSupported :: 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 ProfDetailOther :: String -> ProfDetailLevel knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] flagToProfDetailLevel :: String -> ProfDetailLevel showProfDetailLevel :: ProfDetailLevel -> String 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 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.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.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.Read.Read Distribution.Simple.Compiler.PackageDB instance GHC.Show.Show Distribution.Simple.Compiler.PackageDB instance GHC.Classes.Ord Distribution.Simple.Compiler.PackageDB instance GHC.Generics.Generic Distribution.Simple.Compiler.PackageDB instance GHC.Classes.Eq Distribution.Simple.Compiler.PackageDB instance Data.Binary.Class.Binary Distribution.Simple.Compiler.ProfDetailLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.Compiler instance Data.Binary.Class.Binary Distribution.Simple.Compiler.DebugInfoLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.OptimisationLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.PackageDB -- | This module provides an library interface to the hc-pkg -- program. Currently only GHC, GHCJS and LHC 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 -> PackageDBStack -> [String] -> IO () -- | Call hc-pkg to register a package. -- --
--   hc-pkg register {filename | -} [--user | --global | --package-db]
--   
register :: HcPkgInfo -> Verbosity -> PackageDBStack -> InstalledPackageInfo -> RegisterOptions -> IO () -- | Call hc-pkg to unregister a package -- --
--   hc-pkg unregister [pkgid] [--user | --global | --package-db]
--   
unregister :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () -- | Call hc-pkg to recache the registered packages. -- --
--   hc-pkg recache [--user | --global | --package-db]
--   
recache :: HcPkgInfo -> Verbosity -> PackageDB -> IO () -- | Call hc-pkg to expose a package. -- --
--   hc-pkg expose [pkgid] [--user | --global | --package-db]
--   
expose :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () -- | Call hc-pkg to hide a package. -- --
--   hc-pkg hide [pkgid] [--user | --global | --package-db]
--   
hide :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () -- | Call hc-pkg to get all the details of all the packages in the -- given package database. dump :: HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo] -- | Call hc-pkg to retrieve a specific package -- --
--   hc-pkg describe [pkgid] [--user | --global | --package-db]
--   
describe :: HcPkgInfo -> Verbosity -> 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 -> PackageDB -> IO [PackageId] initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation registerInvocation :: HcPkgInfo -> Verbosity -> PackageDBStack -> InstalledPackageInfo -> RegisterOptions -> ProgramInvocation unregisterInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation recacheInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation exposeInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation hideInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation describeInvocation :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId -> ProgramInvocation listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation -- | 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] -> CommandParse (a, 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. 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 -- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool -- > Choice > Opt) and consider only the first one. viewAsFieldDescr :: OptionField a -> FieldDescr a -- | 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)) -> (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 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. 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 -> 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 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 -- | This is a big module, but not very complicated. The code is very -- regular and repetitive. It defines the command line interface for all -- the Cabal 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 -> GlobalFlags [globalVersion] :: GlobalFlags -> Flag Bool [globalNumericVersion] :: GlobalFlags -> Flag Bool emptyGlobalFlags :: GlobalFlags defaultGlobalFlags :: GlobalFlags globalCommand :: [Command action] -> CommandUI GlobalFlags -- | 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 :: [String] -> 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 ProfDetailLevel -> Flag ProfDetailLevel -> [String] -> Flag OptimisationLevel -> Flag PathTemplate -> Flag PathTemplate -> InstallDirs (Flag PathTemplate) -> Flag FilePath -> [FilePath] -> [FilePath] -> [FilePath] -> Flag String -> Flag ComponentId -> Flag Bool -> Flag FilePath -> Flag FilePath -> Flag Verbosity -> Flag Bool -> [Maybe PackageDB] -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> [Dependency] -> [(PackageName, ComponentId)] -> [(ModuleName, Module)] -> FlagAssignment -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag String -> Flag Bool -> Flag DebugInfoLevel -> Maybe AllowOlder -> Maybe AllowNewer -> ConfigFlags [configArgs] :: ConfigFlags -> [String] -- | All programs that cabal may run [configPrograms_] :: ConfigFlags -> 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, such as GHC or JHC. [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 -- | Enable dynamic linking of the executables. [configDynExe] :: ConfigFlags -> Flag Bool -- | Enable profiling in the executables. [configProfExe] :: ConfigFlags -> Flag Bool -- | Enable profiling in the library and executables. [configProf] :: 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 -> [FilePath] -- | path to search for extra frameworks (OS X only) [configExtraFrameworkDirs] :: ConfigFlags -> [FilePath] -- | path to search for header files [configExtraIncludeDirs] :: ConfigFlags -> [FilePath] -- | 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 -- | "dist" prefix [configDistPref] :: ConfigFlags -> Flag FilePath -- | Cabal file to use [configCabalFilePath] :: ConfigFlags -> Flag FilePath -- | verbosity level [configVerbosity] :: ConfigFlags -> Flag Verbosity -- | 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-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 -> [Dependency] -- | The packages depended on. [configDependencies] :: ConfigFlags -> [(PackageName, ComponentId)] -- | 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 -- | dual to configAllowNewer [configAllowOlder] :: ConfigFlags -> Maybe AllowOlder -- | Ignore upper bounds on all or some dependencies. Wrapped in -- Maybe to distinguish between "default" and "explicitly -- disabled". [configAllowNewer] :: ConfigFlags -> Maybe AllowNewer 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) -- | Generic data type for policy when relaxing bounds in dependencies. -- Don't use this directly: use AllowOlder or AllowNewer -- depending on whether or not you are relaxing an lower or upper bound -- (respectively). data RelaxDeps -- | Default: honor the upper bounds in all dependencies, never choose -- versions newer than allowed. RelaxDepsNone :: RelaxDeps -- | Ignore upper bounds in dependencies on the given packages. RelaxDepsSome :: [RelaxedDep] -> RelaxDeps -- | Ignore upper bounds in dependencies on all packages. RelaxDepsAll :: RelaxDeps -- | Dependencies can be relaxed either for all packages in the install -- plan, or only for some packages. data RelaxedDep RelaxedDep :: PackageName -> RelaxedDep RelaxedDepScoped :: PackageName -> PackageName -> RelaxedDep -- | Convert RelaxDeps to a boolean. isRelaxDeps :: RelaxDeps -> Bool -- | RelaxDeps in the context of upper bounds (i.e. for -- --allow-newer flag) newtype AllowNewer AllowNewer :: RelaxDeps -> AllowNewer [unAllowNewer] :: AllowNewer -> RelaxDeps -- | RelaxDeps in the context of lower bounds (i.e. for -- --allow-older flag) newtype AllowOlder AllowOlder :: RelaxDeps -> AllowOlder [unAllowOlder] :: AllowOlder -> RelaxDeps configAbsolutePaths :: ConfigFlags -> NoCallStackIO ConfigFlags readPackageDbList :: String -> [Maybe PackageDB] showPackageDbList :: [Maybe PackageDB] -> [String] -- | Flags to copy: (destdir, copy-prefix (backwards compat), -- verbosity) data CopyFlags CopyFlags :: Flag CopyDest -> Flag FilePath -> Flag Verbosity -> [String] -> CopyFlags [copyDest] :: CopyFlags -> Flag CopyDest [copyDistPref] :: CopyFlags -> Flag FilePath [copyVerbosity] :: CopyFlags -> Flag Verbosity [copyArgs] :: CopyFlags -> [String] emptyCopyFlags :: CopyFlags defaultCopyFlags :: CopyFlags copyCommand :: CommandUI CopyFlags -- | Flags to install: (package db, verbosity) data InstallFlags InstallFlags :: Flag PackageDB -> Flag FilePath -> Flag Bool -> Flag Bool -> Flag Verbosity -> InstallFlags [installPackageDB] :: InstallFlags -> Flag PackageDB [installDistPref] :: InstallFlags -> Flag FilePath [installUseWrapper] :: InstallFlags -> Flag Bool [installInPlace] :: InstallFlags -> Flag Bool [installVerbosity] :: InstallFlags -> Flag Verbosity emptyInstallFlags :: InstallFlags defaultInstallFlags :: InstallFlags installCommand :: CommandUI InstallFlags data DoctestFlags DoctestFlags :: [(String, FilePath)] -> [(String, [String])] -> Flag FilePath -> Flag Verbosity -> DoctestFlags [doctestProgramPaths] :: DoctestFlags -> [(String, FilePath)] [doctestProgramArgs] :: DoctestFlags -> [(String, [String])] [doctestDistPref] :: DoctestFlags -> Flag FilePath [doctestVerbosity] :: DoctestFlags -> Flag Verbosity emptyDoctestFlags :: DoctestFlags defaultDoctestFlags :: DoctestFlags doctestCommand :: CommandUI DoctestFlags -- | When we build haddock documentation, there are two cases: -- --
    --
  1. We build haddocks only for the current development version, -- intended for local use and not for distribution. In this case, we -- store the generated documentation in -- distdochtml/name.
  2. --
  3. 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.
  4. --
data HaddockTarget ForHackage :: HaddockTarget ForDevelopment :: HaddockTarget data HaddockFlags HaddockFlags :: [(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 FilePath -> Flag PathTemplate -> Flag FilePath -> Flag Bool -> Flag Verbosity -> HaddockFlags [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 [haddockHscolour] :: HaddockFlags -> Flag Bool [haddockHscolourCss] :: HaddockFlags -> Flag FilePath [haddockContents] :: HaddockFlags -> Flag PathTemplate [haddockDistPref] :: HaddockFlags -> Flag FilePath [haddockKeepTempFiles] :: HaddockFlags -> Flag Bool [haddockVerbosity] :: HaddockFlags -> Flag Verbosity emptyHaddockFlags :: HaddockFlags defaultHaddockFlags :: HaddockFlags haddockCommand :: CommandUI HaddockFlags data HscolourFlags HscolourFlags :: Flag FilePath -> Flag Bool -> Flag Bool -> Flag Bool -> Flag Bool -> Flag FilePath -> Flag Verbosity -> HscolourFlags [hscolourCSS] :: HscolourFlags -> Flag FilePath [hscolourExecutables] :: HscolourFlags -> Flag Bool [hscolourTestSuites] :: HscolourFlags -> Flag Bool [hscolourBenchmarks] :: HscolourFlags -> Flag Bool [hscolourForeignLibs] :: HscolourFlags -> Flag Bool [hscolourDistPref] :: HscolourFlags -> Flag FilePath [hscolourVerbosity] :: HscolourFlags -> Flag Verbosity emptyHscolourFlags :: HscolourFlags defaultHscolourFlags :: HscolourFlags hscolourCommand :: CommandUI HscolourFlags data BuildFlags BuildFlags :: [(String, FilePath)] -> [(String, [String])] -> Flag FilePath -> Flag Verbosity -> Flag (Maybe Int) -> [String] -> BuildFlags [buildProgramPaths] :: BuildFlags -> [(String, FilePath)] [buildProgramArgs] :: BuildFlags -> [(String, [String])] [buildDistPref] :: BuildFlags -> Flag FilePath [buildVerbosity] :: BuildFlags -> Flag Verbosity [buildNumJobs] :: BuildFlags -> Flag (Maybe Int) [buildArgs] :: BuildFlags -> [String] emptyBuildFlags :: BuildFlags defaultBuildFlags :: BuildFlags buildCommand :: ProgramDb -> CommandUI BuildFlags -- | Deprecated: Use buildVerbosity instead buildVerbose :: BuildFlags -> Verbosity data ReplFlags ReplFlags :: [(String, FilePath)] -> [(String, [String])] -> Flag FilePath -> Flag Verbosity -> Flag Bool -> ReplFlags [replProgramPaths] :: ReplFlags -> [(String, FilePath)] [replProgramArgs] :: ReplFlags -> [(String, [String])] [replDistPref] :: ReplFlags -> Flag FilePath [replVerbosity] :: ReplFlags -> Flag Verbosity [replReload] :: ReplFlags -> Flag Bool defaultReplFlags :: ReplFlags replCommand :: ProgramDb -> CommandUI ReplFlags data CleanFlags CleanFlags :: Flag Bool -> Flag FilePath -> Flag Verbosity -> CleanFlags [cleanSaveConf] :: CleanFlags -> Flag Bool [cleanDistPref] :: CleanFlags -> Flag FilePath [cleanVerbosity] :: CleanFlags -> Flag Verbosity emptyCleanFlags :: CleanFlags defaultCleanFlags :: CleanFlags cleanCommand :: CommandUI CleanFlags -- | Flags to register and unregister: (user package, -- gen-script, in-place, verbosity) data RegisterFlags RegisterFlags :: Flag PackageDB -> Flag Bool -> Flag (Maybe FilePath) -> Flag Bool -> Flag FilePath -> Flag Bool -> Flag Verbosity -> [String] -> RegisterFlags [regPackageDB] :: RegisterFlags -> Flag PackageDB [regGenScript] :: RegisterFlags -> Flag Bool [regGenPkgConf] :: RegisterFlags -> Flag (Maybe FilePath) [regInPlace] :: RegisterFlags -> Flag Bool [regDistPref] :: RegisterFlags -> Flag FilePath [regPrintId] :: RegisterFlags -> Flag Bool [regVerbosity] :: RegisterFlags -> Flag Verbosity [regArgs] :: RegisterFlags -> [String] emptyRegisterFlags :: RegisterFlags defaultRegisterFlags :: RegisterFlags registerCommand :: CommandUI RegisterFlags unregisterCommand :: CommandUI RegisterFlags -- | Flags to sdist: (snapshot, verbosity) data SDistFlags SDistFlags :: Flag Bool -> Flag FilePath -> Flag FilePath -> Flag FilePath -> Flag Verbosity -> SDistFlags [sDistSnapshot] :: SDistFlags -> Flag Bool [sDistDirectory] :: SDistFlags -> Flag FilePath [sDistDistPref] :: SDistFlags -> Flag FilePath [sDistListSources] :: SDistFlags -> Flag FilePath [sDistVerbosity] :: SDistFlags -> Flag Verbosity emptySDistFlags :: SDistFlags defaultSDistFlags :: SDistFlags sdistCommand :: CommandUI SDistFlags data TestFlags TestFlags :: Flag FilePath -> Flag Verbosity -> Flag PathTemplate -> Flag PathTemplate -> Flag TestShowDetails -> Flag Bool -> [PathTemplate] -> TestFlags [testDistPref] :: TestFlags -> Flag FilePath [testVerbosity] :: TestFlags -> Flag Verbosity [testHumanLog] :: TestFlags -> Flag PathTemplate [testMachineLog] :: TestFlags -> Flag PathTemplate [testShowDetails] :: TestFlags -> Flag TestShowDetails [testKeepTix] :: TestFlags -> Flag Bool [testOptions] :: TestFlags -> [PathTemplate] emptyTestFlags :: TestFlags defaultTestFlags :: TestFlags testCommand :: CommandUI TestFlags data TestShowDetails Never :: TestShowDetails Failures :: TestShowDetails Always :: TestShowDetails Streaming :: TestShowDetails Direct :: TestShowDetails data BenchmarkFlags BenchmarkFlags :: Flag FilePath -> Flag Verbosity -> [PathTemplate] -> BenchmarkFlags [benchmarkDistPref] :: BenchmarkFlags -> Flag FilePath [benchmarkVerbosity] :: BenchmarkFlags -> Flag Verbosity [benchmarkOptions] :: BenchmarkFlags -> [PathTemplate] emptyBenchmarkFlags :: BenchmarkFlags defaultBenchmarkFlags :: BenchmarkFlags benchmarkCommand :: CommandUI BenchmarkFlags -- | The location prefix for the copy command. data CopyDest NoCopyDest :: CopyDest CopyTo :: 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] installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] -- | 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] -- | For each known program PROG in progDb, produce a -- PROG-options OptionField. -- | Deprecated: Use programDbOptions instead programConfigurationOptions :: ProgramDb -> ShowOrParseArgs -> (flags -> [(String, [String])]) -> ([(String, [String])] -> (flags -> flags)) -> [OptionField flags] -- | Like programDbPaths, but allows to customise the option name. -- | Deprecated: Use programDbPaths' instead programConfigurationPaths' :: (String -> String) -> ProgramDb -> ShowOrParseArgs -> (flags -> [(String, FilePath)]) -> ([(String, FilePath)] -> (flags -> flags)) -> [OptionField flags] -- | 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 :: FilePath optionDistPref :: (flags -> Flag FilePath) -> (Flag FilePath -> flags -> flags) -> ShowOrParseArgs -> OptionField flags -- | All flags are monoids, they come in two flavours: -- --
    --
  1. list flags eg
  2. --
-- --
--   --ghc-option=foo --ghc-option=bar
--   
-- -- gives us all the values ["foo", "bar"] -- --
    --
  1. singular value flags, eg:
  2. --
-- --
--   --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. data Flag a Flag :: a -> Flag a NoFlag :: Flag a toFlag :: a -> Flag a fromFlag :: WithCallStack (Flag a -> a) fromFlagOrDefault :: a -> Flag a -> a flagToMaybe :: Flag a -> Maybe a flagToList :: Flag a -> [a] 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 optionNumJobs :: (flags -> Flag (Maybe Int)) -> (Flag (Maybe Int) -> flags -> flags) -> OptionField flags readPToMaybe :: ReadP a a -> String -> Maybe a instance GHC.Generics.Generic Distribution.Simple.Setup.BenchmarkFlags instance GHC.Generics.Generic Distribution.Simple.Setup.TestFlags instance GHC.Show.Show Distribution.Simple.Setup.TestShowDetails instance GHC.Enum.Bounded Distribution.Simple.Setup.TestShowDetails instance GHC.Enum.Enum Distribution.Simple.Setup.TestShowDetails instance GHC.Classes.Ord Distribution.Simple.Setup.TestShowDetails instance GHC.Classes.Eq Distribution.Simple.Setup.TestShowDetails instance GHC.Generics.Generic Distribution.Simple.Setup.ReplFlags instance GHC.Show.Show Distribution.Simple.Setup.ReplFlags instance GHC.Generics.Generic Distribution.Simple.Setup.BuildFlags instance GHC.Show.Show Distribution.Simple.Setup.BuildFlags instance GHC.Read.Read Distribution.Simple.Setup.BuildFlags instance GHC.Generics.Generic Distribution.Simple.Setup.CleanFlags instance GHC.Show.Show Distribution.Simple.Setup.CleanFlags instance GHC.Generics.Generic Distribution.Simple.Setup.HaddockFlags instance GHC.Show.Show Distribution.Simple.Setup.HaddockFlags instance GHC.Generics.Generic Distribution.Simple.Setup.HaddockTarget instance GHC.Show.Show Distribution.Simple.Setup.HaddockTarget instance GHC.Classes.Eq Distribution.Simple.Setup.HaddockTarget instance GHC.Generics.Generic Distribution.Simple.Setup.DoctestFlags instance GHC.Show.Show Distribution.Simple.Setup.DoctestFlags instance GHC.Generics.Generic Distribution.Simple.Setup.HscolourFlags instance GHC.Show.Show Distribution.Simple.Setup.HscolourFlags instance GHC.Generics.Generic Distribution.Simple.Setup.RegisterFlags instance GHC.Show.Show Distribution.Simple.Setup.RegisterFlags instance GHC.Generics.Generic Distribution.Simple.Setup.SDistFlags instance GHC.Show.Show Distribution.Simple.Setup.SDistFlags instance GHC.Generics.Generic Distribution.Simple.Setup.InstallFlags instance GHC.Show.Show Distribution.Simple.Setup.InstallFlags instance GHC.Generics.Generic Distribution.Simple.Setup.CopyFlags instance GHC.Show.Show Distribution.Simple.Setup.CopyFlags instance GHC.Show.Show Distribution.Simple.Setup.ConfigFlags instance GHC.Read.Read Distribution.Simple.Setup.ConfigFlags instance GHC.Generics.Generic Distribution.Simple.Setup.ConfigFlags instance GHC.Generics.Generic Distribution.Simple.Setup.AllowNewer instance GHC.Show.Show Distribution.Simple.Setup.AllowNewer instance GHC.Read.Read Distribution.Simple.Setup.AllowNewer instance GHC.Classes.Eq Distribution.Simple.Setup.AllowNewer instance GHC.Generics.Generic Distribution.Simple.Setup.AllowOlder instance GHC.Show.Show Distribution.Simple.Setup.AllowOlder instance GHC.Read.Read Distribution.Simple.Setup.AllowOlder instance GHC.Classes.Eq Distribution.Simple.Setup.AllowOlder instance GHC.Generics.Generic Distribution.Simple.Setup.RelaxDeps instance GHC.Show.Show Distribution.Simple.Setup.RelaxDeps instance GHC.Read.Read Distribution.Simple.Setup.RelaxDeps instance GHC.Classes.Eq Distribution.Simple.Setup.RelaxDeps instance GHC.Generics.Generic Distribution.Simple.Setup.RelaxedDep instance GHC.Show.Show Distribution.Simple.Setup.RelaxedDep instance GHC.Read.Read Distribution.Simple.Setup.RelaxedDep instance GHC.Classes.Eq Distribution.Simple.Setup.RelaxedDep instance GHC.Generics.Generic Distribution.Simple.Setup.GlobalFlags instance GHC.Read.Read a => GHC.Read.Read (Distribution.Simple.Setup.Flag a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Setup.Flag a) instance GHC.Generics.Generic (Distribution.Simple.Setup.Flag a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.Setup.Flag a) instance GHC.Base.Monoid Distribution.Simple.Setup.BenchmarkFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.BenchmarkFlags instance GHC.Base.Monoid Distribution.Simple.Setup.TestFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.TestFlags instance Distribution.Text.Text Distribution.Simple.Setup.TestShowDetails instance GHC.Base.Monoid Distribution.Simple.Setup.TestShowDetails instance Data.Semigroup.Semigroup Distribution.Simple.Setup.TestShowDetails instance GHC.Base.Monoid Distribution.Simple.Setup.ReplFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.ReplFlags instance GHC.Base.Monoid Distribution.Simple.Setup.BuildFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.BuildFlags instance GHC.Base.Monoid Distribution.Simple.Setup.CleanFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.CleanFlags instance GHC.Base.Monoid Distribution.Simple.Setup.HaddockFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.HaddockFlags instance GHC.Base.Monoid Distribution.Simple.Setup.DoctestFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.DoctestFlags instance GHC.Base.Monoid Distribution.Simple.Setup.HscolourFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.HscolourFlags instance GHC.Base.Monoid Distribution.Simple.Setup.RegisterFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.RegisterFlags instance GHC.Base.Monoid Distribution.Simple.Setup.SDistFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.SDistFlags instance GHC.Base.Monoid Distribution.Simple.Setup.InstallFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.InstallFlags instance GHC.Base.Monoid Distribution.Simple.Setup.CopyFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.CopyFlags instance Data.Binary.Class.Binary Distribution.Simple.Setup.ConfigFlags instance GHC.Classes.Eq Distribution.Simple.Setup.ConfigFlags instance GHC.Base.Monoid Distribution.Simple.Setup.ConfigFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.ConfigFlags instance Data.Binary.Class.Binary Distribution.Simple.Setup.AllowNewer instance Data.Semigroup.Semigroup Distribution.Simple.Setup.AllowNewer instance GHC.Base.Monoid Distribution.Simple.Setup.AllowNewer instance Data.Binary.Class.Binary Distribution.Simple.Setup.AllowOlder instance Data.Semigroup.Semigroup Distribution.Simple.Setup.AllowOlder instance GHC.Base.Monoid Distribution.Simple.Setup.AllowOlder instance Data.Binary.Class.Binary Distribution.Simple.Setup.RelaxDeps instance Data.Semigroup.Semigroup Distribution.Simple.Setup.RelaxDeps instance GHC.Base.Monoid Distribution.Simple.Setup.RelaxDeps instance Distribution.Text.Text Distribution.Simple.Setup.RelaxedDep instance Data.Binary.Class.Binary Distribution.Simple.Setup.RelaxedDep instance GHC.Base.Monoid Distribution.Simple.Setup.GlobalFlags instance Data.Semigroup.Semigroup Distribution.Simple.Setup.GlobalFlags instance Distribution.Simple.Setup.BooleanFlag GHC.Types.Bool instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Simple.Setup.Flag a) instance GHC.Base.Functor Distribution.Simple.Setup.Flag instance GHC.Base.Monoid (Distribution.Simple.Setup.Flag a) instance Data.Semigroup.Semigroup (Distribution.Simple.Setup.Flag a) instance GHC.Enum.Bounded a => GHC.Enum.Bounded (Distribution.Simple.Setup.Flag a) instance GHC.Enum.Enum a => GHC.Enum.Enum (Distribution.Simple.Setup.Flag a) module Distribution.Types.LocalBuildInfo -- | Data cached after configuration step. See also ConfigFlags. data LocalBuildInfo LocalBuildInfo :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> [String] -> InstallDirTemplates -> Compiler -> Platform -> FilePath -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> InstalledPackageIndex -> Maybe FilePath -> PackageDescription -> ProgramDb -> PackageDBStack -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> PathTemplate -> PathTemplate -> Bool -> LocalBuildInfo -- | Options passed to the configuration step. Needed to re-run -- configuration when .cabal is out of date [configFlags] :: LocalBuildInfo -> ConfigFlags -- | The final set of flags which were picked for this package [flagAssignment] :: LocalBuildInfo -> FlagAssignment -- | What components were enabled during configuration, and why. [componentEnabledSpec] :: LocalBuildInfo -> ComponentRequestedSpec -- | Extra args on the command line for the configuration step. Needed to -- re-run configuration when .cabal is out of date [extraConfigArgs] :: LocalBuildInfo -> [String] -- | The installation directories for the various different kinds of files -- TODO: inplaceDirTemplates :: InstallDirs FilePath [installDirTemplates] :: LocalBuildInfo -> InstallDirTemplates -- | The compiler we're building with [compiler] :: LocalBuildInfo -> Compiler -- | The platform we're building for [hostPlatform] :: LocalBuildInfo -> Platform -- | Where to build the package. [buildDir] :: LocalBuildInfo -> FilePath -- | 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. [componentGraph] :: LocalBuildInfo -> Graph ComponentLocalBuildInfo -- | A map from component name to all matching components. These coincide -- with componentGraph [componentNameMap] :: LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -- | 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.) [installedPkgs] :: LocalBuildInfo -> InstalledPackageIndex -- | the filename containing the .cabal file, if available [pkgDescrFile] :: LocalBuildInfo -> Maybe FilePath -- | 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 wtih a HookedBuildInfo applied to -- it; see HookedBuildInfo for the whole sordid saga. As much as -- possible, Cabal library should avoid using this parameter. [localPkgDescr] :: LocalBuildInfo -> PackageDescription -- | Location and args for all programs [withPrograms] :: LocalBuildInfo -> ProgramDb -- | What package database to use, global/user [withPackageDB] :: LocalBuildInfo -> PackageDBStack -- | Whether to build normal libs. [withVanillaLib] :: LocalBuildInfo -> Bool -- | Whether to build profiling versions of libs. [withProfLib] :: LocalBuildInfo -> Bool -- | Whether to build shared versions of libs. [withSharedLib] :: LocalBuildInfo -> Bool -- | Whether to link executables dynamically [withDynExe] :: LocalBuildInfo -> Bool -- | Whether to build executables for profiling. [withProfExe] :: LocalBuildInfo -> Bool -- | Level of automatic profile detail. [withProfLibDetail] :: LocalBuildInfo -> ProfDetailLevel -- | Level of automatic profile detail. [withProfExeDetail] :: LocalBuildInfo -> ProfDetailLevel -- | Whether to build with optimization (if available). [withOptimization] :: LocalBuildInfo -> OptimisationLevel -- | Whether to emit debug info (if available). [withDebugInfo] :: LocalBuildInfo -> DebugInfoLevel -- | Whether to build libs suitable for use with GHCi. [withGHCiLib] :: LocalBuildInfo -> Bool -- | Use -split-objs with GHC, if available [splitObjs] :: LocalBuildInfo -> Bool -- | Whether to strip executables during install [stripExes] :: LocalBuildInfo -> Bool -- | Whether to strip libraries during install [stripLibs] :: LocalBuildInfo -> Bool -- | Whether to enable executable program coverage [exeCoverage] :: LocalBuildInfo -> Bool -- | Whether to enable library program coverage [libCoverage] :: LocalBuildInfo -> Bool -- | Prefix to be prepended to installed executables [progPrefix] :: LocalBuildInfo -> PathTemplate -- | Suffix to be appended to installed executables [progSuffix] :: LocalBuildInfo -> PathTemplate [relocatable] :: LocalBuildInfo -> Bool -- | 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 localPkgDescr localPackage :: LocalBuildInfo -> PackageId -- | 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 localPkgDescr 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 localPkgDescr 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 localPkgDescr 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 -- localPkgDescr 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 localPkgDescr 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 -- | 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 -- PakcageDescription 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 -- PakcageDescription 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 -- PakcageDescription 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 -- PakcageDescription 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 -- PakcageDescription 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 -- PakcageDescription 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 () -- | Deprecated: Use componentGraph instead; you can get a list -- of ComponentLocalBuildInfo with toList. There's not a -- good way to get the list of ComponentNames the -- ComponentLocalBuildInfo depends on because this query doesn't -- make sense; the graph is indexed by UnitId not -- ComponentName. Given a UnitId you can lookup the -- ComponentLocalBuildInfo (getCLBI) and then get the -- ComponentName ('componentLocalName]). To be removed in Cabal -- 2.2 componentsConfigs :: LocalBuildInfo -> [(ComponentName, ComponentLocalBuildInfo, [ComponentName])] -- | External package dependencies for the package as a whole. This is the -- union of the individual componentPackageDeps, less any internal -- deps. -- | Deprecated: You almost certainly don't want this function, which -- agglomerates the dependencies of ALL enabled components. If you're -- using this to write out information on your dependencies, read off the -- dependencies directly from the actual component in question. To be -- removed in Cabal 2.2 externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] 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 -- | 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 LocalBuildInfo :: ConfigFlags -> FlagAssignment -> ComponentRequestedSpec -> [String] -> InstallDirTemplates -> Compiler -> Platform -> FilePath -> Graph ComponentLocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -> InstalledPackageIndex -> Maybe FilePath -> PackageDescription -> ProgramDb -> PackageDBStack -> Bool -> Bool -> Bool -> Bool -> Bool -> ProfDetailLevel -> ProfDetailLevel -> OptimisationLevel -> DebugInfoLevel -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> PathTemplate -> PathTemplate -> Bool -> LocalBuildInfo -- | Options passed to the configuration step. Needed to re-run -- configuration when .cabal is out of date [configFlags] :: LocalBuildInfo -> ConfigFlags -- | The final set of flags which were picked for this package [flagAssignment] :: LocalBuildInfo -> FlagAssignment -- | What components were enabled during configuration, and why. [componentEnabledSpec] :: LocalBuildInfo -> ComponentRequestedSpec -- | Extra args on the command line for the configuration step. Needed to -- re-run configuration when .cabal is out of date [extraConfigArgs] :: LocalBuildInfo -> [String] -- | The installation directories for the various different kinds of files -- TODO: inplaceDirTemplates :: InstallDirs FilePath [installDirTemplates] :: LocalBuildInfo -> InstallDirTemplates -- | The compiler we're building with [compiler] :: LocalBuildInfo -> Compiler -- | The platform we're building for [hostPlatform] :: LocalBuildInfo -> Platform -- | Where to build the package. [buildDir] :: LocalBuildInfo -> FilePath -- | 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. [componentGraph] :: LocalBuildInfo -> Graph ComponentLocalBuildInfo -- | A map from component name to all matching components. These coincide -- with componentGraph [componentNameMap] :: LocalBuildInfo -> Map ComponentName [ComponentLocalBuildInfo] -- | 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.) [installedPkgs] :: LocalBuildInfo -> InstalledPackageIndex -- | the filename containing the .cabal file, if available [pkgDescrFile] :: LocalBuildInfo -> Maybe FilePath -- | 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 wtih a HookedBuildInfo applied to -- it; see HookedBuildInfo for the whole sordid saga. As much as -- possible, Cabal library should avoid using this parameter. [localPkgDescr] :: LocalBuildInfo -> PackageDescription -- | Location and args for all programs [withPrograms] :: LocalBuildInfo -> ProgramDb -- | What package database to use, global/user [withPackageDB] :: LocalBuildInfo -> PackageDBStack -- | Whether to build normal libs. [withVanillaLib] :: LocalBuildInfo -> Bool -- | Whether to build profiling versions of libs. [withProfLib] :: LocalBuildInfo -> Bool -- | Whether to build shared versions of libs. [withSharedLib] :: LocalBuildInfo -> Bool -- | Whether to link executables dynamically [withDynExe] :: LocalBuildInfo -> Bool -- | Whether to build executables for profiling. [withProfExe] :: LocalBuildInfo -> Bool -- | Level of automatic profile detail. [withProfLibDetail] :: LocalBuildInfo -> ProfDetailLevel -- | Level of automatic profile detail. [withProfExeDetail] :: LocalBuildInfo -> ProfDetailLevel -- | Whether to build with optimization (if available). [withOptimization] :: LocalBuildInfo -> OptimisationLevel -- | Whether to emit debug info (if available). [withDebugInfo] :: LocalBuildInfo -> DebugInfoLevel -- | Whether to build libs suitable for use with GHCi. [withGHCiLib] :: LocalBuildInfo -> Bool -- | Use -split-objs with GHC, if available [splitObjs] :: LocalBuildInfo -> Bool -- | Whether to strip executables during install [stripExes] :: LocalBuildInfo -> Bool -- | Whether to strip libraries during install [stripLibs] :: LocalBuildInfo -> Bool -- | Whether to enable executable program coverage [exeCoverage] :: LocalBuildInfo -> Bool -- | Whether to enable library program coverage [libCoverage] :: LocalBuildInfo -> Bool -- | Prefix to be prepended to installed executables [progPrefix] :: LocalBuildInfo -> PathTemplate -- | Suffix to be appended to installed executables [progSuffix] :: LocalBuildInfo -> PathTemplate [relocatable] :: LocalBuildInfo -> Bool -- | External package dependencies for the package as a whole. This is the -- union of the individual componentPackageDeps, less any internal -- deps. -- | Deprecated: You almost certainly don't want this function, which -- agglomerates the dependencies of ALL enabled components. If you're -- using this to write out information on your dependencies, read off the -- dependencies directly from the actual component in question. To be -- removed in Cabal 2.2 externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)] -- | 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 data Component CLib :: Library -> Component CFLib :: ForeignLib -> Component CExe :: Executable -> Component CTest :: TestSuite -> Component CBench :: Benchmark -> Component data ComponentName CLibName :: ComponentName CSubLibName :: UnqualComponentName -> ComponentName CFLibName :: UnqualComponentName -> ComponentName CExeName :: UnqualComponentName -> ComponentName CTestName :: UnqualComponentName -> ComponentName CBenchName :: UnqualComponentName -> ComponentName defaultLibName :: ComponentName showComponentName :: ComponentName -> String -- | This gets the underlying unqualified component name. In fact, it is -- guaranteed to uniquely identify a component, returning -- Nothing if the ComponentName was for the public -- library. 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 -> FilePath foldComponent :: (Library -> a) -> (ForeignLib -> a) -> (Executable -> a) -> (TestSuite -> a) -> (Benchmark -> a) -> Component -> a componentName :: Component -> ComponentName componentBuildInfo :: Component -> BuildInfo -- | Is a component buildable (i.e., not marked with buildable: -- False)? See also this note in -- Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components. componentBuildable :: Component -> Bool -- | All the components in the package. pkgComponents :: PackageDescription -> [Component] -- | A list of all components in the package that are buildable, i.e., were -- not marked with buildable: False. This does NOT indicate if -- we are actually going to build the component, see -- enabledComponents instead. pkgBuildableComponents :: PackageDescription -> [Component] lookupComponent :: PackageDescription -> ComponentName -> Maybe Component getComponent :: PackageDescription -> ComponentName -> Component -- | Deprecated: This function is not well-defined, because a -- ComponentName does not uniquely identify a -- ComponentLocalBuildInfo. If you have a TargetInfo, you -- should use targetCLBI to get the -- ComponentLocalBuildInfo. Otherwise, use -- componentNameTargets to get all possible -- ComponentLocalBuildInfos. This will be removed in Cabal -- 2.2. getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo allComponentsInBuildOrder :: LocalBuildInfo -> [ComponentLocalBuildInfo] -- | Deprecated: You've got TargetInfo right? Use -- neededTargetsInBuildOrder on the UnitIds you can -- nodeKey out. componentsInBuildOrder :: LocalBuildInfo -> [ComponentName] -> [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 -> NoCallStackIO [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 () -- | Deprecated: You have got a TargetInfo right? Use -- withNeededTargetsInBuildOrder on the UnitIds you can -- nodeKey out. withComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo -> [ComponentName] -> (Component -> ComponentLocalBuildInfo -> IO ()) -> IO () -- | Deprecated: Use withAllComponentsInBuildOrder withComponentsLBI :: 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)] -- | 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) -- | See absoluteInstallDirs. absoluteComponentInstallDirs :: PackageDescription -> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath -- | See prefixRelativeInstallDirs prefixRelativeComponentInstallDirs :: PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe FilePath) substPathTemplate :: PackageId -> LocalBuildInfo -> UnitId -> PathTemplate -> FilePath -- | 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 -> FilePath -> [FilePath] -> 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 -- | 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 :: FilePath -> Way -> FilePath -> FilePath mixDir :: FilePath -> Way -> FilePath -> FilePath tixDir :: FilePath -> Way -> FilePath -> FilePath -- | Path to the .tix file containing a test suite's sum statistics. tixFilePath :: FilePath -> Way -> FilePath -> FilePath -- | Generate the HTML markup for all of a package's test suites. markupPackage :: Verbosity -> LocalBuildInfo -> FilePath -> String -> [TestSuite] -> IO () -- | Generate the HTML markup for a test suite. markupTest :: Verbosity -> LocalBuildInfo -> FilePath -> String -> 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 -- | 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 suspecious 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. generate :: 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 :: [PackageId] -> String -- | 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 :: [ComponentName] -> Doc 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, -- supressing 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.PackageLog instance GHC.Show.Show Distribution.Simple.Test.Log.PackageLog instance GHC.Read.Read Distribution.Simple.Test.Log.PackageLog 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.TestLogs instance GHC.Show.Show Distribution.Simple.Test.Log.TestLogs instance GHC.Read.Read Distribution.Simple.Test.Log.TestLogs module Distribution.Simple.Program.GHC -- | A structured set of GHC options/flags data GhcOptions GhcOptions :: Flag GhcMode -> NubListR String -> NubListR String -> NubListR FilePath -> NubListR ModuleName -> Flag FilePath -> Flag FilePath -> Flag Bool -> NubListR FilePath -> Flag String -> Flag ComponentId -> [(ModuleName, OpenModule)] -> Flag Bool -> PackageDBStack -> NubListR (OpenUnitId, ModuleRenaming) -> Flag Bool -> Flag Bool -> Flag Bool -> NubListR FilePath -> NubListR FilePath -> NubListR String -> NubListR String -> NubListR String -> Flag Bool -> Flag Bool -> NubListR FilePath -> NubListR String -> NubListR String -> NubListR FilePath -> NubListR FilePath -> NubListR FilePath -> Flag Language -> NubListR Extension -> Map Extension String -> Flag GhcOptimisation -> Flag Bool -> Flag Bool -> Flag GhcProfAuto -> Flag Bool -> Flag (Maybe Int) -> Flag FilePath -> NubListR FilePath -> Flag String -> Flag String -> Flag String -> Flag String -> Flag FilePath -> Flag FilePath -> Flag FilePath -> Flag FilePath -> Flag GhcDynLinkMode -> Flag Bool -> Flag Bool -> Flag Bool -> Flag String -> NubListR FilePath -> Flag Verbosity -> NubListR FilePath -> 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 -> NubListR String -- | Extra default flags to pass directly to ghc. These go at the beginning -- and so can be overridden by other stuff. [ghcOptExtraDefault] :: GhcOptions -> NubListR String -- | The main input files; could be .hs, .hi, .c, .o, depending on mode. [ghcOptInputFiles] :: GhcOptions -> NubListR FilePath -- | 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 FilePath -- | 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 it's own with no path argument). [ghcOptSourcePathClear] :: GhcOptions -> Flag Bool -- | Search path for Haskell source files; the ghc -i flag. [ghcOptSourcePath] :: GhcOptions -> NubListR FilePath -- | 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 -> NubListR FilePath -- | Search path for libraries to link in; the ghc -L flag. [ghcOptLinkLibPath] :: GhcOptions -> NubListR FilePath -- | Options to pass through to the linker; the ghc -optl flag. [ghcOptLinkOptions] :: GhcOptions -> NubListR 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 String -- | 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 -> NubListR String -- | Options to pass through to CPP; the ghc -optP flag. [ghcOptCppOptions] :: GhcOptions -> NubListR String -- | Search path for CPP includes like header files; the ghc -I -- flag. [ghcOptCppIncludePath] :: GhcOptions -> NubListR FilePath -- | Extra header files to include at CPP stage; the ghc -- -optP-include flag. [ghcOptCppIncludes] :: GhcOptions -> NubListR FilePath -- | Extra header files to include for old-style FFI; the ghc -- -#include flag. [ghcOptFfiIncludes] :: GhcOptions -> NubListR 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 String -- | What optimisation level to use; the ghc -O flag. [ghcOptOptimisation] :: GhcOptions -> Flag GhcOptimisation -- | Emit debug info; the ghc -g flag. [ghcOptDebugInfo] :: GhcOptions -> Flag Bool -- | 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 object files" feature; the ghc -split-objs -- flag. [ghcOptSplitObjs] :: GhcOptions -> Flag Bool -- | Run N jobs simultaneously (if possible). [ghcOptNumJobs] :: GhcOptions -> Flag (Maybe Int) -- | Enable coverage analysis; the ghc -fhpc -hpcdir flags. [ghcOptHPCDir] :: GhcOptions -> Flag FilePath -- | Extra GHCi startup scripts; the -ghci-script flag [ghcOptGHCiScripts] :: GhcOptions -> NubListR 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 FilePath [ghcOptObjDir] :: GhcOptions -> Flag FilePath [ghcOptOutputDir] :: GhcOptions -> Flag FilePath [ghcOptStubDir] :: GhcOptions -> Flag FilePath [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 FilePath -- | 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 ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> ProgramInvocation renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO () instance GHC.Generics.Generic Distribution.Simple.Program.GHC.GhcOptions instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptions instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcProfAuto instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcProfAuto 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.GhcOptimisation instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptimisation instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcMode instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcMode instance GHC.Base.Monoid Distribution.Simple.Program.GHC.GhcOptions instance Data.Semigroup.Semigroup Distribution.Simple.Program.GHC.GhcOptions -- | 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 -> 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 -> FullDb -> PackageId -> LinkedComponentMap -> ConfiguredComponent -> LogProgress LinkedComponent toLinkedComponents :: Verbosity -> 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 -- | 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 -- | BuildTargetExpected :: UserBuildTarget -> [String] -> String -> BuildTargetProblem -- | BuildTargetNoSuch :: UserBuildTarget -> [(String, String)] -> BuildTargetProblem BuildTargetAmbiguous :: UserBuildTarget -> [(UserBuildTarget, BuildTarget)] -> BuildTargetProblem reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO () instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.BuildTarget.MaybeAmbiguous a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.BuildTarget.Match a) instance GHC.Classes.Eq Distribution.Simple.BuildTarget.MatchError instance GHC.Show.Show Distribution.Simple.BuildTarget.MatchError 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.Show.Show Distribution.Simple.BuildTarget.QualLevel instance GHC.Enum.Enum Distribution.Simple.BuildTarget.QualLevel instance GHC.Show.Show Distribution.Simple.BuildTarget.BuildTargetProblem instance GHC.Show.Show Distribution.Simple.BuildTarget.UserBuildTargetProblem 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.Classes.Ord Distribution.Simple.BuildTarget.UserBuildTarget instance GHC.Classes.Eq Distribution.Simple.BuildTarget.UserBuildTarget instance GHC.Show.Show Distribution.Simple.BuildTarget.UserBuildTarget 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 :: FilePath srcPref :: FilePath -> FilePath -- | This is the name of the directory in which the generated haddocks -- should be stored. It does not include the -- distdochtml prefix. haddockDirName :: HaddockTarget -> PackageDescription -> FilePath hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath -- | The directory to which generated haddock documentation should be -- written. haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath -- | The directory in which we put auto-generated modules for EVERY -- component in the package. See deprecation notice. -- | Deprecated: If you can, use autogenComponentModulesDir -- instead, but if you really wanted package-global generated modules, -- use autogenPackageModulesDir. In Cabal 2.0, we avoid using -- autogenerated files which apply to all components, because the -- information you often want in these files, e.g., dependency -- information, is best specified per component, so that reconfiguring a -- different component (e.g., enabling tests) doesn't force the entire to -- be rebuilt. autogenPackageModulesDir still provides a place to -- put files you want to apply to the entire package, but most users of -- autogenModulesDir should seriously consider -- autogenComponentModulesDir if you really wanted the module to -- apply to one component. autogenModulesDir :: LocalBuildInfo -> String -- | The directory in which we put auto-generated modules for EVERY -- component in the package. autogenPackageModulesDir :: LocalBuildInfo -> String -- | The directory in which we put auto-generated modules for a particular -- component. autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String -- | The name of the auto-generated module associated with a package -- | Deprecated: Use autogenPathsModuleName instead autogenModuleName :: PackageDescription -> ModuleName -- | The name of the auto-generated Paths_* module associated with a -- package autogenPathsModuleName :: PackageDescription -> ModuleName cppHeaderName :: String haddockName :: PackageDescription -> FilePath mkLibName :: UnitId -> String mkProfLibName :: UnitId -> String mkSharedLibName :: CompilerId -> UnitId -> String -- | Default extension for executable files on the current platform. -- (typically "" on Unix and "exe" on Windows or OS/2) exeExtension :: 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 :: 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 :: String getSourceFiles :: Verbosity -> [FilePath] -> [ModuleName] -> IO [(ModuleName, FilePath)] getLibSourceFiles :: Verbosity -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO [(ModuleName, FilePath)] getExeSourceFiles :: Verbosity -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO [(ModuleName, FilePath)] getFLibSourceFiles :: Verbosity -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO [(ModuleName, FilePath)] -- | The directory where we put build results for an executable exeBuildDir :: LocalBuildInfo -> Executable -> FilePath -- | The directory where we put build results for a foreign library flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath -- | 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 -> PackageDBStack -> 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 -> Compiler -> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> IO () inplacePackageDbPath :: LocalBuildInfo -> FilePath -- | 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.LHC configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex -- | Build a library with LHC. buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () -- | Build an executable with LHC. buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () -- | Install for ghc, .hi, .a and, if --with-ghci given, .o installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO () -- | Install executables for GHC. installExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO () registerPackage :: Verbosity -> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> RegisterOptions -> IO () hcPkgInfo :: ProgramDb -> HcPkgInfo ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> [String] ghcVerbosityOptions :: Verbosity -> [String] -- | This module contains most of the JHC-specific code for configuring, -- building and installing packages. module Distribution.Simple.JHC configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex -- | Building a package for JHC. Currently C source files are not -- supported. buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () -- | Building an executable for JHC. Currently C source files are not -- supported. buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO () installExe :: Verbosity -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO () 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, Flag)] getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)] getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () installLib :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> FilePath -> PackageDescription -> Library -> ComponentLocalBuildInfo -> IO () registerPackage :: Verbosity -> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> IO () initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO () packageDbOpt :: PackageDB -> String module Distribution.Simple.GHCJS configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) -- | Given a package DB stack, return all installed packages. getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex -- | Given a single package DB, return all installed packages. getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex buildLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildExe :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () replLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () replExe :: Verbosity -> Flag (Maybe Int) -> 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 () installExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO () libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO String hcPkgInfo :: ProgramDb -> HcPkgInfo registerPackage :: Verbosity -> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> RegisterOptions -> IO () componentGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> GhcOptions getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath isDynamic :: Compiler -> Bool -- | Return the FilePath to the global GHC package database. getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> 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]) -- | 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 -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex getInstalledPackagesMonitorFiles :: Verbosity -> Platform -> ProgramDb -> [PackageDB] -> IO [FilePath] -- | Given a single package DB, return all installed packages. getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex buildLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () -- | Build a foreign library buildFLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () -- | Build an executable with GHC. buildExe :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () replLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () -- | Build a foreign library replFLib :: Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () -- | Build an executable with GHC. replExe :: Verbosity -> Flag (Maybe Int) -> 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 -> PackageDBStack -> InstalledPackageInfo -> RegisterOptions -> IO () componentGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> GhcOptions componentCcGhcOptions :: Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> 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 -- | The kinds of entries we can stick in a .ghc.environment file. data GhcEnvironmentFileEntry -- |
--   -- a comment
--   
GhcEnvFileComment :: String -> GhcEnvironmentFileEntry -- |
--   package-id foo-1.0-4fe301a...
--   
GhcEnvFilePackageId :: UnitId -> GhcEnvironmentFileEntry -- | global-package-db, user-package-db or package-db -- blahpackage.conf.d GhcEnvFilePackageDb :: PackageDB -> GhcEnvironmentFileEntry -- |
--   clear-package-db
--   
GhcEnvFileClearPackageDbStack :: GhcEnvironmentFileEntry -- | 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 :: PackageDBStack -> [UnitId] -> [GhcEnvironmentFileEntry] -- | 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. writeGhcEnvironmentFile :: FilePath -> Platform -> Version -> [GhcEnvironmentFileEntry] -> NoCallStackIO () 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 -> GhcImplInfo -- | [supportsHaskell2010] :: GhcImplInfo -> Bool -- | [reportsNoExt] :: GhcImplInfo -> Bool -- | NondecreasingIndentation is always on [alwaysNondecIndent] :: GhcImplInfo -> Bool -- | [flagGhciScript] :: GhcImplInfo -> Bool -- | new style -fprof-auto* flags [flagProfAuto] :: GhcImplInfo -> Bool -- | use package-conf instead of package-db [flagPackageConf] :: GhcImplInfo -> Bool -- | [flagDebugInfo] :: GhcImplInfo -> Bool -- | picks up .ghc.environment files [supportsPkgEnvFiles] :: GhcImplInfo -> Bool -- | [flagWarnMissingHomeModules] :: GhcImplInfo -> Bool -- | 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 () -- | 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 generate :: 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 module Distribution.Simple.Test.LibV09 runTest :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> 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 -> NoCallStackIO () -- | Write the source file for a library TestSuite stub -- executable. writeSimpleTestStub :: TestSuite -> FilePath -> NoCallStackIO () module Distribution.Simple.Test.ExeV10 runTest :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> TestFlags -> TestSuite -> IO TestSuiteLog -- | This is about the cabal configurations feature. It exports -- finalizePD and flattenPackageDescription which are -- functions for converting GenericPackageDescriptions down to -- PackageDescriptions. It has code for working with the tree of -- conditions and resolving or flattening conditions. module Distribution.PackageDescription.Configuration -- | Create a package description with all configurations resolved. -- -- This function takes a GenericPackageDescription and several -- environment parameters and tries to generate PackageDescription -- by finding a flag assignment that result in satisfiable dependencies. -- -- It takes as inputs a not necessarily complete specifications of flags -- assignments, an optional package index as well as platform parameters. -- If some flags are not assigned explicitly, this function will try to -- pick an assignment that causes this function to succeed. The package -- index is optional since on some platforms we cannot determine which -- packages have been installed before. When no package index is -- supplied, every dependency is assumed to be satisfiable, therefore all -- not explicitly assigned flags will get their default values. -- -- This function will fail if it cannot find a flag assignment that leads -- to satisfiable dependencies. (It will not try alternative assignments -- for explicitly specified flags.) In case of failure it will return the -- missing dependencies that it encountered when trying different flag -- assignments. On success, it will return the package description and -- the full flag assignment chosen. -- -- Note that this drops any stanzas which have buildable: False. -- While this is arguably the right thing to do, it means we give bad -- error messages in some situations, see #3858. finalizePD :: FlagAssignment -> ComponentRequestedSpec -> (Dependency -> Bool) -> Platform -> CompilerInfo -> [Dependency] -> GenericPackageDescription -> Either [Dependency] (PackageDescription, FlagAssignment) -- | Deprecated: This function now always assumes tests and benchmarks -- are disabled; use finalizePD with ComponentRequestedSpec to specify -- something more specific. finalizePackageDescription :: FlagAssignment -> (Dependency -> Bool) -> Platform -> CompilerInfo -> [Dependency] -> GenericPackageDescription -> Either [Dependency] (PackageDescription, FlagAssignment) -- | Flatten a generic package description by ignoring all conditions and -- just join the field descriptors into on package description. Note, -- however, that this may lead to inconsistent field values, since all -- values are joined into one field, which may not be possible in the -- original package description, due to the use of exclusive choices (if -- ... else ...). -- -- TODO: One particularly tricky case is defaulting. In the original -- package description, e.g., the source directory might either be the -- default or a certain, explicitly set path. Since defaults are filled -- in only after the package has been resolved and when no explicit value -- has been set, the default path will be missing from the package -- description returned by this function. flattenPackageDescription :: GenericPackageDescription -> PackageDescription -- | Parse a configuration condition from a string. parseCondition :: ReadP r (Condition ConfVar) freeVars :: CondTree ConfVar c a -> [FlagName] -- | Extract the condition matched by the given predicate from a cond tree. -- -- We use this mainly for extracting buildable conditions (see the Note -- above), but the function is in fact more general. extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v -- | Extract conditions matched by the given predicate from all cond trees -- in a GenericPackageDescription. extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription -> [Condition ConfVar] -- | Transforms a CondTree by putting the input under the "then" -- branch of a conditional that is True when Buildable is True. If -- addBuildableCondition can determine that Buildable is always -- True, it returns the input unchanged. If Buildable is always False, it -- returns the empty CondTree. addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo) -> CondTree v c a -> CondTree v c a mapCondTree :: (a -> b) -> (c -> d) -> (Condition v -> Condition w) -> CondTree v c a -> CondTree w d b mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b mapTreeConds :: (Condition v -> Condition w) -> CondTree v c a -> CondTree w c a mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d a transformAllBuildInfos :: (BuildInfo -> BuildInfo) -> (SetupBuildInfo -> SetupBuildInfo) -> GenericPackageDescription -> GenericPackageDescription -- | Walk a GenericPackageDescription and apply f to all -- nested build-depends fields. transformAllBuildDepends :: (Dependency -> Dependency) -> GenericPackageDescription -> GenericPackageDescription instance GHC.Show.Show Distribution.PackageDescription.Configuration.PDTagged instance GHC.Base.Monoid Distribution.PackageDescription.Configuration.PDTagged instance Data.Semigroup.Semigroup Distribution.PackageDescription.Configuration.PDTagged instance Data.Semigroup.Semigroup d => GHC.Base.Monoid (Distribution.PackageDescription.Configuration.DepTestRslt d) instance Data.Semigroup.Semigroup d => Data.Semigroup.Semigroup (Distribution.PackageDescription.Configuration.DepTestRslt d) -- | This defined parsers and partial pretty printers for the -- .cabal format. Some of the complexity in this module is due -- to the fact that we have to be backwards compatible with old -- .cabal files, so there's code to translate into the newer -- structure. module Distribution.PackageDescription.Parse -- | Parse the given package file. readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription -- | Parses the given file into a GenericPackageDescription. -- -- In Cabal 1.2 the syntax for package descriptions was changed to a -- format with sections and possibly indented property descriptions. parseGenericPackageDescription :: String -> ParseResult GenericPackageDescription -- | Deprecated: Use readGenericPackageDescription, old name is -- misleading. readPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription -- | Deprecated: Use parseGenericPackageDescription, old name is -- misleading parsePackageDescription :: String -> ParseResult GenericPackageDescription data ParseResult a ParseFailed :: PError -> ParseResult a ParseOk :: [PWarning] -> a -> ParseResult a -- | Field descriptor. The parameter a parameterizes over where -- the field's value is stored in. data FieldDescr a FieldDescr :: String -> (a -> Doc) -> (LineNo -> String -> a -> ParseResult a) -> FieldDescr a [fieldName] :: FieldDescr a -> String [fieldGet] :: FieldDescr a -> a -> Doc -- | fieldSet n str x Parses the field value from the given input -- string str and stores the result in x if the parse -- was successful. Otherwise, reports an error on line number n. [fieldSet] :: FieldDescr a -> LineNo -> String -> a -> ParseResult a type LineNo = Int -- | An intermediate type just used for parsing the test-suite stanza. -- After validation it is converted into the proper TestSuite -- type. data TestSuiteStanza TestSuiteStanza :: Maybe TestType -> Maybe FilePath -> Maybe ModuleName -> BuildInfo -> TestSuiteStanza [testStanzaTestType] :: TestSuiteStanza -> Maybe TestType [testStanzaMainIs] :: TestSuiteStanza -> Maybe FilePath [testStanzaTestModule] :: TestSuiteStanza -> Maybe ModuleName [testStanzaBuildInfo] :: TestSuiteStanza -> BuildInfo -- | An intermediate type just used for parsing the benchmark stanza. After -- validation it is converted into the proper Benchmark type. data BenchmarkStanza BenchmarkStanza :: Maybe BenchmarkType -> Maybe FilePath -> Maybe ModuleName -> BuildInfo -> BenchmarkStanza [benchmarkStanzaBenchmarkType] :: BenchmarkStanza -> Maybe BenchmarkType [benchmarkStanzaMainIs] :: BenchmarkStanza -> Maybe FilePath [benchmarkStanzaBenchmarkModule] :: BenchmarkStanza -> Maybe ModuleName [benchmarkStanzaBuildInfo] :: BenchmarkStanza -> BuildInfo readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo pkgDescrFieldDescrs :: [FieldDescr PackageDescription] libFieldDescrs :: [FieldDescr Library] foreignLibFieldDescrs :: [FieldDescr ForeignLib] executableFieldDescrs :: [FieldDescr Executable] binfoFieldDescrs :: [FieldDescr BuildInfo] sourceRepoFieldDescrs :: [FieldDescr SourceRepo] testSuiteFieldDescrs :: [FieldDescr TestSuiteStanza] benchmarkFieldDescrs :: [FieldDescr BenchmarkStanza] flagFieldDescrs :: [FieldDescr Flag] instance GHC.Base.Functor f => GHC.Base.Functor (Distribution.PackageDescription.Parse.StT s f) instance GHC.Base.Monad m => GHC.Base.Applicative (Distribution.PackageDescription.Parse.StT s m) instance GHC.Base.Monad m => GHC.Base.Monad (Distribution.PackageDescription.Parse.StT s m) -- | Pretty printing for cabal files module Distribution.PackageDescription.PrettyPrint -- | Writes a .cabal file from a generic package description writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> NoCallStackIO () -- | Writes a generic package description to a string showGenericPackageDescription :: GenericPackageDescription -> String -- |
--   since 1.26.0.0
--   
writePackageDescription :: FilePath -> PackageDescription -> NoCallStackIO () -- |
--   since 1.26.0.0
--   
showPackageDescription :: PackageDescription -> String -- |
--   since 1.26.0.0
--   
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> NoCallStackIO () -- |
--   since 1.26.0.0
--   
showHookedBuildInfo :: HookedBuildInfo -> 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 -- check so we can see which ones are appropriate to report in different -- situations. This code gets uses when configuring a package when we -- consider only basic problems. The higher standard is uses when 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 -- | 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 :: String -> PackageCheck [explanation] :: PackageCheck -> String -- | 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 :: String -> PackageCheck [explanation] :: PackageCheck -> String -- | 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 :: String -> PackageCheck [explanation] :: PackageCheck -> String -- | Like PackageDistSuspicious but will only display warnings rather than -- causing abnormal exit when you run 'cabal check'. PackageDistSuspiciousWarn :: String -> PackageCheck [explanation] :: PackageCheck -> String -- | 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 :: String -> PackageCheck [explanation] :: PackageCheck -> String -- | 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. -- -- It requires the GenericPackageDescription and optionally a -- particular configuration of that package. If you pass Nothing -- then we just check a version of the generic description using -- flattenPackageDescription. checkPackage :: GenericPackageDescription -> Maybe PackageDescription -> [PackageCheck] checkConfiguredPackage :: PackageDescription -> [PackageCheck] -- | Sanity check things that requires IO. It looks at the files in the -- package and expects to find the package unpacked in at the given file -- path. checkPackageFiles :: PackageDescription -> FilePath -> NoCallStackIO [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 -> PackageDescription -> m [PackageCheck] -- | A record of operations needed to check the contents of packages. Used -- by checkPackageContent. data CheckPackageContentOps m CheckPackageContentOps :: (FilePath -> m Bool) -> (FilePath -> m Bool) -> (FilePath -> m [FilePath]) -> (FilePath -> m String) -> 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 String -- | Check the names of all files in a package for portability problems. -- This should be done for example when creating or validating a package -- tarball. checkPackageFileNames :: [FilePath] -> [PackageCheck] instance GHC.Classes.Eq Distribution.PackageDescription.Check.PackageCheck instance GHC.Show.Show Distribution.PackageDescription.Check.PackageCheck -- | 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: -- -- module Distribution.Make -- | Indicates the license under which a package's source code is released. -- Versions of the licenses not listed here will be rejected by Hackage -- and cause cabal check to issue a warning. data License -- | GNU General Public License, version 2 or version 3. GPL :: (Maybe Version) -> License -- | GNU Affero General Public License, version 3. AGPL :: (Maybe Version) -> License -- | GNU Lesser General Public License, version 2.1 or version -- 3. LGPL :: (Maybe Version) -> License -- | 2-clause BSD license. BSD2 :: License -- | 3-clause BSD license. BSD3 :: License -- | 4-clause BSD license. This license has not been approved by the -- OSI and is incompatible with the GNU GPL. It is provided for -- historical reasons and should be avoided. BSD4 :: License -- | MIT license. MIT :: License -- | ISC license ISC :: License -- | Mozilla Public License, version 2.0. MPL :: Version -> License -- | Apache License, version 2.0. Apache :: (Maybe Version) -> License -- | The author of a package disclaims any copyright to its source code and -- dedicates it to the public domain. This is not a software license. -- Please note that it is not possible to dedicate works to the public -- domain in every jurisdiction, nor is a work that is in the public -- domain in one jurisdiction necessarily in the public domain elsewhere. PublicDomain :: License -- | Explicitly 'All Rights Reserved', eg for proprietary software. The -- package may not be legally modified or redistributed by anyone but the -- rightsholder. AllRightsReserved :: License -- | No license specified which legally defaults to 'All Rights Reserved'. -- The package may not be legally modified or redistributed by anyone but -- the rightsholder. UnspecifiedLicense :: License -- | Any other software license. OtherLicense :: License -- | Indicates an erroneous license name. UnknownLicense :: String -> License -- | A Version represents the version of a software entity. -- -- Instances of Eq and Ord are provided, which gives exact -- equality and lexicographic ordering of the version number components -- (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2, etc.). -- -- This type is opaque and distinct from the Version type in -- Data.Version since Cabal-2.0. The difference extends -- to the Binary instance using a different (and more compact) -- encoding. data Version defaultMain :: IO () defaultMainArgs :: [String] -> IO () -- | Deprecated: it ignores its PackageDescription arg defaultMainNoRead :: PackageDescription -> 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 -> NoCallStackIO ModTime -- | Return age of given file in days. getFileAge :: FilePath -> NoCallStackIO Double -- | Return the current time as ModTime. getCurTime :: NoCallStackIO 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 Data.Binary.Class.Binary 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] -> 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' :: Text 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 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 -> FilePath -> FilePath initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO () doesPackageDBExist :: FilePath -> NoCallStackIO Bool -- | Create an empty package DB at the specified location. createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO () deletePackageDB :: FilePath -> NoCallStackIO () -- | Compute the AbiHash of a library that we built inplace. abiHash :: Verbosity -> PackageDescription -> FilePath -> 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 -> PackageDBStack -> [String] -> IO () registerPackage :: Verbosity -> Compiler -> ProgramDb -> PackageDBStack -> 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 -> FilePath -> 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 :: FilePath -> FilePath -> 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 defines a PreProcessor abstraction which represents a -- pre-processor that can transform one kind of file into another. There -- is also a PPSuffixHandler which is a combination of a file -- extension and a function for configuring a PreProcessor. It -- 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). 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 [FilePath] -- | Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and -- cpphs. knownSuffixHandlers :: [PPSuffixHandler] -- | Convenience function; get the suffixes of these preprocessors. ppSuffixes :: [PPSuffixHandler] -> [String] -- | A preprocessor for turning non-Haskell files with the given extension -- into plain Haskell source files. type PPSuffixHandler = (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor) -- | 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 -> ((FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()) -> PreProcessor [platformIndependent] :: PreProcessor -> Bool [runPreProcessor] :: PreProcessor -> (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () 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] -- | 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. -- -- data UserHooks UserHooks :: (Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()) -> 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 -> SDistFlags -> IO HookedBuildInfo) -> (PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO ()) -> (Args -> SDistFlags -> PackageDescription -> Maybe 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 -> DoctestFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO ()) -> (Args -> DoctestFlags -> 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 -- | Used for ./setup test -- | Deprecated: Please use the new testing interface instead! [runTests] :: UserHooks -> Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () -- | 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 sdist command. Second arg indicates verbosity -- level. [preSDist] :: UserHooks -> Args -> SDistFlags -> IO HookedBuildInfo -- | Over-ride this hook to get different behavior during sdist. [sDistHook] :: UserHooks -> PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO () -- | Hook to run after sdist command. Second arg indicates verbosity level. [postSDist] :: UserHooks -> Args -> SDistFlags -> PackageDescription -> Maybe 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 doctest command. Second arg indicates verbosity -- level. [preDoctest] :: UserHooks -> Args -> DoctestFlags -> IO HookedBuildInfo -- | Over-ride this hook to get different behavior during doctest. [doctestHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO () -- | Hook to run after doctest command. Second arg indicates verbosity -- level. [postDoctest] :: UserHooks -> Args -> DoctestFlags -> 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 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 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 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 -> Maybe LocalBuildInfo -> SDistFlags -> (FilePath -> FilePath) -> [PPSuffixHandler] -> IO () printPackageProblems :: Verbosity -> PackageDescription -> IO () -- | Prepare a directory tree of source files. prepareTree :: Verbosity -> PackageDescription -> Maybe LocalBuildInfo -> FilePath -> [PPSuffixHandler] -> IO () -- | Create an archive from a tree of source files, and clean up the tree. createArchive :: CreateArchiveFun -- | 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 -> PackageDescription -> Maybe LocalBuildInfo -> 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. Returns a tuple of lists: first -- component is a list of ordinary files, second one is a list of those -- files that may be executable. listPackageSources :: Verbosity -> PackageDescription -> [PPSuffixHandler] -> IO ([FilePath], [FilePath]) -- | 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 -- | After running configure, output the LocalBuildInfo to the -- localBuildInfoFile. writePersistBuildConfig :: FilePath -> LocalBuildInfo -> NoCallStackIO () -- | 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 :: FilePath -> 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 :: FilePath -> IO LocalBuildInfo -- | Check that localBuildInfoFile is up-to-date with respect to the .cabal -- file. checkPersistBuildConfigOutdated :: FilePath -> FilePath -> NoCallStackIO Bool -- | Try to read the localBuildInfoFile. tryGetPersistBuildConfig :: FilePath -> IO (Either ConfigStateFileError LocalBuildInfo) -- | Try to read the localBuildInfoFile. maybeGetPersistBuildConfig :: FilePath -> 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 :: FilePath -> Flag FilePath -> NoCallStackIO FilePath -- | 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 FilePath -> NoCallStackIO FilePath -- | 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. getInternalPackages :: GenericPackageDescription -> Map PackageName (Maybe UnqualComponentName) -- | 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): -- --
    --
  1. 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.
  2. --
  3. In GHC 7.8, the string had to be a valid package identifier like -- foo-0.1.
  4. --
-- -- 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: -- -- -- -- The mapping for GHC 7.10: -- -- computeCompatPackageKey :: Compiler -> MungedPackageName -> Version -> UnitId -> String -- | Computes the package name for a library. If this is the public -- library, it will just be the original package name; otherwise, it will -- be a munged package name recording the original package name as well -- as the name of the internal library. -- -- A lot of tooling in the Haskell ecosystem assumes that if something is -- installed to the package database with the package name foo, -- then it actually is an entry for the (only public) library in package -- foo. With internal packages, this is not necessarily true: a -- public library as well as arbitrarily many internal libraries may come -- from the same package. To prevent tools from getting confused in this -- case, the package name of these internal libraries is munged so that -- they do not conflict the public library proper. A particular case -- where this matters is ghc-pkg: if we don't munge the package name, the -- inplace registration will OVERRIDE a different internal library. -- -- We munge into a reserved namespace, "z-", and encode both the -- component name and the package name of an internal library using the -- following format: -- -- compat-pkg-name ::= "z-" package-name "-z-" library-name -- -- where package-name and library-name have "-" ( "z" + ) "-" segments -- encoded by adding an extra "z". -- -- When we have the public library, the compat-pkg-name is just the -- package-name, no surprises there! computeCompatPackageName :: PackageName -> Maybe UnqualComponentName -> MungedPackageName -- | Get the path of dist/setup-config. localBuildInfoFile :: FilePath -> FilePath -- | List all installed packages in the given package databases. getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> 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 -> PackageDBStack -> ProgramDb -> Platform -> IO [FilePath] -- | 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 -> PackageDB -> ProgramDb -> IO InstalledPackageIndex -- | Deprecated: configCompiler is deprecated. Use -- configCompilerEx instead. configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> Verbosity -> IO (Compiler, ProgramDb) -- | Deprecated: configCompilerAux is deprecated. Use -- configCompilerAuxEx instead. configCompilerAux :: ConfigFlags -> IO (Compiler, ProgramDb) 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) -- | 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"]
--   return (ccldOptionsBuildInfo (words ccflags) (words ldflags))
--   
ccLdOptionsBuildInfo :: [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 PackageDB] -> PackageDBStack -- | 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 :: ConfigStateFileError -- | Mismatched version. ConfigStateFileBadVersion :: PackageIdentifier -> PackageIdentifier -> (Either ConfigStateFileError LocalBuildInfo) -> ConfigStateFileError -- | Read the localBuildInfoFile, returning either an error or the -- local build info. tryGetConfigStateFile :: FilePath -> IO (Either ConfigStateFileError LocalBuildInfo) platformDefines :: LocalBuildInfo -> [String] -- | Relax the dependencies of this package if needed. relaxPackageDeps :: (VersionRange -> VersionRange) -> RelaxDeps -> GenericPackageDescription -> GenericPackageDescription instance GHC.Show.Show Distribution.Simple.Configure.ConfigStateFileError instance GHC.Exception.Exception Distribution.Simple.Configure.ConfigStateFileError -- | 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 () repl :: PackageDescription -> LocalBuildInfo -> ReplFlags -> [PPSuffixHandler] -> [String] -> IO () -- | Start an interpreter without loading any package files. startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform -> PackageDBStack -> IO () -- | Runs componentInitialBuildSteps on every configured component. initialBuildSteps :: FilePath -> PackageDescription -> LocalBuildInfo -> Verbosity -> IO () -- | Creates the autogenerated files for a particular configured component. componentInitialBuildSteps :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Verbosity -> IO () -- | Generate and write out the Paths_pkg.hs and cabal_macros.h -- files writeAutogenFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> 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 () hscolour :: 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) -> NoCallStackIO ([(FilePath, Maybe FilePath)], Maybe String) instance GHC.Generics.Generic Distribution.Simple.Haddock.HaddockArgs 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.Base.Monoid Distribution.Simple.Haddock.HaddockArgs instance Data.Semigroup.Semigroup Distribution.Simple.Haddock.HaddockArgs instance GHC.Base.Monoid Distribution.Simple.Haddock.Directory instance Data.Semigroup.Semigroup Distribution.Simple.Haddock.Directory -- | This module deals with the doctest command. module Distribution.Simple.Doctest doctest :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> DoctestFlags -> IO () instance GHC.Generics.Generic Distribution.Simple.Doctest.DoctestArgs instance GHC.Show.Show Distribution.Simple.Doctest.DoctestArgs instance GHC.Base.Monoid Distribution.Simple.Doctest.DoctestArgs instance Data.Semigroup.Semigroup Distribution.Simple.Doctest.DoctestArgs -- | 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. -- -- data UserHooks UserHooks :: (Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()) -> 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 -> SDistFlags -> IO HookedBuildInfo) -> (PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO ()) -> (Args -> SDistFlags -> PackageDescription -> Maybe 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 -> DoctestFlags -> IO HookedBuildInfo) -> (PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO ()) -> (Args -> DoctestFlags -> 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 -- | Used for ./setup test -- | Deprecated: Please use the new testing interface instead! [runTests] :: UserHooks -> Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () -- | 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 sdist command. Second arg indicates verbosity -- level. [preSDist] :: UserHooks -> Args -> SDistFlags -> IO HookedBuildInfo -- | Over-ride this hook to get different behavior during sdist. [sDistHook] :: UserHooks -> PackageDescription -> Maybe LocalBuildInfo -> UserHooks -> SDistFlags -> IO () -- | Hook to run after sdist command. Second arg indicates verbosity level. [postSDist] :: UserHooks -> Args -> SDistFlags -> PackageDescription -> Maybe 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 doctest command. Second arg indicates verbosity -- level. [preDoctest] :: UserHooks -> Args -> DoctestFlags -> IO HookedBuildInfo -- | Over-ride this hook to get different behavior during doctest. [doctestHook] :: UserHooks -> PackageDescription -> LocalBuildInfo -> UserHooks -> DoctestFlags -> IO () -- | Hook to run after doctest command. Second arg indicates verbosity -- level. [postDoctest] :: UserHooks -> Args -> DoctestFlags -> 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 () -- | 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 () -- | Hooks that correspond to a plain instantiation of the "simple" build -- system simpleUserHooks :: UserHooks autoconfUserHooks :: UserHooks -- | Basic autoconf UserHooks: -- -- -- -- Thus configure can use local system information to generate -- package.buildinfo and possibly other files. -- | Deprecated: Use simpleUserHooks or autoconfUserHooks, unless you -- need Cabal-1.2 compatibility in which case you must stick with -- defaultUserHooks defaultUserHooks :: UserHooks -- | Empty UserHooks which do nothing. emptyUserHooks :: UserHooks -- | Optional auxiliary package information file -- (pkgname.buildinfo) defaultHookedPackageDesc :: IO (Maybe FilePath)