-- 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 3.3.0.0 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.Directory -- | listDirectory dir returns a list of all entries -- in dir without the special entries (. and -- ..). -- -- The operation may fail with: -- --
-- "png" `isExtensionOf` "/directory/file.png" == True -- ".png" `isExtensionOf` "/directory/file.png" == True -- ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True -- "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False -- "png" `isExtensionOf` "/directory/file.png.jpg" == False -- "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False --isExtensionOf :: String -> FilePath -> Bool -- | Drop the given extension from a FilePath, and the "." -- preceding it. Returns Nothing if the FilePath does not have the -- given extension, or Just and the part before the extension if -- it does. -- -- This function can be more predictable than dropExtensions, -- especially if the filename might itself contain . characters. -- --
-- stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x" -- stripExtension "hi.o" "foo.x.hs.o" == Nothing -- dropExtension x == fromJust (stripExtension (takeExtension x) x) -- dropExtensions x == fromJust (stripExtension (takeExtensions x) x) -- stripExtension ".c.d" "a.b.c.d" == Just "a.b" -- stripExtension ".c.d" "a.b..c.d" == Just "a.b." -- stripExtension "baz" "foo.bar" == Nothing -- stripExtension "bar" "foobar" == Nothing -- stripExtension "" x == Just x --stripExtension :: String -> FilePath -> Maybe FilePath -- | Per Conor McBride, the Newtype typeclass represents the packing -- and unpacking of a newtype, and allows you to operatate under that -- newtype with functions such as ala. module Distribution.Compat.Newtype -- | The FunctionalDependencies version of Newtype -- type-class. -- -- Since Cabal-3.0 class arguments are in a different order than in -- newtype package. This change is to allow usage with -- DeriveAnyClass (and DerivingStrategies, in GHC-8.2). -- Unfortunately one have to repeat inner type. -- --
-- newtype New = New Old -- deriving anyclass (Newtype Old) ---- -- Another approach would be to use TypeFamilies (and possibly -- compute inner type using GHC.Generics), but we think -- FunctionalDependencies version gives cleaner type signatures. class Newtype o n | n -> o pack :: Newtype o n => o -> n pack :: (Newtype o n, Coercible o n) => o -> n unpack :: Newtype o n => n -> o unpack :: (Newtype o n, Coercible n o) => n -> o -- |
-- >>> ala Sum foldMap [1, 2, 3, 4 :: Int] -- 10 ---- -- Note: the user supplied function for the newtype is -- ignored. -- --
-- >>> ala (Sum . (+1)) foldMap [1, 2, 3, 4 :: Int] -- 10 --ala :: (Newtype o n, Newtype o' n') => (o -> n) -> ((o -> n) -> b -> n') -> b -> o' -- |
-- >>> alaf Sum foldMap length ["cabal", "install"] -- 12 ---- -- Note: as with ala, the user supplied function for the -- newtype is ignored. alaf :: (Newtype o n, Newtype o' n') => (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o' -- | Variant of pack, which takes a phantom type. pack' :: Newtype o n => (o -> n) -> o -> n -- | Variant of pack, which takes a phantom type. unpack' :: Newtype o n => (o -> n) -> n -> o instance Distribution.Compat.Newtype.Newtype a (Data.Functor.Identity.Identity a) instance Distribution.Compat.Newtype.Newtype a (Data.Semigroup.Internal.Sum a) instance Distribution.Compat.Newtype.Newtype a (Data.Semigroup.Internal.Product a) instance Distribution.Compat.Newtype.Newtype (a -> a) (Data.Semigroup.Internal.Endo a) module Distribution.Compat.Process -- | createProcess with process jobs enabled when appropriate. See -- enableProcessJobs. createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -- | runInteractiveProcess with process jobs enabled when -- appropriate. See enableProcessJobs. runInteractiveProcess :: FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> IO (Handle, Handle, Handle, ProcessHandle) -- | rawSystem with process jobs enabled when appropriate. See -- enableProcessJobs. rawSystem :: String -> [String] -> IO ExitCode -- | Enable process jobs to ensure accurate determination of process -- completion in the presence of exec(3) on Windows. -- -- Unfortunately the process job support is badly broken in -- process releases prior to 1.6.8, so we disable it in these -- versions, despite the fact that this means we may see sporatic build -- failures without jobs. enableProcessJobs :: CreateProcess -> CreateProcess module Distribution.Compat.Stack type WithCallStack a = HasCallStack => a -- | CallStacks are a lightweight method of obtaining a partial -- call-stack at any point in the program. -- -- A function can request its call-site with the HasCallStack -- constraint. For example, we can define -- --
-- putStrLnWithCallStack :: HasCallStack => String -> IO () ---- -- as a variant of putStrLn that will get its call-site and -- print it, along with the string given as argument. We can access the -- call-stack inside putStrLnWithCallStack with -- callStack. -- --
-- putStrLnWithCallStack :: HasCallStack => String -> IO () -- putStrLnWithCallStack msg = do -- putStrLn msg -- putStrLn (prettyCallStack callStack) ---- -- Thus, if we call putStrLnWithCallStack we will get a -- formatted call-stack alongside our string. -- --
-- >>> putStrLnWithCallStack "hello" -- hello -- CallStack (from HasCallStack): -- putStrLnWithCallStack, called at <interactive>:2:1 in interactive:Ghci1 ---- -- GHC solves HasCallStack constraints in three steps: -- --
-- >>> showMD5 (Fingerprint 123 456) -- "000000000000007b00000000000001c8" ---- --
-- >>> showMD5 $ md5 $ BS.pack [0..127] -- "37eff01866ba3f538421b30b7cbefcac" ---- -- @since 3.2.0.0 showMD5 :: MD5 -> String -- | @since 3.2.0.0 md5 :: ByteString -> MD5 -- | @since 3.2.0.0 binaryPutMD5 :: MD5 -> Put -- | @since 3.2.0.0 binaryGetMD5 :: Get MD5 -- | Structurally tag binary serialisaton stream. Useful when most -- Binary instances are Generic derived. -- -- Say you have a data type -- --
-- data Record = Record -- { _recordFields :: HM.HashMap Text (Integer, ByteString) -- , _recordEnabled :: Bool -- } -- deriving (Eq, Show, Generic) -- -- instance Binary Record -- instance Structured Record ---- -- then you can serialise and deserialise Record values with a -- structure tag by simply -- --
-- structuredEncode record :: ByteString -- structuredDecode lbs :: IO Record ---- -- If structure of Record changes in between, deserialisation -- will fail early. -- -- Technically, Structured is not related to Binary, and -- may be useful in other uses. module Distribution.Utils.Structured -- | Structured encode. Encode a value to using binary serialisation -- to a lazy ByteString. Encoding starts with 16 byte large -- structure hash. structuredEncode :: forall a. (Binary a, Structured a) => a -> ByteString -- | Lazily serialise a value to a file structuredEncodeFile :: (Binary a, Structured a) => FilePath -> a -> IO () -- | Structured decode. Decode a value from a lazy -- ByteString, reconstructing the original structure. Throws pure -- exception on invalid inputs. structuredDecode :: forall a. (Binary a, Structured a) => ByteString -> a structuredDecodeOrFailIO :: (Binary a, Structured a) => ByteString -> IO (Either String a) -- | Lazily reconstruct a value previously written to a file. structuredDecodeFileOrFail :: (Binary a, Structured a) => FilePath -> IO (Either String a) -- | Class of types with a known Structure. -- -- For regular data types Structured can be derived generically. -- --
-- data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic) -- instance Structured Record --class Typeable a => Structured a structure :: Structured a => Proxy a -> Structure structure :: (Structured a, Generic a, GStructured (Rep a)) => Proxy a -> Structure type MD5 = Fingerprint -- | Semantically hashStructure . structure. structureHash :: forall a. Structured a => Proxy a -> MD5 -- | Flatten Structure into something we can calculate hash of. -- -- As Structure can be potentially infinite. For mutually -- recursive types, we keep track of TypeReps, and put just -- TypeRep name when it's occurred another time. structureBuilder :: Structure -> Builder -- | Derive structure genrically. genericStructure :: forall a. (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure -- | Used to implement genericStructure. class GStructured (f :: Type -> Type) -- | Use Typeable to infer name nominalStructure :: Typeable a => Proxy a -> Structure containerStructure :: forall f a. (Typeable f, Structured a) => Proxy (f a) -> Structure -- | Structure of a datatype. -- -- It can be infinite, as far as TypeReps involved are finite. -- (e.g. polymorphic recursion might cause troubles). data Structure -- | nominal, yet can be parametrised by other structures. Nominal :: !TypeRep -> !TypeVersion -> TypeName -> [Structure] -> Structure -- | a newtype wrapper Newtype :: !TypeRep -> !TypeVersion -> TypeName -> Structure -> Structure -- | sum-of-products structure Structure :: !TypeRep -> !TypeVersion -> TypeName -> SopStructure -> Structure type TypeName = String type ConstructorName = String -- | A sematic version of a data type. Usually 0. type TypeVersion = Word32 type SopStructure = [(ConstructorName, [Structure])] -- | A MD5 hash digest of Structure. hashStructure :: Structure -> MD5 -- | A van-Laarhoven lens into TypeVersion of Structure -- --
-- typeVersion :: Lens' Structure TypeVersion --typeVersion :: Functor f => (TypeVersion -> f TypeVersion) -> Structure -> f Structure -- | A van-Laarhoven lens into TypeName of Structure -- --
-- typeName :: Lens' Structure TypeName --typeName :: Functor f => (TypeName -> f TypeName) -> Structure -> f Structure instance GHC.Generics.Generic Distribution.Utils.Structured.Structure instance GHC.Show.Show Distribution.Utils.Structured.Structure instance GHC.Classes.Ord Distribution.Utils.Structured.Structure instance GHC.Classes.Eq Distribution.Utils.Structured.Structure instance (i GHC.Types.~ GHC.Generics.C, GHC.Generics.Constructor c, Distribution.Utils.Structured.GStructuredProd f) => Distribution.Utils.Structured.GStructuredSum (GHC.Generics.M1 i c f) instance (i GHC.Types.~ GHC.Generics.S, Distribution.Utils.Structured.GStructuredProd f) => Distribution.Utils.Structured.GStructuredProd (GHC.Generics.M1 i c f) instance Distribution.Utils.Structured.Structured c => Distribution.Utils.Structured.GStructuredProd (GHC.Generics.K1 i c) instance Distribution.Utils.Structured.GStructuredProd GHC.Generics.U1 instance (Distribution.Utils.Structured.GStructuredProd f, Distribution.Utils.Structured.GStructuredProd g) => Distribution.Utils.Structured.GStructuredProd (f GHC.Generics.:*: g) instance (i GHC.Types.~ GHC.Generics.D, GHC.Generics.Datatype c, Distribution.Utils.Structured.GStructuredSum f) => Distribution.Utils.Structured.GStructured (GHC.Generics.M1 i c f) instance (Distribution.Utils.Structured.GStructuredSum f, Distribution.Utils.Structured.GStructuredSum g) => Distribution.Utils.Structured.GStructuredSum (f GHC.Generics.:+: g) instance Distribution.Utils.Structured.GStructuredSum GHC.Generics.V1 instance Distribution.Utils.Structured.Structured a => Data.Binary.Class.Binary (Distribution.Utils.Structured.Tag a) instance Distribution.Utils.Structured.Structured () instance Distribution.Utils.Structured.Structured GHC.Types.Bool instance Distribution.Utils.Structured.Structured GHC.Types.Ordering instance Distribution.Utils.Structured.Structured GHC.Types.Char instance Distribution.Utils.Structured.Structured GHC.Types.Int instance Distribution.Utils.Structured.Structured GHC.Integer.Type.Integer instance Distribution.Utils.Structured.Structured GHC.Types.Word instance Distribution.Utils.Structured.Structured GHC.Int.Int8 instance Distribution.Utils.Structured.Structured GHC.Int.Int16 instance Distribution.Utils.Structured.Structured GHC.Int.Int32 instance Distribution.Utils.Structured.Structured GHC.Int.Int64 instance Distribution.Utils.Structured.Structured GHC.Word.Word8 instance Distribution.Utils.Structured.Structured GHC.Word.Word16 instance Distribution.Utils.Structured.Structured GHC.Word.Word32 instance Distribution.Utils.Structured.Structured GHC.Word.Word64 instance Distribution.Utils.Structured.Structured GHC.Types.Float instance Distribution.Utils.Structured.Structured GHC.Types.Double instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (GHC.Maybe.Maybe a) instance (Distribution.Utils.Structured.Structured a, Distribution.Utils.Structured.Structured b) => Distribution.Utils.Structured.Structured (Data.Either.Either a b) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (GHC.Real.Ratio a) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured [a] instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (GHC.Base.NonEmpty a) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2) => Distribution.Utils.Structured.Structured (a1, a2) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2, Distribution.Utils.Structured.Structured a3) => Distribution.Utils.Structured.Structured (a1, a2, a3) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2, Distribution.Utils.Structured.Structured a3, Distribution.Utils.Structured.Structured a4) => Distribution.Utils.Structured.Structured (a1, a2, a3, a4) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2, Distribution.Utils.Structured.Structured a3, Distribution.Utils.Structured.Structured a4, Distribution.Utils.Structured.Structured a5) => Distribution.Utils.Structured.Structured (a1, a2, a3, a4, a5) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2, Distribution.Utils.Structured.Structured a3, Distribution.Utils.Structured.Structured a4, Distribution.Utils.Structured.Structured a5, Distribution.Utils.Structured.Structured a6) => Distribution.Utils.Structured.Structured (a1, a2, a3, a4, a5, a6) instance (Distribution.Utils.Structured.Structured a1, Distribution.Utils.Structured.Structured a2, Distribution.Utils.Structured.Structured a3, Distribution.Utils.Structured.Structured a4, Distribution.Utils.Structured.Structured a5, Distribution.Utils.Structured.Structured a6, Distribution.Utils.Structured.Structured a7) => Distribution.Utils.Structured.Structured (a1, a2, a3, a4, a5, a6, a7) instance Distribution.Utils.Structured.Structured Data.ByteString.Internal.ByteString instance Distribution.Utils.Structured.Structured Data.ByteString.Lazy.Internal.ByteString instance Distribution.Utils.Structured.Structured Data.Text.Internal.Text instance Distribution.Utils.Structured.Structured Data.Text.Internal.Lazy.Text instance (Distribution.Utils.Structured.Structured k, Distribution.Utils.Structured.Structured v) => Distribution.Utils.Structured.Structured (Data.Map.Internal.Map k v) instance Distribution.Utils.Structured.Structured k => Distribution.Utils.Structured.Structured (Data.Set.Internal.Set k) instance Distribution.Utils.Structured.Structured v => Distribution.Utils.Structured.Structured (Data.IntMap.Internal.IntMap v) instance Distribution.Utils.Structured.Structured Data.IntSet.Internal.IntSet instance Distribution.Utils.Structured.Structured v => Distribution.Utils.Structured.Structured (Data.Sequence.Internal.Seq v) instance Distribution.Utils.Structured.Structured Data.Time.Clock.Internal.UTCTime.UTCTime instance Distribution.Utils.Structured.Structured Data.Time.Clock.Internal.DiffTime.DiffTime instance Distribution.Utils.Structured.Structured Data.Time.Clock.Internal.UniversalTime.UniversalTime instance Distribution.Utils.Structured.Structured Data.Time.Clock.Internal.NominalDiffTime.NominalDiffTime instance Distribution.Utils.Structured.Structured Data.Time.Calendar.Days.Day instance Distribution.Utils.Structured.Structured Data.Time.LocalTime.Internal.TimeZone.TimeZone instance Distribution.Utils.Structured.Structured Data.Time.LocalTime.Internal.TimeOfDay.TimeOfDay instance Distribution.Utils.Structured.Structured Data.Time.LocalTime.Internal.LocalTime.LocalTime -- | Compatibility layer for Data.Semigroup module Distribution.Compat.Semigroup -- | The class of semigroups (types with an associative binary operation). -- -- Instances should satisfy the following: -- -- class Semigroup a -- | An associative operation. -- --
-- >>> [1,2,3] <> [4,5,6] -- [1,2,3,4,5,6] --(<>) :: Semigroup a => a -> a -> a infixr 6 <> -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following: -- --
-- >>> "Hello world" <> mempty -- "Hello world" --mempty :: Monoid a => a -- | An associative operation -- -- NOTE: This method is redundant and has the default -- implementation mappend = (<>) since -- base-4.11.0.0. Should it be implemented manually, since -- mappend is a synonym for (<>), it is expected that -- the two functions are defined the same way. In a future GHC release -- mappend will be removed from Monoid. 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 ["Hello", " ", "Haskell", "!"] -- "Hello Haskell!" --mconcat :: Monoid a => [a] -> a -- | Boolean monoid under conjunction (&&). -- --
-- >>> getAll (All True <> mempty <> All False) -- False ---- --
-- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8])) -- False --newtype All All :: Bool -> All [getAll] :: All -> Bool -- | Boolean monoid under disjunction (||). -- --
-- >>> getAny (Any True <> mempty <> Any False) -- True ---- --
-- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8])) -- True --newtype Any Any :: Bool -> Any [getAny] :: Any -> Bool -- | A copy of First. newtype First' a First' :: a -> First' a [getFirst'] :: First' a -> a -- | A copy of Last. newtype Last' a Last' :: a -> Last' a [getLast'] :: Last' a -> a -- | A wrapper around Maybe, providing the Semigroup and -- Monoid instances implemented for Maybe since -- base-4.11. newtype Option' a Option' :: Maybe a -> Option' a [getOption'] :: Option' 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.Show.Show a => GHC.Show.Show (Distribution.Compat.Semigroup.First' a) instance GHC.Classes.Ord a => GHC.Classes.Ord (Distribution.Compat.Semigroup.First' a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Compat.Semigroup.First' a) instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Compat.Semigroup.Last' a) instance GHC.Generics.Generic (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 GHC.Base.Functor Distribution.Compat.Semigroup.Option' instance GHC.Generics.Generic (Distribution.Compat.Semigroup.Option' a) instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Compat.Semigroup.Option' a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Compat.Semigroup.Option' a) instance GHC.Read.Read a => GHC.Read.Read (Distribution.Compat.Semigroup.Option' a) instance GHC.Classes.Ord a => GHC.Classes.Ord (Distribution.Compat.Semigroup.Option' a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Compat.Semigroup.Option' a) instance (GHC.Base.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 GHC.Base.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 Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Compat.Semigroup.Option' a) instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Distribution.Compat.Semigroup.Option' a) instance GHC.Base.Semigroup a => GHC.Base.Monoid (Distribution.Compat.Semigroup.Option' a) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Compat.Semigroup.Last' a) instance GHC.Base.Semigroup (Distribution.Compat.Semigroup.Last' a) instance GHC.Base.Functor Distribution.Compat.Semigroup.Last' instance GHC.Base.Semigroup (Distribution.Compat.Semigroup.First' a) -- | Compact representation of short Strings -- -- This module is designed to be import qualifeid -- --
-- import Distribution.Utils.ShortText (ShortText) -- import qualifeid Distribution.Utils.ShortText as ShortText --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 -- | Convert from UTF-8 encoded strict ByteString. unsafeFromUTF8BS :: ByteString -> ShortText -- | Text whether ShortText is empty. null :: ShortText -> Bool -- | O(n). Length in characters. Slow as converts to string. length :: ShortText -> Int -- | Decode String from UTF8-encoded octets. -- -- Invalid data in the UTF8 stream (this includes code-points -- U+D800 through U+DFFF) will be decoded as the -- replacement character (U+FFFD). -- -- See also encodeStringUtf8 decodeStringUtf8 :: [Word8] -> String -- | Encode String to a list of UTF8-encoded octets -- -- Code-points in the U+D800-U+DFFF range will be -- encoded as the replacement character (i.e. U+FFFD). -- -- 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 Distribution.Utils.Structured.Structured 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 GHC.Base.Semigroup Distribution.Utils.ShortText.ShortText instance GHC.Base.Monoid Distribution.Utils.ShortText.ShortText instance Data.String.IsString Distribution.Utils.ShortText.ShortText -- | 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.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) module Distribution.Utils.IOData -- | Represents either textual or binary data passed via I/O functions -- which support binary/text mode data IOData -- | How Text gets encoded is usually locale-dependent. IODataText :: String -> IOData -- | Raw binary which gets read/written in binary mode. IODataBinary :: ByteString -> IOData data IODataMode mode [IODataModeText] :: IODataMode String [IODataModeBinary] :: IODataMode ByteString class NFData mode => KnownIODataMode mode -- | IOData Wrapper for hGetContents -- -- Note: This operation uses lazy I/O. Use NFData to force -- all data to be read and consequently the internal file handle to be -- closed. hGetIODataContents :: KnownIODataMode mode => Handle -> IO mode toIOData :: KnownIODataMode mode => mode -> IOData iodataMode :: KnownIODataMode mode => IODataMode mode withIOData :: IOData -> (forall mode. IODataMode mode -> mode -> r) -> r -- | Test whether IOData is empty null :: IOData -> Bool -- | IOData Wrapper for hPutStr and hClose -- -- This is the dual operation ot hGetIODataContents, and -- consequently the handle is closed with hClose. -- -- Note: this performs lazy-IO. hPutContents :: Handle -> IOData -> IO () instance (a GHC.Types.~ GHC.Types.Char) => Distribution.Utils.IOData.KnownIODataMode [a] instance Distribution.Utils.IOData.KnownIODataMode Data.ByteString.Lazy.Internal.ByteString instance Control.DeepSeq.NFData Distribution.Utils.IOData.IOData -- | 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 () -- | Decode String from UTF8-encoded ByteString -- -- Invalid data in the UTF8 stream (this includes code-points -- U+D800 through U+DFFF) will be decoded as the -- replacement character (U+FFFD). fromUTF8BS :: ByteString -> String -- | Variant of fromUTF8BS for lazy ByteStrings fromUTF8LBS :: ByteString -> String -- | Encode String to to UTF8-encoded ByteString -- -- Code-points in the U+D800-U+DFFF range will be -- encoded as the replacement character (i.e. U+FFFD). toUTF8BS :: String -> ByteString -- | Variant of toUTF8BS for lazy ByteStrings toUTF8LBS :: String -> ByteString -- | Check that strict ByteString is valid UTF8. Returns 'Just -- offset' if it's not. validateUTF8 :: ByteString -> Maybe Int -- | 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 () -- | Ignore a Unicode byte order mark (BOM) at the beginning of the input ignoreBOM :: String -> String -- | Fix different systems silly line ending conventions normaliseLineEndings :: 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: -- --
-- >>> safeTail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] -- *** Exception: Prelude.undefined -- ... ---- --
-- >>> safeTail $ 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. -- --
-- >>> 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 ", " ["Lorem", "ipsum", "dolor"] -- "Lorem, ipsum, dolor" --intercalate :: [a] -> [[a]] -> [a] -- | Lower case string -- --
-- >>> lowercase "Foobar" -- "foobar" --lowercase :: String -> String -- | Ascii characters isAscii :: Char -> Bool -- | Ascii letters. isAsciiAlpha :: Char -> Bool -- | Ascii letters and digits. -- --
-- >>> isAsciiAlphaNum 'a' -- True ---- --
-- >>> isAsciiAlphaNum 'ä' -- False --isAsciiAlphaNum :: Char -> Bool -- | 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] :: [Int] -- [1,2] ---- --
-- >>> ordNubRight [1,2,1] :: [Int] -- [2,1] --ordNubRight :: Ord a => [a] -> [a] -- | A total variant of head. safeHead :: [a] -> Maybe a -- | A total variant of tail. safeTail :: [a] -> [a] -- | A total variant of last. safeLast :: [a] -> Maybe a -- | A total variant of init. safeInit :: [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]] -- | unfoldr with monadic action. -- --
-- >>> take 5 $ unfoldrM (\b r -> Just (r + b, b + 1)) (1 :: Int) 2 -- [3,4,5,6,7] --unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a] -- | Like span but with Maybe predicate -- --
-- >>> spanMaybe listToMaybe [[1,2],[3],[],[4,5],[6,7]] -- ([1,3],[[],[4,5],[6,7]]) ---- --
-- >>> spanMaybe (readMaybe :: String -> Maybe Int) ["1", "2", "foo"] -- ([1,2],["foo"]) --spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a]) -- | Like break, but with Maybe predicate -- --
-- >>> breakMaybe (readMaybe :: String -> Maybe Int) ["foo", "bar", "1", "2", "quu"] -- (["foo","bar"],Just (1,["2","quu"])) ---- --
-- >>> breakMaybe (readMaybe :: String -> Maybe Int) ["foo", "bar"] -- (["foo","bar"],Nothing) --breakMaybe :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a])) -- | The opposite of snoc, which is the reverse of cons -- -- Example: -- --
-- >>> unsnoc [1, 2, 3] -- Just ([1,2],3) ---- --
-- >>> unsnoc [] -- Nothing --unsnoc :: [a] -> Maybe ([a], a) -- | Like unsnoc, but for NonEmpty so without the -- Maybe -- -- Example: -- --
-- >>> unsnocNE (1 :| [2, 3]) -- ([1,2],3) ---- --
-- >>> unsnocNE (1 :| []) -- ([],1) --unsnocNE :: NonEmpty a -> ([a], a) -- | 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 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 GHC.Base.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) instance Distribution.Utils.Structured.Structured c => Distribution.Utils.Structured.Structured (Distribution.Types.Condition.Condition c) instance Control.DeepSeq.NFData c => Control.DeepSeq.NFData (Distribution.Types.Condition.Condition c) -- | This module defines the detailed test suite interface which makes it -- possible to expose individual tests to Cabal or other test agents. module Distribution.TestSuite data TestInstance TestInstance :: IO Progress -> String -> [String] -> [OptionDescr] -> (String -> String -> Either String TestInstance) -> TestInstance -- | Perform the test. [run] :: TestInstance -> IO Progress -- | A name for the test, unique within a test suite. [name] :: TestInstance -> String -- | Users can select groups of tests by their tags. [tags] :: TestInstance -> [String] -- | Descriptions of the options recognized by this test. [options] :: TestInstance -> [OptionDescr] -- | Try to set the named option to the given value. Returns an error -- message if the option is not supported or the value could not be -- correctly parsed; otherwise, a TestInstance with the option set -- to the given value is returned. [setOption] :: TestInstance -> String -> String -> Either String TestInstance data OptionDescr OptionDescr :: String -> String -> OptionType -> Maybe String -> OptionDescr [optionName] :: OptionDescr -> String -- | A human-readable description of the option to guide the user setting -- it. [optionDescription] :: OptionDescr -> String [optionType] :: OptionDescr -> OptionType [optionDefault] :: OptionDescr -> Maybe String data OptionType OptionFile :: Bool -> Bool -> [String] -> OptionType [optionFileMustExist] :: OptionType -> Bool [optionFileIsDir] :: OptionType -> Bool [optionFileExtensions] :: OptionType -> [String] OptionString :: Bool -> OptionType [optionStringMultiline] :: OptionType -> Bool OptionNumber :: Bool -> (Maybe String, Maybe String) -> OptionType [optionNumberIsInt] :: OptionType -> Bool [optionNumberBounds] :: OptionType -> (Maybe String, Maybe String) OptionBool :: OptionType OptionEnum :: [String] -> OptionType OptionSet :: [String] -> OptionType OptionRngSeed :: OptionType data Test Test :: TestInstance -> Test Group :: String -> Bool -> [Test] -> Test [groupName] :: Test -> String -- | If true, then children of this group may be run in parallel. Note that -- this setting is not inherited by children. In particular, consider a -- group F with "concurrently = False" that has some children, including -- a group T with "concurrently = True". The children of group T may be -- run concurrently with each other, as long as none are run at the same -- time as any of the direct children of group F. [concurrently] :: Test -> Bool [groupTests] :: Test -> [Test] ExtraOptions :: [OptionDescr] -> Test -> Test type Options = [(String, String)] data Progress Finished :: Result -> Progress Progress :: String -> IO Progress -> Progress data Result Pass :: Result Fail :: String -> Result Error :: String -> Result -- | Create a named group of tests, which are assumed to be safe to run in -- parallel. testGroup :: String -> [Test] -> Test instance GHC.Show.Show Distribution.TestSuite.OptionType instance GHC.Read.Read Distribution.TestSuite.OptionType instance GHC.Classes.Eq Distribution.TestSuite.OptionType instance GHC.Show.Show Distribution.TestSuite.OptionDescr instance GHC.Read.Read Distribution.TestSuite.OptionDescr instance GHC.Classes.Eq Distribution.TestSuite.OptionDescr instance GHC.Show.Show Distribution.TestSuite.Result instance GHC.Read.Read Distribution.TestSuite.Result instance GHC.Classes.Eq Distribution.TestSuite.Result -- | 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 -- | 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 module Distribution.Simple.InstallDirs.Internal data PathComponent Ordinary :: FilePath -> PathComponent Variable :: PathTemplateVariable -> PathComponent data PathTemplateVariable -- | The $prefix path variable PrefixVar :: PathTemplateVariable -- | The $bindir path variable BindirVar :: PathTemplateVariable -- | The $libdir path variable LibdirVar :: PathTemplateVariable -- | The $libsubdir path variable LibsubdirVar :: PathTemplateVariable -- | The $dynlibdir path variable DynlibdirVar :: PathTemplateVariable -- | The $datadir path variable DatadirVar :: PathTemplateVariable -- | The $datasubdir path variable DatasubdirVar :: PathTemplateVariable -- | The $docdir path variable DocdirVar :: PathTemplateVariable -- | The $htmldir path variable HtmldirVar :: PathTemplateVariable -- | The $pkg package name path variable PkgNameVar :: PathTemplateVariable -- | The $version package version path variable PkgVerVar :: PathTemplateVariable -- | The $pkgid package Id path variable, eg foo-1.0 PkgIdVar :: PathTemplateVariable -- | The $libname path variable LibNameVar :: PathTemplateVariable -- | The compiler name and version, eg ghc-6.6.1 CompilerVar :: PathTemplateVariable -- | The operating system name, eg windows or linux OSVar :: PathTemplateVariable -- | The CPU architecture name, eg i386 or x86_64 ArchVar :: PathTemplateVariable -- | The compiler's ABI identifier, AbiVar :: PathTemplateVariable -- | The optional ABI tag for the compiler AbiTagVar :: PathTemplateVariable -- | The executable name; used in shell wrappers ExecutableNameVar :: PathTemplateVariable -- | The name of the test suite being run TestSuiteNameVar :: PathTemplateVariable -- | The result of the test suite being run, eg pass, -- fail, or error. TestSuiteResultVar :: PathTemplateVariable -- | The name of the benchmark being run BenchmarkNameVar :: PathTemplateVariable instance GHC.Generics.Generic Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance GHC.Classes.Ord Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance GHC.Classes.Eq Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance GHC.Generics.Generic Distribution.Simple.InstallDirs.Internal.PathComponent instance GHC.Classes.Ord Distribution.Simple.InstallDirs.Internal.PathComponent instance GHC.Classes.Eq Distribution.Simple.InstallDirs.Internal.PathComponent instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.Internal.PathComponent instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.Internal.PathComponent instance GHC.Show.Show Distribution.Simple.InstallDirs.Internal.PathComponent instance GHC.Read.Read Distribution.Simple.InstallDirs.Internal.PathComponent instance Data.Binary.Class.Binary Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance Distribution.Utils.Structured.Structured Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance GHC.Show.Show Distribution.Simple.InstallDirs.Internal.PathTemplateVariable instance GHC.Read.Read Distribution.Simple.InstallDirs.Internal.PathTemplateVariable -- | Defines the Flag type and it's Monoid instance, see -- http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html -- for an explanation. -- -- Split off from Distribution.Simple.Setup to break import -- cycles. module Distribution.Simple.Flag -- | All flags are monoids, they come in two flavours: -- --
-- --ghc-option=foo --ghc-option=bar ---- -- gives us all the values ["foo", "bar"] -- --
-- --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 allFlags :: [Flag Bool] -> Flag Bool toFlag :: a -> Flag a fromFlag :: WithCallStack (Flag a -> a) fromFlagOrDefault :: a -> Flag a -> a flagElim :: b -> (a -> b) -> Flag a -> b 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 instance GHC.Read.Read a => GHC.Read.Read (Distribution.Simple.Flag.Flag a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Flag.Flag a) instance GHC.Generics.Generic (Distribution.Simple.Flag.Flag a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.Flag.Flag a) instance Distribution.Simple.Flag.BooleanFlag GHC.Types.Bool instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Simple.Flag.Flag a) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Simple.Flag.Flag a) instance GHC.Base.Functor Distribution.Simple.Flag.Flag instance GHC.Base.Applicative Distribution.Simple.Flag.Flag instance GHC.Base.Monoid (Distribution.Simple.Flag.Flag a) instance GHC.Base.Semigroup (Distribution.Simple.Flag.Flag a) instance GHC.Enum.Bounded a => GHC.Enum.Bounded (Distribution.Simple.Flag.Flag a) instance GHC.Enum.Enum a => GHC.Enum.Enum (Distribution.Simple.Flag.Flag a) -- | This simple package provides types and functions for interacting with -- C compilers. Currently it's just a type enumerating extant C-like -- languages, which we call dialects. module Distribution.Simple.CCompiler -- | Represents a dialect of C. The Monoid instance expresses backward -- compatibility, in the sense that 'mappend a b' is the least inclusive -- dialect which both a and b can be correctly -- interpreted as. data CDialect C :: CDialect ObjectiveC :: CDialect CPlusPlus :: CDialect ObjectiveCPlusPlus :: CDialect -- | A list of all file extensions which are recognized as possibly -- containing some dialect of C code. Note that this list is only for -- source files, not for header files. cSourceExtensions :: [String] -- | Takes a dialect of C and whether code is intended to be passed through -- the preprocessor, and returns a filename extension for containing that -- code. cDialectFilenameExtension :: CDialect -> Bool -> String -- | Infers from a filename's extension the dialect of C which it contains, -- and whether it is intended to be passed through the preprocessor. filenameCDialect :: String -> Maybe (CDialect, Bool) instance GHC.Show.Show Distribution.Simple.CCompiler.CDialect instance GHC.Classes.Eq Distribution.Simple.CCompiler.CDialect instance GHC.Base.Monoid Distribution.Simple.CCompiler.CDialect instance GHC.Base.Semigroup Distribution.Simple.CCompiler.CDialect module Distribution.Parsec.Position -- | 1-indexed row and column positions in a file. data Position Position :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> Position -- | Shift position by n columns to the right. incPos :: Int -> Position -> Position -- | Shift position to beginning of next row. retPos :: Position -> Position showPos :: Position -> String zeroPos :: Position positionCol :: Position -> Int positionRow :: Position -> Int instance GHC.Generics.Generic Distribution.Parsec.Position.Position instance GHC.Show.Show Distribution.Parsec.Position.Position instance GHC.Classes.Ord Distribution.Parsec.Position.Position instance GHC.Classes.Eq Distribution.Parsec.Position.Position instance Data.Binary.Class.Binary Distribution.Parsec.Position.Position instance Control.DeepSeq.NFData Distribution.Parsec.Position.Position module Distribution.Parsec.Warning -- | Parser warning. data PWarning PWarning :: !PWarnType -> !Position -> String -> PWarning -- | Type of parser warning. We do classify warnings. -- -- Different application may decide not to show some, or have fatal -- behaviour on others data PWarnType -- | Unclassified warning PWTOther :: PWarnType -- | Invalid UTF encoding PWTUTF :: PWarnType -- | true or false, not True or False PWTBoolCase :: PWarnType -- | there are version with tags PWTVersionTag :: PWarnType -- | New syntax used, but no cabal-version: >= 1.2 specified PWTNewSyntax :: PWarnType -- | Old syntax used, and cabal-version >= 1.2 specified PWTOldSyntax :: PWarnType PWTDeprecatedField :: PWarnType PWTInvalidSubsection :: PWarnType PWTUnknownField :: PWarnType PWTUnknownSection :: PWarnType PWTTrailingFields :: PWarnType -- | extra main-is field PWTExtraMainIs :: PWarnType -- | extra test-module field PWTExtraTestModule :: PWarnType -- | extra benchmark-module field PWTExtraBenchmarkModule :: PWarnType PWTLexNBSP :: PWarnType PWTLexBOM :: PWarnType PWTLexTab :: PWarnType -- | legacy cabal file that we know how to patch PWTQuirkyCabalFile :: PWarnType -- | Double dash token, most likely it's a mistake - it's not a comment PWTDoubleDash :: PWarnType -- | e.g. name or version should be specified only once. PWTMultipleSingularField :: PWarnType -- | Workaround for derive-package having build-type: Default. See -- https://github.com/haskell/cabal/issues/5020. PWTBuildTypeDefault :: PWarnType showPWarning :: FilePath -> PWarning -> String instance GHC.Generics.Generic Distribution.Parsec.Warning.PWarnType instance GHC.Enum.Bounded Distribution.Parsec.Warning.PWarnType instance GHC.Enum.Enum Distribution.Parsec.Warning.PWarnType instance GHC.Show.Show Distribution.Parsec.Warning.PWarnType instance GHC.Classes.Ord Distribution.Parsec.Warning.PWarnType instance GHC.Classes.Eq Distribution.Parsec.Warning.PWarnType instance GHC.Generics.Generic Distribution.Parsec.Warning.PWarning instance GHC.Show.Show Distribution.Parsec.Warning.PWarning instance Data.Binary.Class.Binary Distribution.Parsec.Warning.PWarning instance Control.DeepSeq.NFData Distribution.Parsec.Warning.PWarning instance Data.Binary.Class.Binary Distribution.Parsec.Warning.PWarnType instance Control.DeepSeq.NFData Distribution.Parsec.Warning.PWarnType module Distribution.Parsec.FieldLineStream -- | This is essentially a lazy bytestring, but chunks are glued with -- newline '\n'. data FieldLineStream FLSLast :: !ByteString -> FieldLineStream FLSCons :: {-# UNPACK #-} !ByteString -> FieldLineStream -> FieldLineStream -- | Convert String to FieldLineStream. -- -- Note: inefficient! fieldLineStreamFromString :: String -> FieldLineStream fieldLineStreamFromBS :: ByteString -> FieldLineStream fieldLineStreamEnd :: FieldLineStream instance GHC.Show.Show Distribution.Parsec.FieldLineStream.FieldLineStream instance GHC.Base.Monad m => Text.Parsec.Prim.Stream Distribution.Parsec.FieldLineStream.FieldLineStream m GHC.Types.Char module Distribution.Parsec.Error -- | Parser error. data PError PError :: Position -> String -> PError showPError :: FilePath -> PError -> String instance GHC.Generics.Generic Distribution.Parsec.Error.PError instance GHC.Show.Show Distribution.Parsec.Error.PError instance Data.Binary.Class.Binary Distribution.Parsec.Error.PError instance Control.DeepSeq.NFData Distribution.Parsec.Error.PError module Distribution.PackageDescription.Quirks -- | Patch legacy .cabal file contents to allow parsec parser to -- accept all of Hackage. -- -- Bool part of the result tells whether the output is modified. patchQuirks :: ByteString -> (Bool, ByteString) module Distribution.Fields.LexerMonad type InputStream = ByteString data LexState LexState :: {-# UNPACK #-} !Position -> {-# UNPACK #-} !InputStream -> {-# UNPACK #-} !StartCode -> [LexWarning] -> LexState -- | position at current input location [curPos] :: LexState -> {-# UNPACK #-} !Position -- | the current input [curInput] :: LexState -> {-# UNPACK #-} !InputStream -- | lexer code [curCode] :: LexState -> {-# UNPACK #-} !StartCode [warnings] :: LexState -> [LexWarning] data LexResult a LexResult :: {-# UNPACK #-} !LexState -> a -> LexResult a newtype Lex a Lex :: (LexState -> LexResult a) -> Lex a [unLex] :: Lex a -> LexState -> LexResult a -- | Execute the given lexer on the supplied input stream. execLexer :: Lex a -> InputStream -> ([LexWarning], a) getPos :: Lex Position setPos :: Position -> Lex () adjustPos :: (Position -> Position) -> Lex () getInput :: Lex InputStream setInput :: InputStream -> Lex () getStartCode :: Lex Int setStartCode :: Int -> Lex () data LexWarning LexWarning :: !LexWarningType -> {-# UNPACK #-} !Position -> LexWarning data LexWarningType -- | Encountered non breaking space LexWarningNBSP :: LexWarningType -- | BOM at the start of the cabal file LexWarningBOM :: LexWarningType -- | Leading tags LexWarningTab :: LexWarningType -- | Add warning at the current position addWarning :: LexWarningType -> Lex () toPWarnings :: [LexWarning] -> [PWarning] instance GHC.Show.Show Distribution.Fields.LexerMonad.LexWarningType instance GHC.Classes.Ord Distribution.Fields.LexerMonad.LexWarningType instance GHC.Classes.Eq Distribution.Fields.LexerMonad.LexWarningType instance GHC.Show.Show Distribution.Fields.LexerMonad.LexWarning instance GHC.Base.Functor Distribution.Fields.LexerMonad.Lex instance GHC.Base.Applicative Distribution.Fields.LexerMonad.Lex instance GHC.Base.Monad Distribution.Fields.LexerMonad.Lex -- | Lexer for the cabal files. module Distribution.Fields.Lexer ltest :: Int -> String -> IO () lexToken :: Lex LToken -- | Tokens of outer cabal file structure. Field values are treated -- opaquely. data Token -- | Haskell-like identifier, number or operator TokSym :: !ByteString -> Token -- | String in quotes TokStr :: !ByteString -> Token -- | Operators and parens TokOther :: !ByteString -> Token -- | Indentation token Indent :: !Int -> Token -- | Lines after : TokFieldLine :: !ByteString -> Token Colon :: Token OpenBrace :: Token CloseBrace :: Token EOF :: Token LexicalError :: InputStream -> Token data LToken L :: !Position -> !Token -> LToken bol_section :: Int in_section :: Int in_field_layout :: Int in_field_braces :: Int mkLexState :: ByteString -> LexState instance GHC.Show.Show Distribution.Fields.Lexer.Token instance GHC.Show.Show Distribution.Fields.Lexer.LToken -- | Cabal-like file AST types: Field, Section etc -- -- These types are parametrized by an annotation. module Distribution.Fields.Field -- | A Cabal-like file consists of a series of fields (foo: bar) -- and sections (library ...). data Field ann Field :: !Name ann -> [FieldLine ann] -> Field ann Section :: !Name ann -> [SectionArg ann] -> [Field ann] -> Field ann -- | Section of field name fieldName :: Field ann -> Name ann fieldAnn :: Field ann -> ann -- | All transitive descendants of Field, including itself. -- -- Note: the resulting list is never empty. fieldUniverse :: Field ann -> [Field ann] -- | A line of text representing the value of a field from a Cabal file. A -- field may contain multiple lines. -- -- Invariant: ByteString has no newlines. data FieldLine ann FieldLine :: !ann -> !ByteString -> FieldLine ann fieldLineAnn :: FieldLine ann -> ann fieldLineBS :: FieldLine ann -> ByteString -- | Section arguments, e.g. name of the library data SectionArg ann -- | identifier, or something which looks like number. Also many dot -- numbers, i.e. "7.6.3" SecArgName :: !ann -> !ByteString -> SectionArg ann -- | quoted string SecArgStr :: !ann -> !ByteString -> SectionArg ann -- | everything else, mm. operators (e.g. in if-section conditionals) SecArgOther :: !ann -> !ByteString -> SectionArg ann -- | Extract annotation from SectionArg. sectionArgAnn :: SectionArg ann -> ann type FieldName = ByteString -- | A field name. -- -- Invariant: ByteString is lower-case ASCII. data Name ann Name :: !ann -> !FieldName -> Name ann mkName :: ann -> FieldName -> Name ann getName :: Name ann -> FieldName nameAnn :: Name ann -> ann instance Data.Traversable.Traversable Distribution.Fields.Field.FieldLine instance Data.Foldable.Foldable Distribution.Fields.Field.FieldLine instance GHC.Base.Functor Distribution.Fields.Field.FieldLine instance GHC.Show.Show ann => GHC.Show.Show (Distribution.Fields.Field.FieldLine ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.Fields.Field.FieldLine ann) instance Data.Traversable.Traversable Distribution.Fields.Field.SectionArg instance Data.Foldable.Foldable Distribution.Fields.Field.SectionArg instance GHC.Base.Functor Distribution.Fields.Field.SectionArg instance GHC.Show.Show ann => GHC.Show.Show (Distribution.Fields.Field.SectionArg ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.Fields.Field.SectionArg ann) instance Data.Traversable.Traversable Distribution.Fields.Field.Name instance Data.Foldable.Foldable Distribution.Fields.Field.Name instance GHC.Base.Functor Distribution.Fields.Field.Name instance GHC.Show.Show ann => GHC.Show.Show (Distribution.Fields.Field.Name ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.Fields.Field.Name ann) instance Data.Traversable.Traversable Distribution.Fields.Field.Field instance Data.Foldable.Foldable Distribution.Fields.Field.Field instance GHC.Base.Functor Distribution.Fields.Field.Field instance GHC.Show.Show ann => GHC.Show.Show (Distribution.Fields.Field.Field ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.Fields.Field.Field ann) module Distribution.Fields.Parser -- | A Cabal-like file consists of a series of fields (foo: bar) -- and sections (library ...). data Field ann Field :: !Name ann -> [FieldLine ann] -> Field ann Section :: !Name ann -> [SectionArg ann] -> [Field ann] -> Field ann -- | A field name. -- -- Invariant: ByteString is lower-case ASCII. data Name ann Name :: !ann -> !FieldName -> Name ann -- | A line of text representing the value of a field from a Cabal file. A -- field may contain multiple lines. -- -- Invariant: ByteString has no newlines. data FieldLine ann FieldLine :: !ann -> !ByteString -> FieldLine ann -- | Section arguments, e.g. name of the library data SectionArg ann -- | identifier, or something which looks like number. Also many dot -- numbers, i.e. "7.6.3" SecArgName :: !ann -> !ByteString -> SectionArg ann -- | quoted string SecArgStr :: !ann -> !ByteString -> SectionArg ann -- | everything else, mm. operators (e.g. in if-section conditionals) SecArgOther :: !ann -> !ByteString -> SectionArg ann -- | Parse cabal style ByteString into list of Fields, i.e. -- the cabal AST. readFields :: ByteString -> Either ParseError [Field Position] -- | Like readFields but also return lexer warnings readFields' :: ByteString -> Either ParseError ([Field Position], [LexWarning]) instance Text.Parsec.Prim.Stream Distribution.Fields.Parser.LexState' Data.Functor.Identity.Identity Distribution.Fields.Lexer.LToken module Distribution.Compat.ResponseFile expandResponse :: [String] -> IO [String] -- | 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 -- | Append two lists, i.e., -- --
-- [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn] -- [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...] ---- -- If the first list is not finite, the result is the first list. (++) :: [a] -> [a] -> [a] infixr 5 ++ seq :: forall {r :: RuntimeRep} a (b :: TYPE r). a -> b -> b -- | <math>. filter, applied to a predicate and a list, -- returns the list of those elements that satisfy the predicate; i.e., -- --
-- filter p xs = [ x | x <- xs, p x] ---- --
-- >>> filter odd [1, 2, 3] -- [1,3] --filter :: (a -> Bool) -> [a] -> [a] -- | <math>. zip takes two lists and returns a list of -- corresponding pairs. -- --
-- >>> zip [1, 2] ['a', 'b'] -- [(1, 'a'), (2, 'b')] ---- -- If one input list is shorter than the other, excess elements of the -- longer list are discarded, even if one of the lists is infinite: -- --
-- >>> zip [1] ['a', 'b'] -- [(1, 'a')] -- -- >>> zip [1, 2] ['a'] -- [(1, 'a')] -- -- >>> zip [] [1..] -- [] -- -- >>> zip [1..] [] -- [] ---- -- zip is right-lazy: -- --
-- >>> zip [] _|_ -- [] -- -- >>> zip _|_ [] -- _|_ ---- -- zip is capable of list fusion, but it is restricted to its -- first list argument and its resulting list. zip :: [a] -> [b] -> [(a, b)] -- | The print function outputs a value of any printable type to the -- standard output device. Printable types are those that are instances -- of class Show; print converts values to strings for -- output using the show operation and adds a newline. -- -- For example, a program to print the first 20 integers and their powers -- of 2 could be written as: -- --
-- main = print ([(n, 2^n) | n <- [0..19]]) --print :: Show a => a -> IO () -- | Extract the first component of a pair. fst :: (a, b) -> a -- | Extract the second component of a pair. snd :: (a, b) -> b -- | otherwise is defined as the value True. It helps to make -- guards more readable. eg. -- --
-- f x | x < 0 = ... -- | otherwise = ... --otherwise :: Bool -- | <math>. map f xs is the list obtained by -- applying f to each element of xs, i.e., -- --
-- map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn] -- map f [x1, x2, ...] == [f x1, f x2, ...] ---- --
-- >>> map (+1) [1, 2, 3] -- [2,3,4] --map :: (a -> b) -> [a] -> [b] -- | Application operator. This operator is redundant, since ordinary -- application (f x) means the same as (f $ x). -- However, $ has low, right-associative binding precedence, so it -- sometimes allows parentheses to be omitted; for example: -- --
-- f $ g $ h x = f (g (h x)) ---- -- It is also useful in higher-order situations, such as map -- ($ 0) xs, or zipWith ($) fs xs. -- -- Note that ($) is levity-polymorphic in its result -- type, so that foo $ True where foo :: Bool -> -- Int# is well-typed. ($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b infixr 0 $ -- | general coercion from integral types fromIntegral :: (Integral a, Num b) => a -> b -- | general coercion to fractional types realToFrac :: (Real a, Fractional b) => a -> b -- | The Bounded class is used to name the upper and lower limits of -- a type. Ord is not a superclass of Bounded since types -- that are not totally ordered may also have upper and lower bounds. -- -- The Bounded class may be derived for any enumeration type; -- minBound is the first constructor listed in the data -- declaration and maxBound is the last. Bounded may also -- be derived for single-constructor datatypes whose constituent types -- are in Bounded. class Bounded a minBound :: Bounded a => a maxBound :: Bounded a => a -- | Class Enum defines operations on sequentially ordered types. -- -- The enumFrom... methods are used in Haskell's translation of -- arithmetic sequences. -- -- Instances of Enum may be derived for any enumeration type -- (types whose constructors have no fields). The nullary constructors -- are assumed to be numbered left-to-right by fromEnum from -- 0 through n-1. See Chapter 10 of the Haskell -- Report for more details. -- -- For any type that is an instance of class Bounded as well as -- Enum, the following should hold: -- --
-- enumFrom x = enumFromTo x maxBound -- enumFromThen x y = enumFromThenTo x y bound -- where -- bound | fromEnum y >= fromEnum x = maxBound -- | otherwise = minBound --class Enum a -- | the successor of a value. For numeric types, succ adds 1. succ :: Enum a => a -> a -- | the predecessor of a value. For numeric types, pred subtracts -- 1. pred :: Enum a => a -> a -- | Convert from an Int. toEnum :: Enum a => Int -> a -- | Convert to an Int. It is implementation-dependent what -- fromEnum returns when applied to a value that is too large to -- fit in an Int. fromEnum :: Enum a => a -> Int -- | Used in Haskell's translation of [n..] with [n..] = -- enumFrom n, a possible implementation being enumFrom n = n : -- enumFrom (succ n). For example: -- --
enumFrom 4 :: [Integer] = [4,5,6,7,...]
enumFrom 6 :: [Int] = [6,7,8,9,...,maxBound :: -- Int]
enumFromThen 4 6 :: [Integer] = [4,6,8,10...]
enumFromThen 6 2 :: [Int] = [6,2,-2,-6,...,minBound :: -- Int]
enumFromTo 6 10 :: [Int] = [6,7,8,9,10]
enumFromTo 42 1 :: [Integer] = []
enumFromThenTo 4 2 -6 :: [Integer] = -- [4,2,0,-2,-4,-6]
enumFromThenTo 6 8 2 :: [Int] = []
-- (x `quot` y)*y + (x `rem` y) == x --rem :: Integral a => a -> a -> a -- | integer division truncated toward negative infinity div :: Integral a => a -> a -> a -- | integer modulus, satisfying -- --
-- (x `div` y)*y + (x `mod` y) == x --mod :: Integral a => a -> a -> a -- | simultaneous quot and rem quotRem :: Integral a => a -> a -> (a, a) -- | simultaneous div and mod divMod :: Integral a => a -> a -> (a, a) -- | conversion to Integer toInteger :: Integral a => a -> Integer infixl 7 `mod` infixl 7 `div` infixl 7 `rem` infixl 7 `quot` -- | The Monad class defines the basic operations over a -- monad, a concept from a branch of mathematics known as -- category theory. From the perspective of a Haskell programmer, -- however, it is best to think of a monad as an abstract datatype -- of actions. Haskell's do expressions provide a convenient -- syntax for writing monadic expressions. -- -- Instances of Monad should satisfy the following: -- --
-- do a <- as -- bs a --(>>=) :: Monad m => m a -> (a -> m b) -> m b -- | Sequentially compose two actions, discarding any value produced by the -- first, like sequencing operators (such as the semicolon) in imperative -- languages. -- -- 'as >> bs' can be understood as the do -- expression -- --
-- do as -- bs --(>>) :: Monad m => m a -> m b -> m b -- | Inject a value into the monadic type. return :: Monad m => a -> m a infixl 1 >>= infixl 1 >> -- | A type f is a Functor if it provides a function fmap -- which, given any types a and b lets you apply any -- function from (a -> b) to turn an f a into an -- f b, preserving the structure of f. Furthermore -- f needs to adhere to the following: -- -- -- -- Note, that the second law follows from the free theorem of the type -- fmap and the first law, so you need only check that the former -- condition holds. class Functor (f :: Type -> Type) -- | Using ApplicativeDo: 'fmap f as' can be -- understood as the do expression -- --
-- do a <- as -- pure (f a) ---- -- with an inferred Functor constraint. fmap :: Functor f => (a -> b) -> f a -> f b -- | Replace all locations in the input with the same value. The default -- definition is fmap . const, but this may be -- overridden with a more efficient version. -- -- Using ApplicativeDo: 'a <$ bs' can be -- understood as the do expression -- --
-- do bs -- pure a ---- -- with an inferred Functor constraint. (<$) :: Functor f => a -> f b -> f a infixl 4 <$ -- | Basic numeric class. -- -- The Haskell Report defines no laws for Num. However, -- (+) and (*) are customarily expected -- to define a ring and have the following properties: -- --
-- abs x * signum x == x ---- -- For real numbers, the signum is either -1 (negative), -- 0 (zero) or 1 (positive). signum :: Num a => a -> a -- | Conversion from an Integer. An integer literal represents the -- application of the function fromInteger to the appropriate -- value of type Integer, so such literals have type -- (Num a) => a. fromInteger :: Num a => Integer -> a infixl 6 - infixl 6 + infixl 7 * class Eq a => Ord a compare :: Ord a => a -> a -> Ordering (<) :: Ord a => a -> a -> Bool (<=) :: Ord a => a -> a -> Bool (>) :: Ord a => a -> a -> Bool (>=) :: Ord a => a -> a -> Bool max :: Ord a => a -> a -> a min :: Ord a => a -> a -> a -- | Parsing of Strings, producing values. -- -- Derived instances of Read make the following assumptions, which -- derived instances of Show obey: -- --
-- infixr 5 :^: -- data Tree a = Leaf a | Tree a :^: Tree a ---- -- the derived instance of Read in Haskell 2010 is equivalent to -- --
-- instance (Read a) => Read (Tree a) where -- -- readsPrec d r = readParen (d > app_prec) -- (\r -> [(Leaf m,t) | -- ("Leaf",s) <- lex r, -- (m,t) <- readsPrec (app_prec+1) s]) r -- -- ++ readParen (d > up_prec) -- (\r -> [(u:^:v,w) | -- (u,s) <- readsPrec (up_prec+1) r, -- (":^:",t) <- lex s, -- (v,w) <- readsPrec (up_prec+1) t]) r -- -- where app_prec = 10 -- up_prec = 5 ---- -- Note that right-associativity of :^: is unused. -- -- The derived instance in GHC is equivalent to -- --
-- instance (Read a) => Read (Tree a) where -- -- readPrec = parens $ (prec app_prec $ do -- Ident "Leaf" <- lexP -- m <- step readPrec -- return (Leaf m)) -- -- +++ (prec up_prec $ do -- u <- step readPrec -- Symbol ":^:" <- lexP -- v <- step readPrec -- return (u :^: v)) -- -- where app_prec = 10 -- up_prec = 5 -- -- readListPrec = readListPrecDefault ---- -- Why do both readsPrec and readPrec exist, and why does -- GHC opt to implement readPrec in derived Read instances -- instead of readsPrec? The reason is that readsPrec is -- based on the ReadS type, and although ReadS is mentioned -- in the Haskell 2010 Report, it is not a very efficient parser data -- structure. -- -- readPrec, on the other hand, is based on a much more efficient -- ReadPrec datatype (a.k.a "new-style parsers"), but its -- definition relies on the use of the RankNTypes language -- extension. Therefore, readPrec (and its cousin, -- readListPrec) are marked as GHC-only. Nevertheless, it is -- recommended to use readPrec instead of readsPrec -- whenever possible for the efficiency improvements it brings. -- -- As mentioned above, derived Read instances in GHC will -- implement readPrec instead of readsPrec. The default -- implementations of readsPrec (and its cousin, readList) -- will simply use readPrec under the hood. If you are writing a -- Read instance by hand, it is recommended to write it like so: -- --
-- instance Read T where -- readPrec = ... -- readListPrec = readListPrecDefault --class Read a -- | attempts to parse a value from the front of the string, returning a -- list of (parsed value, remaining string) pairs. If there is no -- successful parse, the returned list is empty. -- -- Derived instances of Read and Show satisfy the -- following: -- -- -- -- That is, readsPrec parses the string produced by -- showsPrec, and delivers the value that showsPrec started -- with. readsPrec :: Read a => Int -> ReadS a -- | The method readList is provided to allow the programmer to give -- a specialised way of parsing lists of values. For example, this is -- used by the predefined Read instance of the Char type, -- where values of type String should be are expected to use -- double quotes, rather than square brackets. readList :: Read a => ReadS [a] class (Num a, Ord a) => Real a -- | the rational equivalent of its real argument with full precision toRational :: Real a => a -> Rational -- | Efficient, machine-independent access to the components of a -- floating-point number. class (RealFrac a, Floating a) => RealFloat a -- | a constant function, returning the radix of the representation (often -- 2) floatRadix :: RealFloat a => a -> Integer -- | a constant function, returning the number of digits of -- floatRadix in the significand floatDigits :: RealFloat a => a -> Int -- | a constant function, returning the lowest and highest values the -- exponent may assume floatRange :: RealFloat a => a -> (Int, Int) -- | The function decodeFloat applied to a real floating-point -- number returns the significand expressed as an Integer and an -- appropriately scaled exponent (an Int). If -- decodeFloat x yields (m,n), then x -- is equal in value to m*b^^n, where b is the -- floating-point radix, and furthermore, either m and -- n are both zero or else b^(d-1) <= abs m < -- b^d, where d is the value of floatDigits -- x. In particular, decodeFloat 0 = (0,0). If the -- type contains a negative zero, also decodeFloat (-0.0) = -- (0,0). The result of decodeFloat x is -- unspecified if either of isNaN x or -- isInfinite x is True. decodeFloat :: RealFloat a => a -> (Integer, Int) -- | encodeFloat performs the inverse of decodeFloat in the -- sense that for finite x with the exception of -0.0, -- uncurry encodeFloat (decodeFloat x) = x. -- encodeFloat m n is one of the two closest -- representable floating-point numbers to m*b^^n (or -- ±Infinity if overflow occurs); usually the closer, but if -- m contains too many bits, the result may be rounded in the -- wrong direction. encodeFloat :: RealFloat a => Integer -> Int -> a -- | exponent corresponds to the second component of -- decodeFloat. exponent 0 = 0 and for finite -- nonzero x, exponent x = snd (decodeFloat x) -- + floatDigits x. If x is a finite floating-point -- number, it is equal in value to significand x * b ^^ -- exponent x, where b is the floating-point radix. -- The behaviour is unspecified on infinite or NaN values. exponent :: RealFloat a => a -> Int -- | The first component of decodeFloat, scaled to lie in the open -- interval (-1,1), either 0.0 or of absolute -- value >= 1/b, where b is the floating-point -- radix. The behaviour is unspecified on infinite or NaN -- values. significand :: RealFloat a => a -> a -- | multiplies a floating-point number by an integer power of the radix scaleFloat :: RealFloat a => Int -> a -> a -- | True if the argument is an IEEE "not-a-number" (NaN) value isNaN :: RealFloat a => a -> Bool -- | True if the argument is an IEEE infinity or negative infinity isInfinite :: RealFloat a => a -> Bool -- | True if the argument is too small to be represented in -- normalized format isDenormalized :: RealFloat a => a -> Bool -- | True if the argument is an IEEE negative zero isNegativeZero :: RealFloat a => a -> Bool -- | True if the argument is an IEEE floating point number isIEEE :: RealFloat a => a -> Bool -- | a version of arctangent taking two real floating-point arguments. For -- real floating x and y, atan2 y x -- computes the angle (from the positive x-axis) of the vector from the -- origin to the point (x,y). atan2 y x returns -- a value in the range [-pi, pi]. It follows the -- Common Lisp semantics for the origin when signed zeroes are supported. -- atan2 y 1, with y in a type that is -- RealFloat, should return the same value as atan -- y. A default definition of atan2 is provided, but -- implementors can provide a more accurate implementation. atan2 :: RealFloat a => a -> a -> a -- | Extracting components of fractions. class (Real a, Fractional a) => RealFrac a -- | The function properFraction takes a real fractional number -- x and returns a pair (n,f) such that x = -- n+f, and: -- --
-- infixr 5 :^: -- data Tree a = Leaf a | Tree a :^: Tree a ---- -- the derived instance of Show is equivalent to -- --
-- instance (Show a) => Show (Tree a) where -- -- showsPrec d (Leaf m) = showParen (d > app_prec) $ -- showString "Leaf " . showsPrec (app_prec+1) m -- where app_prec = 10 -- -- showsPrec d (u :^: v) = showParen (d > up_prec) $ -- showsPrec (up_prec+1) u . -- showString " :^: " . -- showsPrec (up_prec+1) v -- where up_prec = 5 ---- -- Note that right-associativity of :^: is ignored. For example, -- --
-- showsPrec d x r ++ s == showsPrec d x (r ++ s) ---- -- Derived instances of Read and Show satisfy the -- following: -- -- -- -- That is, readsPrec parses the string produced by -- showsPrec, and delivers the value that showsPrec started -- with. showsPrec :: Show a => Int -> a -> ShowS -- | A specialised variant of showsPrec, using precedence context -- zero, and returning an ordinary String. show :: Show a => a -> String -- | The method showList is provided to allow the programmer to give -- a specialised way of showing lists of values. For example, this is -- used by the predefined Show instance of the Char type, -- where values of type String should be shown in double quotes, -- rather than between square brackets. showList :: Show a => [a] -> ShowS -- | When a value is bound in do-notation, the pattern on the left -- hand side of <- might not match. In this case, this class -- provides a function to recover. -- -- A Monad without a MonadFail instance may only be used in -- conjunction with pattern that always match, such as newtypes, tuples, -- data types with only a single data constructor, and irrefutable -- patterns (~pat). -- -- Instances of MonadFail should satisfy the following law: -- fail s should be a left zero for >>=, -- --
-- fail s >>= f = fail s ---- -- If your Monad is also MonadPlus, a popular definition is -- --
-- fail _ = mzero --class Monad m => MonadFail (m :: Type -> Type) fail :: MonadFail m => String -> m a -- | A functor with application, providing operations to -- --
-- (<*>) = liftA2 id ---- --
-- liftA2 f x y = f <$> x <*> y ---- -- Further, any definition must satisfy the following: -- --
pure id <*> v = -- v
pure (.) <*> u -- <*> v <*> w = u <*> (v -- <*> w)
pure f <*> -- pure x = pure (f x)
u <*> pure y = -- pure ($ y) <*> u
-- forall x y. p (q x y) = f x . g y ---- -- it follows from the above that -- --
-- liftA2 p (liftA2 q u v) = liftA2 f u . liftA2 g v ---- -- If f is also a Monad, it should satisfy -- -- -- -- (which implies that pure and <*> satisfy the -- applicative functor laws). class Functor f => Applicative (f :: Type -> Type) -- | Lift a value. pure :: Applicative f => a -> f a -- | Sequential application. -- -- A few functors support an implementation of <*> that is -- more efficient than the default one. -- -- Using ApplicativeDo: 'fs <*> as' can be -- understood as the do expression -- --
-- do f <- fs -- a <- as -- pure (f a) --(<*>) :: Applicative f => f (a -> b) -> f a -> f b -- | Sequence actions, discarding the value of the first argument. -- -- 'as *> bs' can be understood as the do -- expression -- --
-- do as -- bs ---- -- This is a tad complicated for our ApplicativeDo extension -- which will give it a Monad constraint. For an -- Applicative constraint we write it of the form -- --
-- do _ <- as -- b <- bs -- pure b --(*>) :: Applicative f => f a -> f b -> f b -- | Sequence actions, discarding the value of the second argument. -- -- Using ApplicativeDo: 'as <* bs' can be -- understood as the do expression -- --
-- do a <- as -- bs -- pure a --(<*) :: Applicative f => f a -> f b -> f a infixl 4 <* infixl 4 *> infixl 4 <*> -- | Does the element occur in the structure? -- -- Note: elem is often used in infix form. -- --
-- >>> 3 `elem` [] -- False ---- --
-- >>> 3 `elem` [1,2] -- False ---- --
-- >>> 3 `elem` [1,2,3,4,5] -- True ---- -- For infinite structures, elem terminates if the value exists at -- a finite distance from the left side of the structure: -- --
-- >>> 3 `elem` [1..] -- True ---- --
-- >>> 3 `elem` ([4..] ++ [3]) -- * Hangs forever * --elem :: (Foldable t, Eq a) => a -> t a -> Bool infix 4 `elem` -- | The least element of a non-empty structure. -- -- ⚠️ This function is non-total and will raise a runtime exception if -- the structure happens to be empty -- --
-- >>> minimum [1..10] -- 1 ---- --
-- >>> minimum [] -- *** Exception: Prelude.minimum: empty list ---- --
-- >>> minimum Nothing -- *** Exception: minimum: empty structure --minimum :: (Foldable t, Ord a) => t a -> a -- | The largest element of a non-empty structure. -- -- ⚠️ This function is non-total and will raise a runtime exception if -- the structure happens to be empty. -- --
-- >>> maximum [1..10] -- 10 ---- --
-- >>> maximum [] -- *** Exception: Prelude.maximum: empty list ---- --
-- >>> maximum Nothing -- *** Exception: maximum: empty structure --maximum :: (Foldable t, Ord a) => t a -> a -- | The product function computes the product of the numbers of a -- structure. -- --
-- >>> product [] -- 1 ---- --
-- >>> product [42] -- 42 ---- --
-- >>> product [1..10] -- 3628800 ---- --
-- >>> product [4.1, 2.0, 1.7] -- 13.939999999999998 ---- --
-- >>> product [1..] -- * Hangs forever * --product :: (Foldable t, Num a) => t a -> a -- | 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 <math> -- 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 (+) 42 (Node (Leaf 1) 3 (Node Empty 4 (Leaf 2))) -- 52 ---- --
-- >>> foldl (+) 42 Empty -- 42 ---- --
-- >>> foldl (\string nextElement -> nextElement : string) "abcd" (Node (Leaf 'd') 'e' (Node Empty 'f' (Leaf 'g'))) -- "gfedabcd" ---- -- Left-folding infinite structures never terminates: -- --
-- >>> let infiniteNode = Node Empty 1 infiniteNode in foldl (+) 42 infiniteNode -- * Hangs forever * ---- -- Evaluating the head of the result (when applicable) does not -- terminate, unlike foldr: -- --
-- >>> let infiniteNode = Node Empty 'd' infiniteNode in take 5 (foldl (\string nextElement -> nextElement : string) "abc" infiniteNode) -- * Hangs forever * --foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b -- | The sum function computes the sum of the numbers of a -- structure. -- --
-- >>> sum [] -- 0 ---- --
-- >>> sum [42] -- 42 ---- --
-- >>> sum [1..10] -- 55 ---- --
-- >>> sum [4.1, 2.0, 1.7] -- 7.8 ---- --
-- >>> sum [1..] -- * Hangs forever * --sum :: (Foldable t, Num a) => t a -> a -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following: -- --
-- >>> "Hello world" <> mempty -- "Hello world" --mempty :: Monoid a => a -- | An associative operation -- -- NOTE: This method is redundant and has the default -- implementation mappend = (<>) since -- base-4.11.0.0. Should it be implemented manually, since -- mappend is a synonym for (<>), it is expected that -- the two functions are defined the same way. In a future GHC release -- mappend will be removed from Monoid. 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 ["Hello", " ", "Haskell", "!"] -- "Hello Haskell!" --mconcat :: Monoid a => [a] -> a data Bool False :: Bool True :: Bool data Char data Double data Float data Int data Integer -- | The Maybe type encapsulates an optional value. A value of type -- Maybe a either contains a value of type a -- (represented as Just a), or it is empty (represented -- as Nothing). Using Maybe is a good way to deal with -- errors or exceptional cases without resorting to drastic measures such -- as error. -- -- The Maybe type is also a monad. It is a simple kind of error -- monad, where all errors are represented by Nothing. A richer -- error monad can be built using the Either type. data Maybe a Nothing :: Maybe a Just :: a -> Maybe a data Ordering LT :: Ordering EQ :: Ordering GT :: Ordering -- | Arbitrary-precision rational numbers, represented as a ratio of two -- Integer values. A rational number may be constructed using the -- % operator. type Rational = Ratio Integer -- | The Either type represents values with two possibilities: a -- value of type Either a b is either Left -- a or Right b. -- -- The Either type is sometimes used to represent a value which is -- either correct or an error; by convention, the Left constructor -- is used to hold an error value and the Right constructor is -- used to hold a correct value (mnemonic: "right" also means "correct"). -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> s -- Left "foo" -- -- >>> let n = Right 3 :: Either String Int -- -- >>> n -- Right 3 -- -- >>> :type s -- s :: Either String Int -- -- >>> :type n -- n :: Either String Int ---- -- The fmap from our Functor instance will ignore -- Left values, but will apply the supplied function to values -- contained in a Right: -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> let n = Right 3 :: Either String Int -- -- >>> fmap (*2) s -- Left "foo" -- -- >>> fmap (*2) n -- Right 6 ---- -- The Monad instance for Either allows us to chain -- together multiple actions which may fail, and fail overall if any of -- the individual steps failed. First we'll write a function that can -- either parse an Int from a Char, or fail. -- --
-- >>> import Data.Char ( digitToInt, isDigit ) -- -- >>> :{ -- let parseEither :: Char -> Either String Int -- parseEither c -- | isDigit c = Right (digitToInt c) -- | otherwise = Left "parse error" -- -- >>> :} ---- -- The following should work, since both '1' and '2' -- can be parsed as Ints. -- --
-- >>> :{ -- let parseMultiple :: Either String Int -- parseMultiple = do -- x <- parseEither '1' -- y <- parseEither '2' -- return (x + y) -- -- >>> :} ---- --
-- >>> parseMultiple -- Right 3 ---- -- But the following should fail overall, since the first operation where -- we attempt to parse 'm' as an Int will fail: -- --
-- >>> :{ -- let parseMultiple :: Either String Int -- parseMultiple = do -- x <- parseEither 'm' -- y <- parseEither '2' -- return (x + y) -- -- >>> :} ---- --
-- >>> parseMultiple -- Left "parse error" --data Either a b Left :: a -> Either a b Right :: b -> Either a b -- | The readIO function is similar to read except that it -- signals parse failure to the IO monad instead of terminating -- the program. readIO :: Read a => String -> IO a -- | The readLn function combines getLine and readIO. readLn :: Read a => IO a -- | The computation appendFile file str function appends -- the string str, to the file file. -- -- Note that writeFile and appendFile write a literal -- string to a file. To write a value of any printable type, as with -- print, use the show function to convert the value to a -- string first. -- --
-- main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]]) --appendFile :: FilePath -> String -> IO () -- | The computation writeFile file str function writes the -- string str, to the file file. writeFile :: FilePath -> String -> IO () -- | The readFile function reads a file and returns the contents of -- the file as a string. The file is read lazily, on demand, as with -- getContents. readFile :: FilePath -> IO String -- | The interact function takes a function of type -- String->String as its argument. The entire input from the -- standard input device is passed to this function as its argument, and -- the resulting string is output on the standard output device. interact :: (String -> String) -> IO () -- | The getContents operation returns all user input as a single -- string, which is read lazily as it is needed (same as -- hGetContents stdin). getContents :: IO String -- | Read a line from the standard input device (same as hGetLine -- stdin). getLine :: IO String -- | Read a character from the standard input device (same as -- hGetChar stdin). getChar :: IO Char -- | The same as putStr, but adds a newline character. putStrLn :: String -> IO () -- | Write a string to the standard output device (same as hPutStr -- stdout). putStr :: String -> IO () -- | Write a character to the standard output device (same as -- hPutChar stdout). putChar :: Char -> IO () -- | Raise an IOException in the IO monad. ioError :: IOError -> IO a -- | File and directory names are values of type String, whose -- precise meaning is operating system dependent. Files can be opened, -- yielding a handle which can then be used to operate on the contents of -- that file. type FilePath = String -- | Construct an IOException value with a string describing the -- error. The fail method of the IO instance of the -- Monad class raises a userError, thus: -- --
-- instance Monad IO where -- ... -- fail s = ioError (userError s) --userError :: String -> IOError -- | The Haskell 2010 type for exceptions in the IO monad. Any I/O -- operation may raise an IOException instead of returning a -- result. For a more general type of exception, including also those -- that arise in pure code, see Exception. -- -- In Haskell 2010, this is an opaque type. type IOError = IOException -- | notElem is the negation of elem. -- --
-- >>> 3 `notElem` [] -- True ---- --
-- >>> 3 `notElem` [1,2] -- True ---- --
-- >>> 3 `notElem` [1,2,3,4,5] -- False ---- -- For infinite structures, notElem terminates if the value exists -- at a finite distance from the left side of the structure: -- --
-- >>> 3 `notElem` [1..] -- False ---- --
-- >>> 3 `notElem` ([4..] ++ [3]) -- * Hangs forever * --notElem :: (Foldable t, Eq a) => a -> t a -> Bool infix 4 `notElem` -- | or returns the disjunction of a container of Bools. For the -- result to be False, the container must be finite; True, -- however, results from a True value finitely far from the left -- end. -- --
-- >>> or [] -- False ---- --
-- >>> or [True] -- True ---- --
-- >>> or [False] -- False ---- --
-- >>> or [True, True, False] -- True ---- --
-- >>> or (True : repeat False) -- Infinite list [True,False,False,False,False,False,False... -- True ---- --
-- >>> or (repeat False) -- * Hangs forever * --or :: Foldable t => t Bool -> Bool -- | and returns the conjunction of a container of Bools. For the -- result to be True, the container must be finite; False, -- however, results from a False value finitely far from the left -- end. -- --
-- >>> and [] -- True ---- --
-- >>> and [True] -- True ---- --
-- >>> and [False] -- False ---- --
-- >>> and [True, True, False] -- False ---- --
-- >>> and (False : repeat True) -- Infinite list [False,True,True,True,True,True,True... -- False ---- --
-- >>> and (repeat True) -- * Hangs forever * --and :: Foldable t => t Bool -> Bool -- | Map a function over all the elements of a container and concatenate -- the resulting lists. -- --
-- >>> concatMap (take 3) [[1..], [10..], [100..], [1000..]] -- [1,2,3,10,11,12,100,101,102,1000,1001,1002] ---- --
-- >>> concatMap (take 3) (Node (Leaf [1..]) [10..] Empty) -- [1,2,3,10,11,12] --concatMap :: Foldable t => (a -> [b]) -> t a -> [b] -- | The concatenation of all the elements of a container of lists. -- --
-- >>> concat (Just [1, 2, 3]) -- [1,2,3] ---- --
-- >>> concat (Node (Leaf [1, 2, 3]) [4, 5] (Node Empty [6] (Leaf []))) -- [1,2,3,4,5,6] --concat :: Foldable t => t [a] -> [a] -- | Evaluate each monadic action in the structure from left to right, and -- ignore the results. For a version that doesn't ignore the results see -- sequence. -- -- As of base 4.8.0.0, sequence_ is just sequenceA_, -- specialized to Monad. sequence_ :: (Foldable t, Monad m) => t (m a) -> m () -- | unwords is an inverse operation to words. It joins words -- with separating spaces. -- --
-- >>> unwords ["Lorem", "ipsum", "dolor"] -- "Lorem ipsum dolor" --unwords :: [String] -> String -- | words breaks a string up into a list of words, which were -- delimited by white space. -- --
-- >>> words "Lorem ipsum\ndolor" -- ["Lorem","ipsum","dolor"] --words :: String -> [String] -- | unlines is an inverse operation to lines. It joins -- lines, after appending a terminating newline to each. -- --
-- >>> unlines ["Hello", "World", "!"] -- "Hello\nWorld\n!\n" --unlines :: [String] -> String -- | lines breaks a string up into a list of strings at newline -- characters. The resulting strings do not contain newlines. -- -- Note that after splitting the string at newline characters, the last -- part of the string is considered a line even if it doesn't end with a -- newline. For example, -- --
-- >>> lines "" -- [] ---- --
-- >>> lines "\n" -- [""] ---- --
-- >>> lines "one" -- ["one"] ---- --
-- >>> lines "one\n" -- ["one"] ---- --
-- >>> lines "one\n\n" -- ["one",""] ---- --
-- >>> lines "one\ntwo" -- ["one","two"] ---- --
-- >>> lines "one\ntwo\n" -- ["one","two"] ---- -- Thus lines s contains at least as many elements as -- newlines in s. lines :: String -> [String] -- | equivalent to readsPrec with a precedence of 0. reads :: Read a => ReadS a -- | Case analysis for the Either type. If the value is -- Left a, apply the first function to a; if it -- is Right b, apply the second function to b. -- --
-- >>> let s = Left "foo" :: Either String Int -- -- >>> let n = Right 3 :: Either String Int -- -- >>> either length (*2) s -- 3 -- -- >>> either length (*2) n -- 6 --either :: (a -> c) -> (b -> c) -> Either a b -> c -- | The lex function reads a single lexeme from the input, -- discarding initial white space, and returning the characters that -- constitute the lexeme. If the input string contains only white space, -- lex returns a single successful `lexeme' consisting of the -- empty string. (Thus lex "" = [("","")].) If there is -- no legal lexeme at the beginning of the input string, lex fails -- (i.e. returns []). -- -- This lexer is not completely faithful to the Haskell lexical syntax in -- the following respects: -- --
-- >>> unzip3 [] -- ([],[],[]) -- -- >>> unzip3 [(1, 'a', True), (2, 'b', False)] -- ([1,2],"ab",[True,False]) --unzip3 :: [(a, b, c)] -> ([a], [b], [c]) -- | unzip transforms a list of pairs into a list of first -- components and a list of second components. -- --
-- >>> unzip [] -- ([],[]) -- -- >>> unzip [(1, 'a'), (2, 'b')] -- ([1,2],"ab") --unzip :: [(a, b)] -> ([a], [b]) -- | The zipWith3 function takes a function which combines three -- elements, as well as three lists and returns a list of the function -- applied to corresponding elements, analogous to zipWith. It is -- capable of list fusion, but it is restricted to its first list -- argument and its resulting list. -- --
-- zipWith3 (,,) xs ys zs == zip3 xs ys zs -- zipWith3 f [x1,x2,x3..] [y1,y2,y3..] [z1,z2,z3..] == [f x1 y1 z1, f x2 y2 z2, f x3 y3 z3..] --zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] -- | <math>. zipWith generalises zip by zipping with -- the function given as the first argument, instead of a tupling -- function. -- --
-- zipWith (,) xs ys == zip xs ys -- zipWith f [x1,x2,x3..] [y1,y2,y3..] == [f x1 y1, f x2 y2, f x3 y3..] ---- -- For example, zipWith (+) is applied to two lists to -- produce the list of corresponding sums: -- --
-- >>> zipWith (+) [1, 2, 3] [4, 5, 6] -- [5,7,9] ---- -- zipWith is right-lazy: -- --
-- >>> zipWith f [] _|_ -- [] ---- -- zipWith is capable of list fusion, but it is restricted to its -- first list argument and its resulting list. zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] -- | zip3 takes three lists and returns a list of triples, analogous -- to zip. It is capable of list fusion, but it is restricted to -- its first list argument and its resulting list. zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] -- | List index (subscript) operator, starting from 0. It is an instance of -- the more general genericIndex, which takes an index of any -- integral type. -- --
-- >>> ['a', 'b', 'c'] !! 0 -- 'a' -- -- >>> ['a', 'b', 'c'] !! 2 -- 'c' -- -- >>> ['a', 'b', 'c'] !! 3 -- Exception: Prelude.!!: index too large -- -- >>> ['a', 'b', 'c'] !! (-1) -- Exception: Prelude.!!: negative index --(!!) :: [a] -> Int -> a infixl 9 !! -- | <math>. lookup key assocs looks up a key in an -- association list. -- --
-- >>> lookup 2 [] -- Nothing -- -- >>> lookup 2 [(1, "first")] -- Nothing -- -- >>> lookup 2 [(1, "first"), (2, "second"), (3, "third")] -- Just "second" --lookup :: Eq a => a -> [(a, b)] -> Maybe b -- | reverse xs returns the elements of xs in -- reverse order. xs must be finite. -- --
-- >>> reverse [] -- [] -- -- >>> reverse [42] -- [42] -- -- >>> reverse [2,5,7] -- [7,5,2] -- -- >>> reverse [1..] -- * Hangs forever * --reverse :: [a] -> [a] -- | break, applied to a predicate p and a list -- xs, returns a tuple where first element is longest prefix -- (possibly empty) of xs of elements that do not satisfy -- p and second element is the remainder of the list: -- --
-- >>> break (> 3) [1,2,3,4,1,2,3,4] -- ([1,2,3],[4,1,2,3,4]) -- -- >>> break (< 9) [1,2,3] -- ([],[1,2,3]) -- -- >>> break (> 9) [1,2,3] -- ([1,2,3],[]) ---- -- break p is equivalent to span (not . -- p). break :: (a -> Bool) -> [a] -> ([a], [a]) -- | span, applied to a predicate p and a list xs, -- returns a tuple where first element is longest prefix (possibly empty) -- of xs of elements that satisfy p and second element -- is the remainder of the list: -- --
-- >>> span (< 3) [1,2,3,4,1,2,3,4] -- ([1,2],[3,4,1,2,3,4]) -- -- >>> span (< 9) [1,2,3] -- ([1,2,3],[]) -- -- >>> span (< 0) [1,2,3] -- ([],[1,2,3]) ---- -- span p xs is equivalent to (takeWhile p xs, -- dropWhile p xs) span :: (a -> Bool) -> [a] -> ([a], [a]) -- | splitAt n xs returns a tuple where first element is -- xs prefix of length n and second element is the -- remainder of the list: -- --
-- >>> splitAt 6 "Hello World!" -- ("Hello ","World!") -- -- >>> splitAt 3 [1,2,3,4,5] -- ([1,2,3],[4,5]) -- -- >>> splitAt 1 [1,2,3] -- ([1],[2,3]) -- -- >>> splitAt 3 [1,2,3] -- ([1,2,3],[]) -- -- >>> splitAt 4 [1,2,3] -- ([1,2,3],[]) -- -- >>> splitAt 0 [1,2,3] -- ([],[1,2,3]) -- -- >>> splitAt (-1) [1,2,3] -- ([],[1,2,3]) ---- -- It is equivalent to (take n xs, drop n xs) when -- n is not _|_ (splitAt _|_ xs = _|_). -- splitAt is an instance of the more general -- genericSplitAt, in which n may be of any integral -- type. splitAt :: Int -> [a] -> ([a], [a]) -- | drop n xs returns the suffix of xs after the -- first n elements, or [] if n > length -- xs. -- --
-- >>> drop 6 "Hello World!" -- "World!" -- -- >>> drop 3 [1,2,3,4,5] -- [4,5] -- -- >>> drop 3 [1,2] -- [] -- -- >>> drop 3 [] -- [] -- -- >>> drop (-1) [1,2] -- [1,2] -- -- >>> drop 0 [1,2] -- [1,2] ---- -- It is an instance of the more general genericDrop, in which -- n may be of any integral type. drop :: Int -> [a] -> [a] -- | take n, applied to a list xs, returns the -- prefix of xs of length n, or xs itself if -- n > length xs. -- --
-- >>> take 5 "Hello World!" -- "Hello" -- -- >>> take 3 [1,2,3,4,5] -- [1,2,3] -- -- >>> take 3 [1,2] -- [1,2] -- -- >>> take 3 [] -- [] -- -- >>> take (-1) [1,2] -- [] -- -- >>> take 0 [1,2] -- [] ---- -- It is an instance of the more general genericTake, in which -- n may be of any integral type. take :: Int -> [a] -> [a] -- | dropWhile p xs returns the suffix remaining after -- takeWhile p xs. -- --
-- >>> dropWhile (< 3) [1,2,3,4,5,1,2,3] -- [3,4,5,1,2,3] -- -- >>> dropWhile (< 9) [1,2,3] -- [] -- -- >>> dropWhile (< 0) [1,2,3] -- [1,2,3] --dropWhile :: (a -> Bool) -> [a] -> [a] -- | takeWhile, applied to a predicate p and a list -- xs, returns the longest prefix (possibly empty) of -- xs of elements that satisfy p. -- --
-- >>> takeWhile (< 3) [1,2,3,4,1,2,3,4] -- [1,2] -- -- >>> takeWhile (< 9) [1,2,3] -- [1,2,3] -- -- >>> takeWhile (< 0) [1,2,3] -- [] --takeWhile :: (a -> Bool) -> [a] -> [a] -- | cycle ties a finite list into a circular one, or equivalently, -- the infinite repetition of the original list. It is the identity on -- infinite lists. -- --
-- >>> cycle [] -- Exception: Prelude.cycle: empty list -- -- >>> cycle [42] -- [42,42,42,42,42,42,42,42,42,42... -- -- >>> cycle [2, 5, 7] -- [2,5,7,2,5,7,2,5,7,2,5,7... --cycle :: [a] -> [a] -- | replicate n x is a list of length n with -- x the value of every element. It is an instance of the more -- general genericReplicate, in which n may be of any -- integral type. -- --
-- >>> replicate 0 True -- [] -- -- >>> replicate (-1) True -- [] -- -- >>> replicate 4 True -- [True,True,True,True] --replicate :: Int -> a -> [a] -- | repeat x is an infinite list, with x the -- value of every element. -- --
-- >>> repeat 17 -- [17,17,17,17,17,17,17,17,17... --repeat :: a -> [a] -- | iterate f x returns an infinite list of repeated -- applications of f to x: -- --
-- iterate f x == [x, f x, f (f x), ...] ---- -- Note that iterate is lazy, potentially leading to thunk -- build-up if the consumer doesn't force each iterate. See -- iterate' for a strict variant of this function. -- --
-- >>> iterate not True -- [True,False,True,False... -- -- >>> iterate (+3) 42 -- [42,45,48,51,54,57,60,63... --iterate :: (a -> a) -> a -> [a] -- | <math>. scanr1 is a variant of scanr that has no -- starting value argument. -- --
-- >>> scanr1 (+) [1..4] -- [10,9,7,4] -- -- >>> scanr1 (+) [] -- [] -- -- >>> scanr1 (-) [1..4] -- [-2,3,-1,4] -- -- >>> scanr1 (&&) [True, False, True, True] -- [False,False,True,True] -- -- >>> scanr1 (||) [True, True, False, False] -- [True,True,False,False] -- -- >>> scanr1 (+) [1..] -- * Hangs forever * --scanr1 :: (a -> a -> a) -> [a] -> [a] -- | <math>. scanr is the right-to-left dual of scanl. -- Note that the order of parameters on the accumulating function are -- reversed compared to scanl. Also note that -- --
-- head (scanr f z xs) == foldr f z xs. ---- --
-- >>> scanr (+) 0 [1..4] -- [10,9,7,4,0] -- -- >>> scanr (+) 42 [] -- [42] -- -- >>> scanr (-) 100 [1..4] -- [98,-97,99,-96,100] -- -- >>> scanr (\nextChar reversedString -> nextChar : reversedString) "foo" ['a', 'b', 'c', 'd'] -- ["abcdfoo","bcdfoo","cdfoo","dfoo","foo"] -- -- >>> scanr (+) 0 [1..] -- * Hangs forever * --scanr :: (a -> b -> b) -> b -> [a] -> [b] -- | <math>. scanl1 is a variant of scanl that has no -- starting value argument: -- --
-- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] ---- --
-- >>> scanl1 (+) [1..4] -- [1,3,6,10] -- -- >>> scanl1 (+) [] -- [] -- -- >>> scanl1 (-) [1..4] -- [1,-1,-4,-8] -- -- >>> scanl1 (&&) [True, False, True, True] -- [True,False,False,False] -- -- >>> scanl1 (||) [False, False, True, True] -- [False,False,True,True] -- -- >>> scanl1 (+) [1..] -- * Hangs forever * --scanl1 :: (a -> a -> a) -> [a] -> [a] -- | <math>. scanl is similar to foldl, but returns a -- list of successive reduced values from the left: -- --
-- scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] ---- -- Note that -- --
-- last (scanl f z xs) == foldl f z xs ---- --
-- >>> scanl (+) 0 [1..4] -- [0,1,3,6,10] -- -- >>> scanl (+) 42 [] -- [42] -- -- >>> scanl (-) 100 [1..4] -- [100,99,97,94,90] -- -- >>> scanl (\reversedString nextChar -> nextChar : reversedString) "foo" ['a', 'b', 'c', 'd'] -- ["foo","afoo","bafoo","cbafoo","dcbafoo"] -- -- >>> scanl (+) 0 [1..] -- * Hangs forever * --scanl :: (b -> a -> b) -> b -> [a] -> [b] -- | The maybe function takes a default value, a function, and a -- Maybe value. If the Maybe value is Nothing, the -- function returns the default value. Otherwise, it applies the function -- to the value inside the Just and returns the result. -- --
-- >>> maybe False odd (Just 3) -- True ---- --
-- >>> maybe False odd Nothing -- False ---- -- Read an integer from a string using readMaybe. If we succeed, -- return twice the integer; that is, apply (*2) to it. If -- instead we fail to parse an integer, return 0 by default: -- --
-- >>> import Text.Read ( readMaybe ) -- -- >>> maybe 0 (*2) (readMaybe "5") -- 10 -- -- >>> maybe 0 (*2) (readMaybe "") -- 0 ---- -- Apply show to a Maybe Int. If we have Just n, -- we want to show the underlying Int n. But if we have -- Nothing, we return the empty string instead of (for example) -- "Nothing": -- --
-- >>> maybe "" show (Just 5) -- "5" -- -- >>> maybe "" show Nothing -- "" --maybe :: b -> (a -> b) -> Maybe a -> b -- | An infix synonym for fmap. -- -- The name of this operator is an allusion to $. Note the -- similarities between their types: -- --
-- ($) :: (a -> b) -> a -> b -- (<$>) :: Functor f => (a -> b) -> f a -> f b ---- -- Whereas $ is function application, <$> is function -- application lifted over a Functor. -- --
-- >>> show <$> Nothing -- Nothing -- -- >>> show <$> Just 3 -- Just "3" ---- -- Convert from an Either Int Int to an -- Either Int String using show: -- --
-- >>> show <$> Left 17 -- Left 17 -- -- >>> show <$> Right 17 -- Right "17" ---- -- Double each element of a list: -- --
-- >>> (*2) <$> [1,2,3] -- [2,4,6] ---- -- Apply even to the second element of a pair: -- --
-- >>> even <$> (2,2) -- (2,True) --(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 <$> -- | uncurry converts a curried function to a function on pairs. -- --
-- >>> uncurry (+) (1,2) -- 3 ---- --
-- >>> uncurry ($) (show, 1) -- "1" ---- --
-- >>> map (uncurry max) [(1,2), (3,4), (6,8)] -- [2,4,8] --uncurry :: (a -> b -> c) -> (a, b) -> c -- | curry converts an uncurried function to a curried function. -- --
-- >>> curry fst 1 2 -- 1 --curry :: ((a, b) -> c) -> a -> b -> c -- | the same as flip (-). -- -- Because - is treated specially in the Haskell grammar, -- (- e) is not a section, but an application of -- prefix negation. However, (subtract -- exp) is equivalent to the disallowed section. subtract :: Num a => a -> a -> a -- | asTypeOf is a type-restricted version of const. It is -- usually used as an infix operator, and its typing forces its first -- argument (which is usually overloaded) to have the same type as the -- second. asTypeOf :: a -> a -> a -- | until p f yields the result of applying f -- until p holds. until :: (a -> Bool) -> (a -> a) -> a -> a -- | Strict (call-by-value) application operator. It takes a function and -- an argument, evaluates the argument to weak head normal form (WHNF), -- then calls the function with that value. ($!) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b infixr 0 $! -- | flip f takes its (first) two arguments in the reverse -- order of f. -- --
-- >>> flip (++) "hello" "world" -- "worldhello" --flip :: (a -> b -> c) -> b -> a -> c -- | Function composition. (.) :: (b -> c) -> (a -> b) -> a -> c infixr 9 . -- | const x is a unary function which evaluates to x for -- all inputs. -- --
-- >>> const 42 "hello" -- 42 ---- --
-- >>> map (const 42) [0..3] -- [42,42,42,42] --const :: a -> b -> a -- | Identity function. -- --
-- id x = x --id :: a -> a -- | Same as >>=, but with the arguments interchanged. (=<<) :: Monad m => (a -> m b) -> m a -> m b infixr 1 =<< -- | A String is a list of characters. String constants in Haskell -- are values of type String. -- -- See Data.List for operations on lists. type String = [Char] -- | A special case of error. It is expected that compilers will -- recognize this and insert error messages which are more appropriate to -- the context in which undefined appears. undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a -- | A variant of error that does not produce a stack trace. errorWithoutStackTrace :: forall (r :: RuntimeRep) (a :: TYPE r). [Char] -> a -- | error stops execution and displays an error message. error :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => [Char] -> a (&&) :: Bool -> Bool -> Bool (||) :: Bool -> Bool -> Bool not :: Bool -> Bool -- | The class of semigroups (types with an associative binary operation). -- -- Instances should satisfy the following: -- -- class Semigroup a -- | An associative operation. -- --
-- >>> [1,2,3] <> [4,5,6] -- [1,2,3,4,5,6] --(<>) :: Semigroup a => a -> a -> a infixr 6 <> -- | 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 (a :: k) -- | A quantified type representation. type TypeRep = SomeTypeRep -- | Takes a value of type a and returns a concrete representation -- of that type. typeRep :: forall {k} proxy (a :: k). Typeable a => proxy a -> TypeRep -- | 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 within 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. -- -- A Generic instance must satisfy the following laws: -- --
-- from . to ≡ id -- to . from ≡ id --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 '()'. -- --
-- {-# 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) ---- --
-- 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 PutM 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 -- | Class of types with a known Structure. -- -- For regular data types Structured can be derived generically. -- --
-- data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic) -- instance Structured Record --class Typeable a => Structured a -- | A monoid on applicative functors. -- -- If defined, some and many should be the least solutions -- of the equations: -- -- class Applicative f => Alternative (f :: Type -> Type) -- | 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] infixl 3 <|> -- | Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) -- | The identity of mplus. It should also satisfy the equations -- --
-- mzero >>= f = mzero -- v >> mzero = mzero ---- -- The default definition is -- --
-- mzero = empty --mzero :: MonadPlus m => m a -- | An associative operation. The default definition is -- --
-- mplus = (<|>) --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. -- -- The Semigroup operation for Map is union, which -- prefers values from the left operand. If m1 maps a key -- k to a value a1, and m2 maps the same key -- to a different value a2, then their union m1 <> -- m2 maps k to a1. data Map k a -- | A set of values a. data Set a -- | Identity functor and monad. (a non-strict monad) newtype Identity a Identity :: a -> Identity a [runIdentity] :: Identity a -> a -- | Proxy is a type that holds no data, but has a phantom parameter -- of arbitrary type (or even kind). Its use is to provide type -- information, even though there is no value available of that type (or -- it may be too costly to create one). -- -- Historically, Proxy :: Proxy a is a safer -- alternative to the undefined :: a idiom. -- --
-- >>> Proxy :: Proxy (Void, Int -> Int) -- Proxy ---- -- Proxy can even hold types of higher kinds, -- --
-- >>> Proxy :: Proxy Either -- Proxy ---- --
-- >>> Proxy :: Proxy Functor -- Proxy ---- --
-- >>> Proxy :: Proxy complicatedStructure -- Proxy --data Proxy (t :: k) Proxy :: Proxy t :: k -- | The catMaybes function takes a list of Maybes and -- returns a list of all the Just values. -- --
-- >>> 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. -- --
-- >>> 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 a Maybe -- value. If the Maybe is Nothing, it returns the default -- values; otherwise, it returns the value contained in the Maybe. -- --
-- >>> 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 given Just. -- --
-- >>> 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. -- --
-- >>> 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. -- --
-- >>> 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 _. -- --
-- >>> 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] -- | <math>. The isPrefixOf function takes two lists and -- returns True iff the first list is a prefix of the second. -- --
-- >>> "Hello" `isPrefixOf` "Hello World!" -- True ---- --
-- >>> "Hello" `isPrefixOf` "Wello Horld!" -- False --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. -- --
-- >>> "ld!" `isSuffixOf` "Hello World!" -- True ---- --
-- >>> "World" `isSuffixOf` "Hello World!" -- False --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 ", " ["Lorem", "ipsum", "dolor"] -- "Lorem, ipsum, dolor" --intercalate :: [a] -> [[a]] -> [a] -- | <math>. 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 lowest to highest, keeping duplicates in -- the order they appeared in the input. -- --
-- >>> sort [1,6,4,3,2,5] -- [1,2,3,4,5,6] --sort :: Ord a => [a] -> [a] -- | The sortBy function is the non-overloaded version of -- sort. -- --
-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")] -- [(1,"Hello"),(2,"world"),(4,"!")] --sortBy :: (a -> a -> Ordering) -> [a] -> [a] -- | <math>. 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 [1,2,3,4,3,2,1,2,4,3,5] -- [1,2,3,4,5] --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 (\x y -> mod x 3 == mod y 3) [1,2,4,5,6] -- [1,2,6] --nubBy :: (a -> a -> Bool) -> [a] -> [a] -- | Non-empty (and non-strict) list type. data NonEmpty a (:|) :: a -> [a] -> NonEmpty a infixr 5 :| foldl1 :: (a -> a -> a) -> NonEmpty a -> a foldr1 :: (a -> a -> a) -> NonEmpty a -> a -- | Extract the first element of the stream. head :: NonEmpty a -> a -- | Extract the possibly-empty tail of the stream. tail :: NonEmpty a -> [a] -- | Extract the last element of the stream. last :: NonEmpty a -> a -- | Extract everything except the last element of the stream. init :: NonEmpty 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 ---- --
-- length = getSum . foldMap (Sum . const 1) ---- -- 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 :: Type -> Type) -- | Map each element of the structure to a monoid, and combine the -- results. -- --
-- >>> foldMap Sum [1, 3, 5] -- Sum {getSum = 9} ---- --
-- >>> foldMap Product [1, 3, 5] -- Product {getProduct = 15} ---- --
-- >>> foldMap (replicate 3) [1, 2, 3] -- [1,1,1,2,2,2,3,3,3] ---- -- Infinite structures never terminate: -- --
-- >>> foldMap Sum [1..] -- * Hangs forever * --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 (||) False [False, True, False] -- True ---- --
-- >>> foldr (||) False [] -- False ---- --
-- >>> foldr (\nextChar reversedString -> reversedString ++ [nextChar]) "foo" ['a', 'b', 'c', 'd'] -- "foodcba" ---- --
-- >>> foldr (||) False (True : repeat False) -- True ---- -- But the following doesn't terminate: -- --
-- >>> foldr (||) False (repeat False ++ [True]) -- * Hangs forever * ---- --
-- >>> foldr (\nextElement accumulator -> nextElement : fmap (+3) accumulator) [42] (repeat 1) -- [1,4,7,10,13,16,19,22,25,28,31,34,37,40,43... ---- --
-- >>> take 5 $ foldr (\nextElement accumulator -> nextElement : fmap (+3) accumulator) [42] (repeat 1) -- [1,4,7,10,13] --foldr :: Foldable t => (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 [] -- True ---- --
-- >>> null [1] -- False ---- -- null terminates even for infinite structures: -- --
-- >>> null [1..] -- False --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 [] -- 0 ---- --
-- >>> length ['a', 'b', 'c'] -- 3 -- -- >>> length [1..] -- * Hangs forever * --length :: Foldable t => 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 (> 42) [0, 5..] -- Just 45 ---- --
-- >>> find (> 4) (Node (Leaf 3) 17 (Node Empty 12 (Leaf 8))) -- Just 17 ---- --
-- >>> find (> 12) [1..7] -- Nothing --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 => (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_ print ["Hello", "world", "!"] -- "Hello" -- "world" -- "!" --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 () -- | Determines whether any element of the structure satisfies the -- predicate. -- --
-- >>> any (> 3) [] -- False ---- --
-- >>> any (> 3) [1,2] -- False ---- --
-- >>> any (> 3) [1,2,3,4,5] -- True ---- --
-- >>> any (> 3) [1..] -- True ---- --
-- >>> any (> 3) [0, -1..] -- * Hangs forever * --any :: Foldable t => (a -> Bool) -> t a -> Bool -- | Determines whether all elements of the structure satisfy the -- predicate. -- --
-- >>> all (> 3) [] -- True ---- --
-- >>> all (> 3) [1,2] -- False ---- --
-- >>> all (> 3) [1,2,3,4,5] -- False ---- --
-- >>> all (> 3) [1..] -- False ---- --
-- >>> all (> 3) [4..] -- * Hangs forever * --all :: Foldable t => (a -> Bool) -> t a -> Bool -- | List of elements of a structure, from left to right. -- --
-- >>> toList Nothing -- [] ---- --
-- >>> toList (Just 42) -- [42] ---- --
-- >>> toList (Left "foo") -- [] ---- --
-- >>> toList (Node (Leaf 5) 17 (Node Empty 12 (Leaf 8))) -- [5,17,12,8] ---- -- For lists, toList is the identity: -- --
-- >>> toList [1, 2, 3] -- [1,2,3] --toList :: Foldable t => t a -> [a] -- | Functors representing data structures that can be traversed from left -- to right. -- -- A definition of traverse must satisfy the following laws: -- --
-- t :: (Applicative f, Applicative g) => f a -> g a ---- -- preserving the Applicative operations, i.e. -- --
-- t (pure x) = pure x -- t (f <*> x) = t f <*> t x ---- -- and the identity functor Identity and composition functors -- Compose are from Data.Functor.Identity and -- Data.Functor.Compose. -- -- A result of the naturality law is a purity law for traverse -- --
-- traverse pure = pure ---- -- (The naturality law is implied by parametricity and thus so is the -- purity law [1, p15].) -- -- 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: -- --
-- 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. -- -- Using ApplicativeDo: 'void as' can be -- understood as the do expression -- --
-- do as -- pure () ---- -- with an inferred Functor constraint. -- --
-- >>> 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 Unicode characters. -- -- Note that numeric digits outside the ASCII range, as well as numeric -- characters which aren't digits, are selected by this function but not -- by isDigit. Such characters 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 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 -- | Parse a string using the Read instance. Succeeds if there is -- exactly one valid result. -- --
-- >>> readMaybe "123" :: Maybe Int -- Just 123 ---- --
-- >>> readMaybe "hello" :: Maybe Int -- Nothing --readMaybe :: Read a => String -> Maybe a -- | Alternative parser combinators. -- -- Originally in parsers package. module Distribution.Compat.Parsing -- | choice ps tries to apply the parsers in the list ps -- in order, until one of them succeeds. Returns the value of the -- succeeding parser. choice :: Alternative m => [m a] -> m a -- | option x p tries to apply parser p. If p -- fails without consuming input, it returns the value x, -- otherwise the value returned by p. -- --
-- priority = option 0 (digitToInt <$> digit) --option :: Alternative m => a -> m a -> m a -- | One or none. -- -- It is useful for modelling any computation that is allowed to fail. -- --
-- >>> canFail = throwError "it failed" :: Except String Int -- -- >>> final = return 42 :: Except String Int ---- -- Can be combined by allowing the first function to fail: -- --
-- >>> runExcept $ canFail *> final -- Left "it failed" -- -- >>> runExcept $ optional canFail *> final -- Right 42 --optional :: Alternative f => f a -> f (Maybe a) -- | skipOptional p tries to apply parser p. It will -- parse p or nothing. It only fails if p fails after -- consuming input. It discards the result of p. (Plays the role -- of parsec's optional, which conflicts with Applicative's optional) skipOptional :: Alternative m => m a -> m () -- | between open close p parses open, followed by -- p and close. Returns the value returned by -- p. -- --
-- braces = between (symbol "{") (symbol "}") --between :: Applicative m => m bra -> m ket -> m a -> m a -- | One or more. some :: Alternative f => f a -> f [a] -- | Zero or more. many :: Alternative f => f a -> f [a] -- | sepBy p sep parses zero or more occurrences of -- p, separated by sep. Returns a list of values -- returned by p. -- --
-- commaSep p = p `sepBy` (symbol ",") --sepBy :: Alternative m => m a -> m sep -> m [a] -- | sepByNonEmpty p sep parses one or more occurrences of -- p, separated by sep. Returns a non-empty list of -- values returned by p. sepByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) -- | sepEndByNonEmpty p sep parses one or more occurrences -- of p, separated and optionally ended by sep. Returns -- a non-empty list of values returned by p. sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) -- | sepEndBy p sep parses zero or more occurrences of -- p, separated and optionally ended by sep, ie. -- haskell style statements. Returns a list of values returned by -- p. -- --
-- haskellStatements = haskellStatement `sepEndBy` semi --sepEndBy :: Alternative m => m a -> m sep -> m [a] -- | endByNonEmpty p sep parses one or more occurrences of -- p, separated and ended by sep. Returns a non-empty -- list of values returned by p. endByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a) -- | endBy p sep parses zero or more occurrences of -- p, separated and ended by sep. Returns a list of -- values returned by p. -- --
-- cStatements = cStatement `endBy` semi --endBy :: Alternative m => m a -> m sep -> m [a] -- | count n p parses n occurrences of p. If -- n is smaller or equal to zero, the parser equals to -- return []. Returns a list of n values returned by -- p. count :: Applicative m => Int -> m a -> m [a] -- | chainl p op x parses zero or more occurrences of -- p, separated by op. Returns a value obtained by a -- left associative application of all functions returned by -- op to the values returned by p. If there are zero -- occurrences of p, the value x is returned. chainl :: Alternative m => m a -> m (a -> a -> a) -> a -> m a -- | chainr p op x parses zero or more occurrences of -- p, separated by op Returns a value obtained by a -- right associative application of all functions returned by -- op to the values returned by p. If there are no -- occurrences of p, the value x is returned. chainr :: Alternative m => m a -> m (a -> a -> a) -> a -> m a -- | chainl1 p op x parses one or more occurrences of -- p, separated by op Returns a value obtained by a -- left associative application of all functions returned by -- op to the values returned by p. . This parser can -- for example be used to eliminate left recursion which typically occurs -- in expression grammars. -- --
-- expr = term `chainl1` addop -- term = factor `chainl1` mulop -- factor = parens expr <|> integer -- -- mulop = (*) <$ symbol "*" -- <|> div <$ symbol "/" -- -- addop = (+) <$ symbol "+" -- <|> (-) <$ symbol "-" --chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a -- | chainr1 p op x parses one or more occurrences of -- p, separated by op Returns a value obtained by a -- right associative application of all functions returned by -- op to the values returned by p. chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a -- | manyTill p end applies parser p zero or more -- times until parser end succeeds. Returns the list of values -- returned by p. This parser can be used to scan comments: -- --
-- simpleComment = do{ string "<!--" -- ; manyTill anyChar (try (string "-->")) -- } ---- -- Note the overlapping parsers anyChar and string -- "-->", and therefore the use of the try combinator. manyTill :: Alternative m => m a -> m end -> m [a] -- | Additional functionality needed to describe parsers independent of -- input type. class Alternative m => Parsing m -- | Take a parser that may consume input, and on failure, go back to where -- we started and fail as if we didn't consume input. try :: Parsing m => m a -> m a -- | Give a parser a name (>) :: Parsing m => m a -> String -> m a -- | A version of many that discards its input. Specialized because it can -- often be implemented more cheaply. skipMany :: Parsing m => m a -> m () -- | skipSome p applies the parser p one or more -- times, skipping its result. (aka skipMany1 in parsec) skipSome :: Parsing m => m a -> m () -- | Used to emit an error on an unexpected token unexpected :: Parsing m => String -> m a -- | This parser only succeeds at the end of the input. This is not a -- primitive parser but it is defined using notFollowedBy. -- --
-- eof = notFollowedBy anyChar <?> "end of input" --eof :: Parsing m => m () -- | notFollowedBy p only succeeds when parser p fails. -- This parser does not consume any input. This parser can be used to -- implement the 'longest match' rule. For example, when recognizing -- keywords (for example let), we want to make sure that a -- keyword is not followed by a legal identifier character, in which case -- the keyword is actually an identifier (for example lets). We -- can program this behaviour as follows: -- --
-- keywordLet = try $ string "let" <* notFollowedBy alphaNum --notFollowedBy :: (Parsing m, Show a) => m a -> m () infixr 0 > instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.State.Lazy.StateT s m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.State.Strict.StateT s m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.Reader.ReaderT e m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.Writer.Strict.WriterT w m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.Writer.Lazy.WriterT w m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.RWS.Lazy.RWST r w s m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.RWS.Strict.RWST r w s m) instance (Distribution.Compat.Parsing.Parsing m, GHC.Base.Monad m) => Distribution.Compat.Parsing.Parsing (Control.Monad.Trans.Identity.IdentityT m) instance (Text.Parsec.Prim.Stream s m t, GHC.Show.Show t) => Distribution.Compat.Parsing.Parsing (Text.Parsec.Prim.ParsecT s u m) -- | 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 fromList :: [a] -> DList a toList :: DList a -> [a] snoc :: DList a -> a -> DList a instance GHC.Base.Monoid (Distribution.Compat.DList.DList a) instance GHC.Base.Semigroup (Distribution.Compat.DList.DList a) -- | This module provides very basic lens functionality, without extra -- dependencies. -- -- For the documentation of the combinators see lens package. This -- module uses the same vocabulary. module Distribution.Compat.Lens type Lens s t a b = forall f. Functor f => LensLike f s t a b type Lens' s a = Lens s s a a type Traversal s t a b = forall f. Applicative f => LensLike f s t a b type Traversal' s a = Traversal s s a a type LensLike f s t a b = (a -> f b) -> s -> f t type LensLike' f s a = (a -> f a) -> s -> f s type Getting r s a = LensLike (Const r) s s a a type AGetter s a = LensLike (Const a) s s a a type ASetter s t a b = LensLike Identity s t a b type ALens s t a b = LensLike (Pretext a b) s t a b type ALens' s a = ALens s s a a view :: Getting a s a -> s -> a use :: MonadState s m => Getting a s a -> m a -- |
-- >>> (3 :: Int) ^. getting (+2) . getting show -- "5" --getting :: (s -> a) -> Getting r s a set :: ASetter s t a b -> b -> s -> t over :: ASetter s t a b -> (a -> b) -> s -> t toDListOf :: Getting (DList a) s a -> s -> DList a toListOf :: Getting (DList a) s a -> s -> [a] toSetOf :: Getting (Set a) s a -> s -> Set a cloneLens :: Functor f => ALens s t a b -> LensLike f s t a b aview :: ALens s t a b -> s -> a _1 :: Lens (a, c) (b, c) a b _2 :: Lens (c, a) (c, b) a b -- | & is a reverse application operator (&) :: a -> (a -> b) -> b infixl 1 & (^.) :: s -> Getting a s a -> a infixl 8 ^. (.~) :: ASetter s t a b -> b -> s -> t infixr 4 .~ (?~) :: ASetter s t a (Maybe b) -> b -> s -> t infixr 4 ?~ (%~) :: ASetter s t a b -> (a -> b) -> s -> t infixr 4 %~ (.=) :: MonadState s m => ASetter s s a b -> b -> m () infixr 4 .= (?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () infixr 4 ?= (%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () infixr 4 %= (^#) :: s -> ALens s t a b -> a infixl 8 ^# (#~) :: ALens s t a b -> b -> s -> t infixr 4 #~ (#%~) :: ALens s t a b -> (a -> b) -> s -> t infixr 4 #%~ -- | lens variant is also parametrised by profunctor. data Pretext a b t Pretext :: (forall f. Functor f => (a -> f b) -> f t) -> Pretext a b t [runPretext] :: Pretext a b t -> forall f. Functor f => (a -> f b) -> f t instance GHC.Base.Functor (Distribution.Compat.Lens.Pretext a b) 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 -- | @Traversal@ for the variables traverseCondTreeV :: Traversal (CondTree v c a) (CondTree w c a) v w -- | @Traversal@ for the variables traverseCondBranchV :: Traversal (CondBranch v c a) (CondBranch w c a) v w -- | @Traversal@ for the aggregated constraints traverseCondTreeC :: Traversal (CondTree v c a) (CondTree v d a) c d -- | @Traversal@ for the aggregated constraints traverseCondBranchC :: Traversal (CondBranch v c a) (CondBranch v d a) c d -- | 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 :: (Semigroup a, Semigroup 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 :: (Semigroup a, Semigroup 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 v, Data.Data.Data c, Data.Data.Data a) => Data.Data.Data (Distribution.Types.CondTree.CondTree v c a) instance (GHC.Classes.Eq a, GHC.Classes.Eq c, GHC.Classes.Eq v) => GHC.Classes.Eq (Distribution.Types.CondTree.CondTree v c a) instance (GHC.Show.Show a, GHC.Show.Show c, GHC.Show.Show v) => 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 v, Data.Data.Data c, Data.Data.Data a) => Data.Data.Data (Distribution.Types.CondTree.CondBranch v c a) instance (GHC.Classes.Eq v, GHC.Classes.Eq a, GHC.Classes.Eq c) => GHC.Classes.Eq (Distribution.Types.CondTree.CondBranch v c a) instance (GHC.Show.Show v, GHC.Show.Show a, GHC.Show.Show c) => 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 (Distribution.Utils.Structured.Structured v, Distribution.Utils.Structured.Structured c, Distribution.Utils.Structured.Structured a) => Distribution.Utils.Structured.Structured (Distribution.Types.CondTree.CondTree v c a) instance (Control.DeepSeq.NFData v, Control.DeepSeq.NFData c, Control.DeepSeq.NFData a) => Control.DeepSeq.NFData (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) instance (Distribution.Utils.Structured.Structured v, Distribution.Utils.Structured.Structured c, Distribution.Utils.Structured.Structured a) => Distribution.Utils.Structured.Structured (Distribution.Types.CondTree.CondBranch v c a) instance (Control.DeepSeq.NFData v, Control.DeepSeq.NFData c, Control.DeepSeq.NFData a) => Control.DeepSeq.NFData (Distribution.Types.CondTree.CondBranch v c a) module Distribution.Compat.CreatePipe createPipe :: IO (Handle, Handle) -- | Parsers for character streams -- -- Originally in parsers package. module Distribution.Compat.CharParsing -- | oneOf cs succeeds if the current character is in the supplied -- list of characters cs. Returns the parsed character. See also -- satisfy. -- --
-- vowel = oneOf "aeiou" --oneOf :: CharParsing m => [Char] -> m Char -- | As the dual of oneOf, noneOf cs succeeds if the -- current character is not in the supplied list of characters -- cs. Returns the parsed character. -- --
-- consonant = noneOf "aeiou" --noneOf :: CharParsing m => [Char] -> m Char -- | Skips zero or more white space characters. See also -- skipMany. spaces :: CharParsing m => m () -- | Parses a white space character (any character which satisfies -- isSpace) Returns the parsed character. space :: CharParsing m => m Char -- | Parses a newline character ('\n'). Returns a newline character. newline :: CharParsing m => m Char -- | Parses a tab character ('\t'). Returns a tab character. tab :: CharParsing m => m Char -- | Parses an upper case letter. Returns the parsed character. upper :: CharParsing m => m Char -- | Parses a lower case character. Returns the parsed character. lower :: CharParsing m => m Char -- | Parses a letter or digit. Returns the parsed character. alphaNum :: CharParsing m => m Char -- | Parses a letter (an upper case or lower case character). Returns the -- parsed character. letter :: CharParsing m => m Char -- | Parses a digit. Returns the parsed character. digit :: CharParsing m => m Char -- | Parses a hexadecimal digit (a digit or a letter between 'a' and 'f' or -- 'A' and 'F'). Returns the parsed character. hexDigit :: CharParsing m => m Char -- | Parses an octal digit (a character between '0' and '7'). Returns the -- parsed character. octDigit :: CharParsing m => m Char satisfyRange :: CharParsing m => Char -> Char -> m Char -- | Additional functionality needed to parse character streams. class Parsing m => CharParsing m -- | Parse a single character of the input, with UTF-8 decoding satisfy :: CharParsing m => (Char -> Bool) -> m Char -- | char c parses a single character c. Returns the -- parsed character (i.e. c). -- -- e.g. -- --
-- semiColon = char ';' --char :: CharParsing m => Char -> m Char -- | notChar c parses any single character other than c. -- Returns the parsed character. notChar :: CharParsing m => Char -> m Char -- | This parser succeeds for any character. Returns the parsed character. anyChar :: CharParsing m => m Char -- | string s parses a sequence of characters given by s. -- Returns the parsed string (i.e. s). -- --
-- divOrMod = string "div" -- <|> string "mod" --string :: CharParsing m => String -> m String -- | text t parses a sequence of characters determined by the text -- t Returns the parsed text fragment (i.e. t). -- -- Using OverloadedStrings: -- --
-- divOrMod = text "div" -- <|> text "mod" --text :: CharParsing m => Text -> m Text integral :: (CharParsing m, Integral a) => m a -- | Greedily munch characters while predicate holds. Require at least one -- character. munch1 :: CharParsing m => (Char -> Bool) -> m String -- | Greedely munch characters while predicate holds. Always succeeds. munch :: CharParsing m => (Char -> Bool) -> m String skipSpaces1 :: CharParsing m => m () instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.State.Lazy.StateT s m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.State.Strict.StateT s m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.Reader.ReaderT e m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.Writer.Strict.WriterT w m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.Writer.Lazy.WriterT w m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.RWS.Lazy.RWST r w s m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m, GHC.Base.Monoid w) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.RWS.Strict.RWST r w s m) instance (Distribution.Compat.CharParsing.CharParsing m, GHC.Base.MonadPlus m) => Distribution.Compat.CharParsing.CharParsing (Control.Monad.Trans.Identity.IdentityT m) instance Text.Parsec.Prim.Stream s m GHC.Types.Char => Distribution.Compat.CharParsing.CharParsing (Text.Parsec.Prim.ParsecT s u m) module Distribution.CabalSpecVersion -- | Different Cabal-the-spec versions. -- -- We branch based on this at least in the parser. data CabalSpecVersion -- | this is older than CabalSpecV1_2 CabalSpecV1_0 :: CabalSpecVersion -- | new syntax (sections) CabalSpecV1_2 :: CabalSpecVersion CabalSpecV1_4 :: CabalSpecVersion CabalSpecV1_6 :: CabalSpecVersion CabalSpecV1_8 :: CabalSpecVersion CabalSpecV1_10 :: CabalSpecVersion CabalSpecV1_12 :: CabalSpecVersion CabalSpecV1_18 :: CabalSpecVersion CabalSpecV1_20 :: CabalSpecVersion CabalSpecV1_22 :: CabalSpecVersion CabalSpecV1_24 :: CabalSpecVersion CabalSpecV2_0 :: CabalSpecVersion CabalSpecV2_2 :: CabalSpecVersion CabalSpecV2_4 :: CabalSpecVersion CabalSpecV3_0 :: CabalSpecVersion -- | Show cabal spec version, but not the way in the .cabal files showCabalSpecVersion :: CabalSpecVersion -> String cabalSpecLatest :: CabalSpecVersion cabalSpecFromVersionDigits :: [Int] -> CabalSpecVersion specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas specHasElif :: CabalSpecVersion -> HasElif data HasElif HasElif :: HasElif NoElif :: HasElif data HasCommonStanzas HasCommonStanzas :: HasCommonStanzas NoCommonStanzas :: HasCommonStanzas data HasGlobstar HasGlobstar :: HasGlobstar NoGlobstar :: HasGlobstar instance GHC.Generics.Generic Distribution.CabalSpecVersion.CabalSpecVersion instance Data.Data.Data Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Enum.Bounded Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Enum.Enum Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Read.Read Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Show.Show Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Classes.Ord Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Classes.Eq Distribution.CabalSpecVersion.CabalSpecVersion instance GHC.Show.Show Distribution.CabalSpecVersion.HasElif instance GHC.Classes.Eq Distribution.CabalSpecVersion.HasElif instance GHC.Show.Show Distribution.CabalSpecVersion.HasCommonStanzas instance GHC.Classes.Eq Distribution.CabalSpecVersion.HasCommonStanzas module Distribution.SPDX.LicenseListVersion -- | SPDX License List version Cabal is aware of. data LicenseListVersion LicenseListVersion_3_0 :: LicenseListVersion LicenseListVersion_3_2 :: LicenseListVersion LicenseListVersion_3_6 :: LicenseListVersion cabalSpecVersionToSPDXListVersion :: CabalSpecVersion -> LicenseListVersion instance GHC.Enum.Bounded Distribution.SPDX.LicenseListVersion.LicenseListVersion instance GHC.Enum.Enum Distribution.SPDX.LicenseListVersion.LicenseListVersion instance GHC.Show.Show Distribution.SPDX.LicenseListVersion.LicenseListVersion instance GHC.Classes.Ord Distribution.SPDX.LicenseListVersion.LicenseListVersion instance GHC.Classes.Eq Distribution.SPDX.LicenseListVersion.LicenseListVersion module Distribution.Pretty class Pretty a pretty :: Pretty a => a -> Doc prettyVersioned :: Pretty a => CabalSpecVersion -> a -> Doc prettyShow :: Pretty a => a -> String -- | The default rendering style used in Cabal for console output. It has a -- fixed page width and adds line breaks automatically. defaultStyle :: Style -- | A style for rendering all on one line. flatStyle :: Style showFilePath :: FilePath -> Doc showToken :: String -> Doc -- | Pretty-print free-format text, ensuring that it is vertically aligned, -- and with blank lines replaced by dots for correct re-parsing. showFreeText :: String -> Doc -- | Pretty-print free-format text. Since cabal-version: 3.0 we -- don't replace blank lines with dots. showFreeTextV3 :: String -> Doc type Separator = [Doc] -> Doc instance Distribution.Pretty.Pretty GHC.Types.Bool instance Distribution.Pretty.Pretty GHC.Types.Int instance Distribution.Pretty.Pretty a => Distribution.Pretty.Pretty (Data.Functor.Identity.Identity a) module Distribution.Parsec -- | Class for parsing with parsec. Mainly used for -- .cabal file fields. -- -- For parsing .cabal like file structure, see -- Distribution.Fields. class Parsec a parsec :: (Parsec a, CabalParsing m) => m a newtype ParsecParser a PP :: (CabalSpecVersion -> Parsec FieldLineStream [PWarning] a) -> ParsecParser a [unPP] :: ParsecParser a -> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a -- | Run ParsecParser with cabalSpecLatest. runParsecParser :: ParsecParser a -> FilePath -> FieldLineStream -> Either ParseError a -- | Like runParsecParser but lets specify CabalSpecVersion -- used. runParsecParser' :: CabalSpecVersion -> ParsecParser a -> FilePath -> FieldLineStream -> Either ParseError a -- | Parse a String with lexemeParsec. simpleParsec :: Parsec a => String -> Maybe a -- | parsec could consume trailing spaces, this function -- will consume. lexemeParsec :: (CabalParsing m, Parsec a) => m a -- | Parse a String with lexemeParsec. eitherParsec :: Parsec a => String -> Either String a -- | Parse a String with given ParsecParser. Trailing -- whitespace is accepted. explicitEitherParsec :: ParsecParser a -> String -> Either String a -- | Parsing class which -- --
-- [^ ,] --parsecToken :: CabalParsing m => m String -- |
-- [^ ] --parsecToken' :: CabalParsing m => m String parsecFilePath :: CabalParsing m => m FilePath -- | Content isn't unquoted parsecQuoted :: CabalParsing m => m a -> m a -- | parsecMaybeQuoted p = parsecQuoted p | p. parsecMaybeQuoted :: CabalParsing m => m a -> m a parsecCommaList :: CabalParsing m => m a -> m [a] -- | Like parsecCommaList but accept leading or trailing comma. -- --
-- p (comma p)* -- p sepBy comma -- (comma p)* -- leading comma -- (p comma)* -- trailing comma --parsecLeadingCommaList :: CabalParsing m => m a -> m [a] parsecOptCommaList :: CabalParsing m => m a -> m [a] -- | Like parsecOptCommaList but -- --
-- p (comma p)* -- p sepBy comma -- (comma p)* -- leading comma -- (p comma)* -- trailing comma -- p* -- no commas: many p --parsecLeadingOptCommaList :: CabalParsing m => m a -> m [a] -- | Parse a benchmark/test-suite types. parsecStandard :: (CabalParsing m, Parsec ver) => (ver -> String -> a) -> m a parsecUnqualComponentName :: CabalParsing m => m String instance GHC.Base.Functor Distribution.Parsec.ParsecParser instance GHC.Base.Applicative Distribution.Parsec.ParsecParser instance GHC.Base.Alternative Distribution.Parsec.ParsecParser instance GHC.Base.Monad Distribution.Parsec.ParsecParser instance GHC.Base.MonadPlus Distribution.Parsec.ParsecParser instance Control.Monad.Fail.MonadFail Distribution.Parsec.ParsecParser instance Distribution.Compat.Parsing.Parsing Distribution.Parsec.ParsecParser instance Distribution.Compat.CharParsing.CharParsing Distribution.Parsec.ParsecParser instance Distribution.Parsec.CabalParsing Distribution.Parsec.ParsecParser instance Distribution.Parsec.Parsec a => Distribution.Parsec.Parsec (Data.Functor.Identity.Identity a) instance Distribution.Parsec.Parsec GHC.Types.Bool module Distribution.Types.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 mkVersion 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 -- | Version 0. A lower bound of Version. version0 :: Version validVersion :: Version -> Bool -- | An integral without leading zeroes. versionDigitParser :: CabalParsing m => m Int instance GHC.Generics.Generic Distribution.Types.Version.Version instance GHC.Classes.Eq Distribution.Types.Version.Version instance Data.Data.Data Distribution.Types.Version.Version instance GHC.Classes.Ord Distribution.Types.Version.Version instance GHC.Show.Show Distribution.Types.Version.Version instance GHC.Read.Read Distribution.Types.Version.Version instance Data.Binary.Class.Binary Distribution.Types.Version.Version instance Distribution.Utils.Structured.Structured Distribution.Types.Version.Version instance Control.DeepSeq.NFData Distribution.Types.Version.Version instance Distribution.Pretty.Pretty Distribution.Types.Version.Version instance Distribution.Parsec.Parsec Distribution.Types.Version.Version -- | The only purpose of this module is to prevent the export of -- VersionRange constructors from VersionRange. To avoid -- creating orphan instances, a lot of related code had to be moved here -- too. module Distribution.Types.VersionRange.Internal data VersionRange AnyVersion :: VersionRange ThisVersion :: Version -> VersionRange LaterVersion :: Version -> VersionRange OrLaterVersion :: Version -> VersionRange EarlierVersion :: Version -> VersionRange OrEarlierVersion :: Version -> VersionRange WildcardVersion :: Version -> VersionRange MajorBoundVersion :: Version -> VersionRange UnionVersionRanges :: VersionRange -> VersionRange -> VersionRange 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 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. majorBoundVersion :: Version -> VersionRange -- | F-Algebra of VersionRange. See cataVersionRange. data VersionRangeF a AnyVersionF :: VersionRangeF a ThisVersionF :: Version -> VersionRangeF a LaterVersionF :: Version -> VersionRangeF a OrLaterVersionF :: Version -> VersionRangeF a EarlierVersionF :: Version -> VersionRangeF a OrEarlierVersionF :: Version -> VersionRangeF a WildcardVersionF :: Version -> VersionRangeF a MajorBoundVersionF :: Version -> VersionRangeF a UnionVersionRangesF :: a -> a -> VersionRangeF a IntersectVersionRangesF :: a -> a -> VersionRangeF a VersionRangeParensF :: a -> VersionRangeF a projectVersionRange :: VersionRange -> VersionRangeF VersionRange embedVersionRange :: VersionRangeF VersionRange -> VersionRange -- | Fold VersionRange. cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a -- | Unfold VersionRange. anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange -- | Refold VersionRange hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) -> (VersionRange -> VersionRangeF VersionRange) -> VersionRange -> VersionRange -- | VersionRange parser parametrised by version digit parser -- --
-- 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 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. majorBoundVersion :: Version -> VersionRange -- | Does this version fall within the given range? -- -- This is the evaluation function for the VersionRange type. withinRange :: Version -> VersionRange -> Bool -- | 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 -- | Normalise VersionRange. -- -- In particular collapse (== v || > v) into >= -- v, and so on. normaliseVersionRange :: VersionRange -> VersionRange -- | Remove VersionRangeParens constructors. stripParensVersionRange :: VersionRange -> VersionRange -- | 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 -- | F-Algebra of VersionRange. See cataVersionRange. data VersionRangeF a AnyVersionF :: VersionRangeF a ThisVersionF :: Version -> VersionRangeF a LaterVersionF :: Version -> VersionRangeF a OrLaterVersionF :: Version -> VersionRangeF a EarlierVersionF :: Version -> VersionRangeF a OrEarlierVersionF :: Version -> VersionRangeF a WildcardVersionF :: Version -> VersionRangeF a MajorBoundVersionF :: Version -> VersionRangeF a UnionVersionRangesF :: a -> a -> VersionRangeF a IntersectVersionRangesF :: a -> a -> VersionRangeF a VersionRangeParensF :: a -> VersionRangeF a -- | Fold VersionRange. cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a -- | Unfold VersionRange. anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange -- | Refold VersionRange hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) -> (VersionRange -> VersionRangeF VersionRange) -> VersionRange -> VersionRange projectVersionRange :: VersionRange -> VersionRangeF VersionRange embedVersionRange :: VersionRangeF VersionRange -> VersionRange wildcardUpperBound :: Version -> Version -- | Compute next greater major version to be used as upper bound -- -- Example: 0.4.1 produces the version 0.5 which then -- can be used to construct a range >= 0.4.1 && < -- 0.5 majorUpperBound :: Version -> Version isWildcardRange :: Version -> Version -> Bool -- | VersionRange parser parametrised by version digit parser -- --
-- 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. -- -- In Cabal-2.2 the Maybe is dropped from the result -- type. mkVersionIntervals :: [VersionInterval] -> VersionIntervals unionVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals intersectVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals invertVersionIntervals :: VersionIntervals -> VersionIntervals relaxLastInterval :: VersionIntervals -> VersionIntervals relaxHeadInterval :: VersionIntervals -> VersionIntervals -- | 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 instance GHC.Show.Show Distribution.Types.VersionInterval.Bound instance GHC.Classes.Eq Distribution.Types.VersionInterval.Bound instance GHC.Show.Show Distribution.Types.VersionInterval.UpperBound instance GHC.Classes.Eq Distribution.Types.VersionInterval.UpperBound instance GHC.Show.Show Distribution.Types.VersionInterval.LowerBound instance GHC.Classes.Eq Distribution.Types.VersionInterval.LowerBound instance GHC.Show.Show Distribution.Types.VersionInterval.VersionIntervals instance GHC.Classes.Eq Distribution.Types.VersionInterval.VersionIntervals instance GHC.Classes.Ord Distribution.Types.VersionInterval.LowerBound instance GHC.Classes.Ord Distribution.Types.VersionInterval.UpperBound 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.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.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.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.Ord Distribution.Types.SourceRepo.SourceRepo instance GHC.Classes.Eq Distribution.Types.SourceRepo.SourceRepo instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.SourceRepo instance Distribution.Utils.Structured.Structured Distribution.Types.SourceRepo.SourceRepo instance Control.DeepSeq.NFData Distribution.Types.SourceRepo.SourceRepo instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.RepoType instance Distribution.Utils.Structured.Structured Distribution.Types.SourceRepo.RepoType instance Control.DeepSeq.NFData Distribution.Types.SourceRepo.RepoType instance Distribution.Pretty.Pretty Distribution.Types.SourceRepo.RepoType instance Distribution.Parsec.Parsec Distribution.Types.SourceRepo.RepoType instance Data.Binary.Class.Binary Distribution.Types.SourceRepo.RepoKind instance Distribution.Utils.Structured.Structured Distribution.Types.SourceRepo.RepoKind instance Control.DeepSeq.NFData Distribution.Types.SourceRepo.RepoKind instance Distribution.Pretty.Pretty Distribution.Types.SourceRepo.RepoKind instance Distribution.Parsec.Parsec Distribution.Types.SourceRepo.RepoKind module Distribution.Types.SourceRepo.Lens -- | 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 repoKind :: Lens' SourceRepo RepoKind repoType :: Lens' SourceRepo (Maybe RepoType) repoLocation :: Lens' SourceRepo (Maybe String) repoModule :: Lens' SourceRepo (Maybe String) repoBranch :: Lens' SourceRepo (Maybe String) repoTag :: Lens' SourceRepo (Maybe String) repoSubdir :: Lens' SourceRepo (Maybe FilePath) module Distribution.Types.PkgconfigVersion -- | pkg-config versions. -- -- In fact, this can be arbitrary ByteString, but Parsec -- instance is a little pickier. newtype PkgconfigVersion PkgconfigVersion :: ByteString -> PkgconfigVersion -- | Compare two version strings as pkg-config would compare them. rpmvercmp :: ByteString -> ByteString -> Ordering instance Data.Data.Data Distribution.Types.PkgconfigVersion.PkgconfigVersion instance GHC.Show.Show Distribution.Types.PkgconfigVersion.PkgconfigVersion instance GHC.Read.Read Distribution.Types.PkgconfigVersion.PkgconfigVersion instance GHC.Generics.Generic Distribution.Types.PkgconfigVersion.PkgconfigVersion instance GHC.Classes.Eq Distribution.Types.PkgconfigVersion.PkgconfigVersion instance GHC.Classes.Ord Distribution.Types.PkgconfigVersion.PkgconfigVersion instance Data.Binary.Class.Binary Distribution.Types.PkgconfigVersion.PkgconfigVersion instance Distribution.Utils.Structured.Structured Distribution.Types.PkgconfigVersion.PkgconfigVersion instance Control.DeepSeq.NFData Distribution.Types.PkgconfigVersion.PkgconfigVersion instance Distribution.Pretty.Pretty Distribution.Types.PkgconfigVersion.PkgconfigVersion instance Distribution.Parsec.Parsec Distribution.Types.PkgconfigVersion.PkgconfigVersion module Distribution.Types.PkgconfigVersionRange data PkgconfigVersionRange PcAnyVersion :: PkgconfigVersionRange PcThisVersion :: PkgconfigVersion -> PkgconfigVersionRange PcLaterVersion :: PkgconfigVersion -> PkgconfigVersionRange PcEarlierVersion :: PkgconfigVersion -> PkgconfigVersionRange PcOrLaterVersion :: PkgconfigVersion -> PkgconfigVersionRange PcOrEarlierVersion :: PkgconfigVersion -> PkgconfigVersionRange PcUnionVersionRanges :: PkgconfigVersionRange -> PkgconfigVersionRange -> PkgconfigVersionRange PcIntersectVersionRanges :: PkgconfigVersionRange -> PkgconfigVersionRange -> PkgconfigVersionRange anyPkgconfigVersion :: PkgconfigVersionRange -- | TODO: this is not precise, but used only to prettify output. isAnyPkgconfigVersion :: PkgconfigVersionRange -> Bool withinPkgconfigVersionRange :: PkgconfigVersion -> PkgconfigVersionRange -> Bool versionToPkgconfigVersion :: Version -> PkgconfigVersion versionRangeToPkgconfigVersionRange :: VersionRange -> PkgconfigVersionRange instance Data.Data.Data Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance GHC.Classes.Eq Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance GHC.Show.Show Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance GHC.Read.Read Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance GHC.Generics.Generic Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance Data.Binary.Class.Binary Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance Distribution.Utils.Structured.Structured Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance Control.DeepSeq.NFData Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance Distribution.Pretty.Pretty Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange instance Distribution.Parsec.Parsec Distribution.Types.PkgconfigVersionRange.PkgconfigVersionRange 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.Utils.Structured.Structured Distribution.Types.PkgconfigName.PkgconfigName instance Distribution.Pretty.Pretty Distribution.Types.PkgconfigName.PkgconfigName instance Distribution.Parsec.Parsec Distribution.Types.PkgconfigName.PkgconfigName instance Control.DeepSeq.NFData Distribution.Types.PkgconfigName.PkgconfigName module Distribution.Types.PkgconfigDependency -- | Describes a dependency on a pkg-config library data PkgconfigDependency PkgconfigDependency :: PkgconfigName -> PkgconfigVersionRange -> 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 Distribution.Utils.Structured.Structured Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Control.DeepSeq.NFData Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Distribution.Pretty.Pretty Distribution.Types.PkgconfigDependency.PkgconfigDependency instance Distribution.Parsec.Parsec Distribution.Types.PkgconfigDependency.PkgconfigDependency 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.Utils.Structured.Structured Distribution.Types.PackageName.PackageName instance Distribution.Pretty.Pretty Distribution.Types.PackageName.PackageName instance Distribution.Parsec.Parsec 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. -- -- 2018-12-21: These "legacy" situations are not legacy. We can -- build-depends on the internal library. However Now dependency -- contains Set LibraryName, and we should use that. 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 GHC.Base.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.Utils.Structured.Structured Distribution.Types.UnqualComponentName.UnqualComponentName instance Distribution.Pretty.Pretty Distribution.Types.UnqualComponentName.UnqualComponentName instance Distribution.Parsec.Parsec Distribution.Types.UnqualComponentName.UnqualComponentName instance Control.DeepSeq.NFData Distribution.Types.UnqualComponentName.UnqualComponentName module Distribution.Types.PackageVersionConstraint -- | A version constraint on a package. Different from -- ExeDependency and Dependency since it does not -- specify the need for a component, not even the main library. There are -- a few places in the codebase where Dependency is used where -- PackageVersionConstraint should be used instead (#5570). data PackageVersionConstraint PackageVersionConstraint :: PackageName -> VersionRange -> PackageVersionConstraint instance Data.Data.Data Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance GHC.Classes.Eq Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance GHC.Show.Show Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance GHC.Read.Read Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance GHC.Generics.Generic Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance Data.Binary.Class.Binary Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance Distribution.Utils.Structured.Structured Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance Control.DeepSeq.NFData Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance Distribution.Pretty.Pretty Distribution.Types.PackageVersionConstraint.PackageVersionConstraint instance Distribution.Parsec.Parsec Distribution.Types.PackageVersionConstraint.PackageVersionConstraint module Distribution.Types.LibraryVisibility -- | Multi-lib visibility data LibraryVisibility -- | Can be depenendent from other packages LibraryVisibilityPublic :: LibraryVisibility -- | Internal library, default LibraryVisibilityPrivate :: LibraryVisibility instance Data.Data.Data Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Classes.Eq Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Read.Read Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Show.Show Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Generics.Generic Distribution.Types.LibraryVisibility.LibraryVisibility instance Distribution.Pretty.Pretty Distribution.Types.LibraryVisibility.LibraryVisibility instance Distribution.Parsec.Parsec Distribution.Types.LibraryVisibility.LibraryVisibility instance Data.Binary.Class.Binary Distribution.Types.LibraryVisibility.LibraryVisibility instance Distribution.Utils.Structured.Structured Distribution.Types.LibraryVisibility.LibraryVisibility instance Control.DeepSeq.NFData Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Base.Semigroup Distribution.Types.LibraryVisibility.LibraryVisibility instance GHC.Base.Monoid Distribution.Types.LibraryVisibility.LibraryVisibility module Distribution.Types.LibraryName data LibraryName LMainLibName :: LibraryName LSubLibName :: UnqualComponentName -> LibraryName defaultLibName :: LibraryName -- | Convert the UnqualComponentName of a library into a -- LibraryName. maybeToLibraryName :: Maybe UnqualComponentName -> LibraryName showLibraryName :: LibraryName -> String libraryNameStanza :: LibraryName -> String libraryNameString :: LibraryName -> Maybe UnqualComponentName -- | Pretty print LibraryName in build-target-ish syntax. -- -- Note: there are no Pretty or Parsec instances, as -- there's other way to represent LibraryName, namely as bare -- UnqualComponentName. prettyLibraryNameComponent :: LibraryName -> Doc parsecLibraryNameComponent :: CabalParsing m => m LibraryName instance Data.Data.Data Distribution.Types.LibraryName.LibraryName instance GHC.Show.Show Distribution.Types.LibraryName.LibraryName instance GHC.Read.Read Distribution.Types.LibraryName.LibraryName instance GHC.Classes.Ord Distribution.Types.LibraryName.LibraryName instance GHC.Generics.Generic Distribution.Types.LibraryName.LibraryName instance GHC.Classes.Eq Distribution.Types.LibraryName.LibraryName instance Data.Binary.Class.Binary Distribution.Types.LibraryName.LibraryName instance Distribution.Utils.Structured.Structured Distribution.Types.LibraryName.LibraryName instance Control.DeepSeq.NFData Distribution.Types.LibraryName.LibraryName 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. -- -- In 3.0.0.0 representation was changed from opaque (string) to -- semantic representation. data MungedPackageName MungedPackageName :: !PackageName -> !LibraryName -> MungedPackageName -- | Intended for internal use only -- --
-- >>> decodeCompatPackageName "z-servant-z-lackey" -- MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey")) --decodeCompatPackageName :: PackageName -> MungedPackageName -- | Intended for internal use only -- --
-- >>> encodeCompatPackageName $ MungedPackageName "servant" (LSubLibName "lackey") -- PackageName "z-servant-z-lackey" ---- -- This is used in cabal-install in the Solver. May become -- obsolete as solver moves to per-component solving. encodeCompatPackageName :: MungedPackageName -> PackageName 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.Binary.Class.Binary Distribution.Types.MungedPackageName.MungedPackageName instance Distribution.Utils.Structured.Structured Distribution.Types.MungedPackageName.MungedPackageName instance Control.DeepSeq.NFData Distribution.Types.MungedPackageName.MungedPackageName instance Distribution.Pretty.Pretty Distribution.Types.MungedPackageName.MungedPackageName instance Distribution.Parsec.Parsec Distribution.Types.MungedPackageName.MungedPackageName 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.Pretty.Pretty Distribution.Types.ForeignLibType.ForeignLibType instance Distribution.Parsec.Parsec Distribution.Types.ForeignLibType.ForeignLibType instance Data.Binary.Class.Binary Distribution.Types.ForeignLibType.ForeignLibType instance Distribution.Utils.Structured.Structured Distribution.Types.ForeignLibType.ForeignLibType instance Control.DeepSeq.NFData Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Base.Semigroup Distribution.Types.ForeignLibType.ForeignLibType instance GHC.Base.Monoid Distribution.Types.ForeignLibType.ForeignLibType 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.Pretty.Pretty Distribution.Types.ForeignLibOption.ForeignLibOption instance Distribution.Parsec.Parsec Distribution.Types.ForeignLibOption.ForeignLibOption instance Data.Binary.Class.Binary Distribution.Types.ForeignLibOption.ForeignLibOption instance Distribution.Utils.Structured.Structured Distribution.Types.ForeignLibOption.ForeignLibOption instance Control.DeepSeq.NFData Distribution.Types.ForeignLibOption.ForeignLibOption module Distribution.Types.Flag -- | 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)] data FlagAssignment -- | Construct a FlagAssignment from a list of flag/value pairs. -- -- If duplicate flags occur in the input list, the later entries in the -- list will take precedence. mkFlagAssignment :: [(FlagName, Bool)] -> FlagAssignment -- | Deconstruct a FlagAssignment into a list of flag/value pairs. -- --
-- null (findDuplicateFlagAssignments fa) ==> (mkFlagAssignment . unFlagAssignment) fa == fa --unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)] -- | Lookup the value for a flag -- -- Returns Nothing if the flag isn't contained in the -- FlagAssignment. lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool -- | Insert or update the boolean value of a flag. -- -- If the flag is already present in the FlagAssigment, the -- value will be updated and the fact that multiple values have been -- provided for that flag will be recorded so that a warning can be -- generated later on. insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment -- | Remove all flag-assignments from the first FlagAssignment that -- are contained in the second FlagAssignment -- -- NB/TODO: This currently only removes flag assignments which also match -- the value assignment! We should review the code which uses this -- operation to figure out if this it's not enough to only compare the -- flagnames without the values. diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment -- | Find the FlagNames that have been listed more than once. findDuplicateFlagAssignments :: FlagAssignment -> [FlagName] -- | Test whether FlagAssignment is empty. nullFlagAssignment :: FlagAssignment -> Bool -- | String representation of a flag-value pair. showFlagValue :: (FlagName, Bool) -> String -- | Pretty-prints a flag assignment. dispFlagAssignment :: FlagAssignment -> Doc -- | Parses a flag assignment. parsecFlagAssignment :: CabalParsing m => m FlagAssignment instance Control.DeepSeq.NFData Distribution.Types.Flag.FlagName instance Data.Data.Data Distribution.Types.Flag.FlagName instance GHC.Read.Read Distribution.Types.Flag.FlagName instance GHC.Show.Show Distribution.Types.Flag.FlagName instance GHC.Classes.Ord Distribution.Types.Flag.FlagName instance GHC.Generics.Generic Distribution.Types.Flag.FlagName instance GHC.Classes.Eq Distribution.Types.Flag.FlagName instance GHC.Generics.Generic Distribution.Types.Flag.Flag instance Data.Data.Data Distribution.Types.Flag.Flag instance GHC.Classes.Eq Distribution.Types.Flag.Flag instance GHC.Show.Show Distribution.Types.Flag.Flag instance Control.DeepSeq.NFData Distribution.Types.Flag.FlagAssignment instance GHC.Generics.Generic Distribution.Types.Flag.FlagAssignment instance Data.Binary.Class.Binary Distribution.Types.Flag.FlagAssignment instance Distribution.Utils.Structured.Structured Distribution.Types.Flag.FlagAssignment instance GHC.Classes.Eq Distribution.Types.Flag.FlagAssignment instance GHC.Classes.Ord Distribution.Types.Flag.FlagAssignment instance GHC.Base.Semigroup Distribution.Types.Flag.FlagAssignment instance GHC.Base.Monoid Distribution.Types.Flag.FlagAssignment instance GHC.Read.Read Distribution.Types.Flag.FlagAssignment instance GHC.Show.Show Distribution.Types.Flag.FlagAssignment instance Data.Binary.Class.Binary Distribution.Types.Flag.Flag instance Distribution.Utils.Structured.Structured Distribution.Types.Flag.Flag instance Control.DeepSeq.NFData Distribution.Types.Flag.Flag instance Data.String.IsString Distribution.Types.Flag.FlagName instance Data.Binary.Class.Binary Distribution.Types.Flag.FlagName instance Distribution.Utils.Structured.Structured Distribution.Types.Flag.FlagName instance Distribution.Pretty.Pretty Distribution.Types.Flag.FlagName instance Distribution.Parsec.Parsec Distribution.Types.Flag.FlagName module Distribution.Types.ExecutableScope data 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.Pretty.Pretty Distribution.Types.ExecutableScope.ExecutableScope instance Distribution.Parsec.Parsec Distribution.Types.ExecutableScope.ExecutableScope instance Data.Binary.Class.Binary Distribution.Types.ExecutableScope.ExecutableScope instance Distribution.Utils.Structured.Structured Distribution.Types.ExecutableScope.ExecutableScope instance Control.DeepSeq.NFData Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Base.Semigroup Distribution.Types.ExecutableScope.ExecutableScope instance GHC.Base.Monoid Distribution.Types.ExecutableScope.ExecutableScope module Distribution.Types.ComponentName data ComponentName CLibName :: LibraryName -> ComponentName CFLibName :: UnqualComponentName -> ComponentName CExeName :: UnqualComponentName -> ComponentName CTestName :: UnqualComponentName -> ComponentName CBenchName :: 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.Utils.Structured.Structured Distribution.Types.ComponentName.ComponentName instance Distribution.Pretty.Pretty Distribution.Types.ComponentName.ComponentName instance Distribution.Parsec.Parsec Distribution.Types.ComponentName.ComponentName 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.Utils.Structured.Structured Distribution.Types.ComponentId.ComponentId instance Distribution.Pretty.Pretty Distribution.Types.ComponentId.ComponentId instance Distribution.Parsec.Parsec Distribution.Types.ComponentId.ComponentId instance Control.DeepSeq.NFData Distribution.Types.ComponentId.ComponentId module Distribution.Types.GivenComponent -- | A GivenComponent represents a library depended on and -- explicitly specified by the user/client with --dependency -- -- It enables Cabal to know which ComponentId to associate with a -- library data GivenComponent GivenComponent :: PackageName -> LibraryName -> ComponentId -> GivenComponent [givenComponentPackage] :: GivenComponent -> PackageName [givenComponentName] :: GivenComponent -> LibraryName [givenComponentId] :: GivenComponent -> ComponentId instance GHC.Classes.Eq Distribution.Types.GivenComponent.GivenComponent instance GHC.Show.Show Distribution.Types.GivenComponent.GivenComponent instance GHC.Read.Read Distribution.Types.GivenComponent.GivenComponent instance GHC.Generics.Generic Distribution.Types.GivenComponent.GivenComponent instance Data.Binary.Class.Binary Distribution.Types.GivenComponent.GivenComponent instance Distribution.Utils.Structured.Structured Distribution.Types.GivenComponent.GivenComponent 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 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.Utils.Structured.Structured Distribution.Types.BuildType.BuildType instance Control.DeepSeq.NFData Distribution.Types.BuildType.BuildType instance Distribution.Pretty.Pretty Distribution.Types.BuildType.BuildType instance Distribution.Parsec.Parsec Distribution.Types.BuildType.BuildType 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.Utils.Structured.Structured Distribution.Types.AbiHash.AbiHash instance Control.DeepSeq.NFData Distribution.Types.AbiHash.AbiHash instance Distribution.Pretty.Pretty Distribution.Types.AbiHash.AbiHash instance Distribution.Parsec.Parsec Distribution.Types.AbiHash.AbiHash module Distribution.Text display :: Pretty a => a -> String simpleParse :: Parsec a => String -> Maybe a -- | 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, -- AArch64, Mips, SH, IA64, S39, Alpha, Hppa, Rs6000, M68k, Vax, and -- JavaScript. -- -- The following aliases can also be used: * PPC alias: powerpc * PPC64 -- alias : powerpc64, powerpc64le * Sparc aliases: sparc64, sun4 * Mips -- aliases: mipsel, mipseb * Arm aliases: armeb, armel * AArch64 aliases: -- arm64 data Arch I386 :: Arch X86_64 :: Arch PPC :: Arch PPC64 :: Arch Sparc :: Arch Arm :: Arch AArch64 :: 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.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.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.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.Binary.Class.Binary Distribution.System.Platform instance Distribution.Utils.Structured.Structured Distribution.System.Platform instance Control.DeepSeq.NFData Distribution.System.Platform instance Distribution.Pretty.Pretty Distribution.System.Platform instance Distribution.Parsec.Parsec Distribution.System.Platform instance Data.Binary.Class.Binary Distribution.System.Arch instance Distribution.Utils.Structured.Structured Distribution.System.Arch instance Control.DeepSeq.NFData Distribution.System.Arch instance Distribution.Pretty.Pretty Distribution.System.Arch instance Distribution.Parsec.Parsec Distribution.System.Arch instance Data.Binary.Class.Binary Distribution.System.OS instance Distribution.Utils.Structured.Structured Distribution.System.OS instance Control.DeepSeq.NFData Distribution.System.OS instance Distribution.Pretty.Pretty Distribution.System.OS instance Distribution.Parsec.Parsec Distribution.System.OS module Distribution.SPDX.LicenseReference -- | A user defined license reference denoted by -- LicenseRef-[idstring] (for a license not on the SPDX License -- List); data LicenseRef -- | License reference. licenseRef :: LicenseRef -> String -- | Document reference. licenseDocumentRef :: LicenseRef -> Maybe String -- | Create LicenseRef from optional document ref and name. mkLicenseRef :: Maybe String -> String -> Maybe LicenseRef -- | Like mkLicenseRef but convert invalid characters into -- -. mkLicenseRef' :: Maybe String -> String -> LicenseRef instance GHC.Generics.Generic Distribution.SPDX.LicenseReference.LicenseRef instance Data.Data.Data Distribution.SPDX.LicenseReference.LicenseRef instance GHC.Classes.Ord Distribution.SPDX.LicenseReference.LicenseRef instance GHC.Classes.Eq Distribution.SPDX.LicenseReference.LicenseRef instance GHC.Read.Read Distribution.SPDX.LicenseReference.LicenseRef instance GHC.Show.Show Distribution.SPDX.LicenseReference.LicenseRef instance Data.Binary.Class.Binary Distribution.SPDX.LicenseReference.LicenseRef instance Distribution.Utils.Structured.Structured Distribution.SPDX.LicenseReference.LicenseRef instance Control.DeepSeq.NFData Distribution.SPDX.LicenseReference.LicenseRef instance Distribution.Pretty.Pretty Distribution.SPDX.LicenseReference.LicenseRef instance Distribution.Parsec.Parsec Distribution.SPDX.LicenseReference.LicenseRef module Distribution.SPDX.LicenseId -- | SPDX License identifier data LicenseId -- | 0BSD, BSD Zero Clause License NullBSD :: LicenseId -- | AAL, Attribution Assurance License AAL :: LicenseId -- | Abstyles, Abstyles License Abstyles :: LicenseId -- | Adobe-2006, Adobe Systems Incorporated Source Code License -- Agreement Adobe_2006 :: LicenseId -- | Adobe-Glyph, Adobe Glyph List License Adobe_Glyph :: LicenseId -- | ADSL, Amazon Digital Services License ADSL :: LicenseId -- | AFL-1.1, Academic Free License v1.1 AFL_1_1 :: LicenseId -- | AFL-1.2, Academic Free License v1.2 AFL_1_2 :: LicenseId -- | AFL-2.0, Academic Free License v2.0 AFL_2_0 :: LicenseId -- | AFL-2.1, Academic Free License v2.1 AFL_2_1 :: LicenseId -- | AFL-3.0, Academic Free License v3.0 AFL_3_0 :: LicenseId -- | Afmparse, Afmparse License Afmparse :: LicenseId -- | AGPL-1.0, Affero General Public License v1.0, SPDX License -- List 3.0 AGPL_1_0 :: LicenseId -- | AGPL-1.0-only, Affero General Public License v1.0 only, SPDX -- License List 3.2, SPDX License List 3.6 AGPL_1_0_only :: LicenseId -- | AGPL-1.0-or-later, Affero General Public License v1.0 or -- later, SPDX License List 3.2, SPDX License List 3.6 AGPL_1_0_or_later :: LicenseId -- | AGPL-3.0-only, GNU Affero General Public License v3.0 only AGPL_3_0_only :: LicenseId -- | AGPL-3.0-or-later, GNU Affero General Public License v3.0 or -- later AGPL_3_0_or_later :: LicenseId -- | Aladdin, Aladdin Free Public License Aladdin :: LicenseId -- | AMDPLPA, AMD's plpa_map.c License AMDPLPA :: LicenseId -- | AML, Apple MIT License AML :: LicenseId -- | AMPAS, Academy of Motion Picture Arts and Sciences BSD AMPAS :: LicenseId -- | ANTLR-PD, ANTLR Software Rights Notice ANTLR_PD :: LicenseId -- | Apache-1.0, Apache License 1.0 Apache_1_0 :: LicenseId -- | Apache-1.1, Apache License 1.1 Apache_1_1 :: LicenseId -- | Apache-2.0, Apache License 2.0 Apache_2_0 :: LicenseId -- | APAFML, Adobe Postscript AFM License APAFML :: LicenseId -- | APL-1.0, Adaptive Public License 1.0 APL_1_0 :: LicenseId -- | APSL-1.0, Apple Public Source License 1.0 APSL_1_0 :: LicenseId -- | APSL-1.1, Apple Public Source License 1.1 APSL_1_1 :: LicenseId -- | APSL-1.2, Apple Public Source License 1.2 APSL_1_2 :: LicenseId -- | APSL-2.0, Apple Public Source License 2.0 APSL_2_0 :: LicenseId -- | Artistic-1.0-cl8, Artistic License 1.0 w/clause 8 Artistic_1_0_cl8 :: LicenseId -- | Artistic-1.0-Perl, Artistic License 1.0 (Perl) Artistic_1_0_Perl :: LicenseId -- | Artistic-1.0, Artistic License 1.0 Artistic_1_0 :: LicenseId -- | Artistic-2.0, Artistic License 2.0 Artistic_2_0 :: LicenseId -- | Bahyph, Bahyph License Bahyph :: LicenseId -- | Barr, Barr License Barr :: LicenseId -- | Beerware, Beerware License Beerware :: LicenseId -- | BitTorrent-1.0, BitTorrent Open Source License v1.0 BitTorrent_1_0 :: LicenseId -- | BitTorrent-1.1, BitTorrent Open Source License v1.1 BitTorrent_1_1 :: LicenseId -- | blessing, SQLite Blessing, SPDX License List 3.6 Blessing :: LicenseId -- | BlueOak-1.0.0, Blue Oak Model License 1.0.0, SPDX License -- List 3.6 BlueOak_1_0_0 :: LicenseId -- | Borceux, Borceux license Borceux :: LicenseId -- | BSD-1-Clause, BSD 1-Clause License BSD_1_Clause :: LicenseId -- | BSD-2-Clause-FreeBSD, BSD 2-Clause FreeBSD License BSD_2_Clause_FreeBSD :: LicenseId -- | BSD-2-Clause-NetBSD, BSD 2-Clause NetBSD License BSD_2_Clause_NetBSD :: LicenseId -- | BSD-2-Clause-Patent, BSD-2-Clause Plus Patent License BSD_2_Clause_Patent :: LicenseId -- | BSD-2-Clause, BSD 2-Clause Simplified License BSD_2_Clause :: LicenseId -- | BSD-3-Clause-Attribution, BSD with attribution BSD_3_Clause_Attribution :: LicenseId -- | BSD-3-Clause-Clear, BSD 3-Clause Clear License BSD_3_Clause_Clear :: LicenseId -- | BSD-3-Clause-LBNL, Lawrence Berkeley National Labs BSD -- variant license BSD_3_Clause_LBNL :: LicenseId -- | BSD-3-Clause-No-Nuclear-License-2014, BSD 3-Clause No Nuclear -- License 2014 BSD_3_Clause_No_Nuclear_License_2014 :: LicenseId -- | BSD-3-Clause-No-Nuclear-License, BSD 3-Clause No Nuclear -- License BSD_3_Clause_No_Nuclear_License :: LicenseId -- | BSD-3-Clause-No-Nuclear-Warranty, BSD 3-Clause No Nuclear -- Warranty BSD_3_Clause_No_Nuclear_Warranty :: LicenseId -- | BSD-3-Clause-Open-MPI, BSD 3-Clause Open MPI variant, SPDX -- License List 3.6 BSD_3_Clause_Open_MPI :: LicenseId -- | BSD-3-Clause, BSD 3-Clause New or Revised -- License BSD_3_Clause :: LicenseId -- | BSD-4-Clause-UC, BSD-4-Clause (University of -- California-Specific) BSD_4_Clause_UC :: LicenseId -- | BSD-4-Clause, BSD 4-Clause Original or Old -- License BSD_4_Clause :: LicenseId -- | BSD-Protection, BSD Protection License BSD_Protection :: LicenseId -- | BSD-Source-Code, BSD Source Code Attribution BSD_Source_Code :: LicenseId -- | BSL-1.0, Boost Software License 1.0 BSL_1_0 :: LicenseId -- | bzip2-1.0.5, bzip2 and libbzip2 License v1.0.5 Bzip2_1_0_5 :: LicenseId -- | bzip2-1.0.6, bzip2 and libbzip2 License v1.0.6 Bzip2_1_0_6 :: LicenseId -- | Caldera, Caldera License Caldera :: LicenseId -- | CATOSL-1.1, Computer Associates Trusted Open Source License -- 1.1 CATOSL_1_1 :: LicenseId -- | CC-BY-1.0, Creative Commons Attribution 1.0 Generic CC_BY_1_0 :: LicenseId -- | CC-BY-2.0, Creative Commons Attribution 2.0 Generic CC_BY_2_0 :: LicenseId -- | CC-BY-2.5, Creative Commons Attribution 2.5 Generic CC_BY_2_5 :: LicenseId -- | CC-BY-3.0, Creative Commons Attribution 3.0 Unported CC_BY_3_0 :: LicenseId -- | CC-BY-4.0, Creative Commons Attribution 4.0 International CC_BY_4_0 :: LicenseId -- | CC-BY-NC-1.0, Creative Commons Attribution Non Commercial 1.0 -- Generic CC_BY_NC_1_0 :: LicenseId -- | CC-BY-NC-2.0, Creative Commons Attribution Non Commercial 2.0 -- Generic CC_BY_NC_2_0 :: LicenseId -- | CC-BY-NC-2.5, Creative Commons Attribution Non Commercial 2.5 -- Generic CC_BY_NC_2_5 :: LicenseId -- | CC-BY-NC-3.0, Creative Commons Attribution Non Commercial 3.0 -- Unported CC_BY_NC_3_0 :: LicenseId -- | CC-BY-NC-4.0, Creative Commons Attribution Non Commercial 4.0 -- International CC_BY_NC_4_0 :: LicenseId -- | CC-BY-NC-ND-1.0, Creative Commons Attribution Non Commercial -- No Derivatives 1.0 Generic CC_BY_NC_ND_1_0 :: LicenseId -- | CC-BY-NC-ND-2.0, Creative Commons Attribution Non Commercial -- No Derivatives 2.0 Generic CC_BY_NC_ND_2_0 :: LicenseId -- | CC-BY-NC-ND-2.5, Creative Commons Attribution Non Commercial -- No Derivatives 2.5 Generic CC_BY_NC_ND_2_5 :: LicenseId -- | CC-BY-NC-ND-3.0, Creative Commons Attribution Non Commercial -- No Derivatives 3.0 Unported CC_BY_NC_ND_3_0 :: LicenseId -- | CC-BY-NC-ND-4.0, Creative Commons Attribution Non Commercial -- No Derivatives 4.0 International CC_BY_NC_ND_4_0 :: LicenseId -- | CC-BY-NC-SA-1.0, Creative Commons Attribution Non Commercial -- Share Alike 1.0 Generic CC_BY_NC_SA_1_0 :: LicenseId -- | CC-BY-NC-SA-2.0, Creative Commons Attribution Non Commercial -- Share Alike 2.0 Generic CC_BY_NC_SA_2_0 :: LicenseId -- | CC-BY-NC-SA-2.5, Creative Commons Attribution Non Commercial -- Share Alike 2.5 Generic CC_BY_NC_SA_2_5 :: LicenseId -- | CC-BY-NC-SA-3.0, Creative Commons Attribution Non Commercial -- Share Alike 3.0 Unported CC_BY_NC_SA_3_0 :: LicenseId -- | CC-BY-NC-SA-4.0, Creative Commons Attribution Non Commercial -- Share Alike 4.0 International CC_BY_NC_SA_4_0 :: LicenseId -- | CC-BY-ND-1.0, Creative Commons Attribution No Derivatives 1.0 -- Generic CC_BY_ND_1_0 :: LicenseId -- | CC-BY-ND-2.0, Creative Commons Attribution No Derivatives 2.0 -- Generic CC_BY_ND_2_0 :: LicenseId -- | CC-BY-ND-2.5, Creative Commons Attribution No Derivatives 2.5 -- Generic CC_BY_ND_2_5 :: LicenseId -- | CC-BY-ND-3.0, Creative Commons Attribution No Derivatives 3.0 -- Unported CC_BY_ND_3_0 :: LicenseId -- | CC-BY-ND-4.0, Creative Commons Attribution No Derivatives 4.0 -- International CC_BY_ND_4_0 :: LicenseId -- | CC-BY-SA-1.0, Creative Commons Attribution Share Alike 1.0 -- Generic CC_BY_SA_1_0 :: LicenseId -- | CC-BY-SA-2.0, Creative Commons Attribution Share Alike 2.0 -- Generic CC_BY_SA_2_0 :: LicenseId -- | CC-BY-SA-2.5, Creative Commons Attribution Share Alike 2.5 -- Generic CC_BY_SA_2_5 :: LicenseId -- | CC-BY-SA-3.0, Creative Commons Attribution Share Alike 3.0 -- Unported CC_BY_SA_3_0 :: LicenseId -- | CC-BY-SA-4.0, Creative Commons Attribution Share Alike 4.0 -- International CC_BY_SA_4_0 :: LicenseId -- | CC-PDDC, Creative Commons Public Domain Dedication and -- Certification, SPDX License List 3.6 CC_PDDC :: LicenseId -- | CC0-1.0, Creative Commons Zero v1.0 Universal CC0_1_0 :: LicenseId -- | CDDL-1.0, Common Development and Distribution License 1.0 CDDL_1_0 :: LicenseId -- | CDDL-1.1, Common Development and Distribution License 1.1 CDDL_1_1 :: LicenseId -- | CDLA-Permissive-1.0, Community Data License Agreement -- Permissive 1.0 CDLA_Permissive_1_0 :: LicenseId -- | CDLA-Sharing-1.0, Community Data License Agreement Sharing -- 1.0 CDLA_Sharing_1_0 :: LicenseId -- | CECILL-1.0, CeCILL Free Software License Agreement v1.0 CECILL_1_0 :: LicenseId -- | CECILL-1.1, CeCILL Free Software License Agreement v1.1 CECILL_1_1 :: LicenseId -- | CECILL-2.0, CeCILL Free Software License Agreement v2.0 CECILL_2_0 :: LicenseId -- | CECILL-2.1, CeCILL Free Software License Agreement v2.1 CECILL_2_1 :: LicenseId -- | CECILL-B, CeCILL-B Free Software License Agreement CECILL_B :: LicenseId -- | CECILL-C, CeCILL-C Free Software License Agreement CECILL_C :: LicenseId -- | CERN-OHL-1.1, CERN Open Hardware License v1.1, SPDX License -- List 3.6 CERN_OHL_1_1 :: LicenseId -- | CERN-OHL-1.2, CERN Open Hardware Licence v1.2, SPDX License -- List 3.6 CERN_OHL_1_2 :: LicenseId -- | ClArtistic, Clarified Artistic License ClArtistic :: LicenseId -- | CNRI-Jython, CNRI Jython License CNRI_Jython :: LicenseId -- | CNRI-Python-GPL-Compatible, CNRI Python Open Source GPL -- Compatible License Agreement CNRI_Python_GPL_Compatible :: LicenseId -- | CNRI-Python, CNRI Python License CNRI_Python :: LicenseId -- | Condor-1.1, Condor Public License v1.1 Condor_1_1 :: LicenseId -- | copyleft-next-0.3.0, copyleft-next 0.3.0, SPDX License List -- 3.6 Copyleft_next_0_3_0 :: LicenseId -- | copyleft-next-0.3.1, copyleft-next 0.3.1, SPDX License List -- 3.6 Copyleft_next_0_3_1 :: LicenseId -- | CPAL-1.0, Common Public Attribution License 1.0 CPAL_1_0 :: LicenseId -- | CPL-1.0, Common Public License 1.0 CPL_1_0 :: LicenseId -- | CPOL-1.02, Code Project Open License 1.02 CPOL_1_02 :: LicenseId -- | Crossword, Crossword License Crossword :: LicenseId -- | CrystalStacker, CrystalStacker License CrystalStacker :: LicenseId -- | CUA-OPL-1.0, CUA Office Public License v1.0 CUA_OPL_1_0 :: LicenseId -- | Cube, Cube License Cube :: LicenseId -- | curl, curl License Curl :: LicenseId -- | D-FSL-1.0, Deutsche Freie Software Lizenz D_FSL_1_0 :: LicenseId -- | diffmark, diffmark license Diffmark :: LicenseId -- | DOC, DOC License DOC :: LicenseId -- | Dotseqn, Dotseqn License Dotseqn :: LicenseId -- | DSDP, DSDP License DSDP :: LicenseId -- | dvipdfm, dvipdfm License Dvipdfm :: LicenseId -- | ECL-1.0, Educational Community License v1.0 ECL_1_0 :: LicenseId -- | ECL-2.0, Educational Community License v2.0 ECL_2_0 :: LicenseId -- | EFL-1.0, Eiffel Forum License v1.0 EFL_1_0 :: LicenseId -- | EFL-2.0, Eiffel Forum License v2.0 EFL_2_0 :: LicenseId -- | eGenix, eGenix.com Public License 1.1.0 EGenix :: LicenseId -- | Entessa, Entessa Public License v1.0 Entessa :: LicenseId -- | EPL-1.0, Eclipse Public License 1.0 EPL_1_0 :: LicenseId -- | EPL-2.0, Eclipse Public License 2.0 EPL_2_0 :: LicenseId -- | ErlPL-1.1, Erlang Public License v1.1 ErlPL_1_1 :: LicenseId -- | EUDatagrid, EU DataGrid Software License EUDatagrid :: LicenseId -- | EUPL-1.0, European Union Public License 1.0 EUPL_1_0 :: LicenseId -- | EUPL-1.1, European Union Public License 1.1 EUPL_1_1 :: LicenseId -- | EUPL-1.2, European Union Public License 1.2 EUPL_1_2 :: LicenseId -- | Eurosym, Eurosym License Eurosym :: LicenseId -- | Fair, Fair License Fair :: LicenseId -- | Frameworx-1.0, Frameworx Open License 1.0 Frameworx_1_0 :: LicenseId -- | FreeImage, FreeImage Public License v1.0 FreeImage :: LicenseId -- | FSFAP, FSF All Permissive License FSFAP :: LicenseId -- | FSFULLR, FSF Unlimited License (with License Retention) FSFULLR :: LicenseId -- | FSFUL, FSF Unlimited License FSFUL :: LicenseId -- | FTL, Freetype Project License FTL :: LicenseId -- | GFDL-1.1-only, GNU Free Documentation License v1.1 only GFDL_1_1_only :: LicenseId -- | GFDL-1.1-or-later, GNU Free Documentation License v1.1 or -- later GFDL_1_1_or_later :: LicenseId -- | GFDL-1.2-only, GNU Free Documentation License v1.2 only GFDL_1_2_only :: LicenseId -- | GFDL-1.2-or-later, GNU Free Documentation License v1.2 or -- later GFDL_1_2_or_later :: LicenseId -- | GFDL-1.3-only, GNU Free Documentation License v1.3 only GFDL_1_3_only :: LicenseId -- | GFDL-1.3-or-later, GNU Free Documentation License v1.3 or -- later GFDL_1_3_or_later :: LicenseId -- | Giftware, Giftware License Giftware :: LicenseId -- | GL2PS, GL2PS License GL2PS :: LicenseId -- | Glide, 3dfx Glide License Glide :: LicenseId -- | Glulxe, Glulxe License Glulxe :: LicenseId -- | gnuplot, gnuplot License Gnuplot :: LicenseId -- | GPL-1.0-only, GNU General Public License v1.0 only GPL_1_0_only :: LicenseId -- | GPL-1.0-or-later, GNU General Public License v1.0 or later GPL_1_0_or_later :: LicenseId -- | GPL-2.0-only, GNU General Public License v2.0 only GPL_2_0_only :: LicenseId -- | GPL-2.0-or-later, GNU General Public License v2.0 or later GPL_2_0_or_later :: LicenseId -- | GPL-3.0-only, GNU General Public License v3.0 only GPL_3_0_only :: LicenseId -- | GPL-3.0-or-later, GNU General Public License v3.0 or later GPL_3_0_or_later :: LicenseId -- | gSOAP-1.3b, gSOAP Public License v1.3b GSOAP_1_3b :: LicenseId -- | HaskellReport, Haskell Language Report License HaskellReport :: LicenseId -- | HPND-sell-variant, Historical Permission Notice and -- Disclaimer - sell variant, SPDX License List 3.6 HPND_sell_variant :: LicenseId -- | HPND, Historical Permission Notice and Disclaimer HPND :: LicenseId -- | IBM-pibs, IBM PowerPC Initialization and Boot Software IBM_pibs :: LicenseId -- | ICU, ICU License ICU :: LicenseId -- | IJG, Independent JPEG Group License IJG :: LicenseId -- | ImageMagick, ImageMagick License ImageMagick :: LicenseId -- | iMatix, iMatix Standard Function Library Agreement IMatix :: LicenseId -- | Imlib2, Imlib2 License Imlib2 :: LicenseId -- | Info-ZIP, Info-ZIP License Info_ZIP :: LicenseId -- | Intel-ACPI, Intel ACPI Software License Agreement Intel_ACPI :: LicenseId -- | Intel, Intel Open Source License Intel :: LicenseId -- | Interbase-1.0, Interbase Public License v1.0 Interbase_1_0 :: LicenseId -- | IPA, IPA Font License IPA :: LicenseId -- | IPL-1.0, IBM Public License v1.0 IPL_1_0 :: LicenseId -- | ISC, ISC License ISC :: LicenseId -- | JasPer-2.0, JasPer License JasPer_2_0 :: LicenseId -- | JPNIC, Japan Network Information Center License, SPDX License -- List 3.6 JPNIC :: LicenseId -- | JSON, JSON License JSON :: LicenseId -- | LAL-1.2, Licence Art Libre 1.2 LAL_1_2 :: LicenseId -- | LAL-1.3, Licence Art Libre 1.3 LAL_1_3 :: LicenseId -- | Latex2e, Latex2e License Latex2e :: LicenseId -- | Leptonica, Leptonica License Leptonica :: LicenseId -- | LGPL-2.0-only, GNU Library General Public License v2 only LGPL_2_0_only :: LicenseId -- | LGPL-2.0-or-later, GNU Library General Public License v2 or -- later LGPL_2_0_or_later :: LicenseId -- | LGPL-2.1-only, GNU Lesser General Public License v2.1 only LGPL_2_1_only :: LicenseId -- | LGPL-2.1-or-later, GNU Lesser General Public License v2.1 or -- later LGPL_2_1_or_later :: LicenseId -- | LGPL-3.0-only, GNU Lesser General Public License v3.0 only LGPL_3_0_only :: LicenseId -- | LGPL-3.0-or-later, GNU Lesser General Public License v3.0 or -- later LGPL_3_0_or_later :: LicenseId -- | LGPLLR, Lesser General Public License For Linguistic -- Resources LGPLLR :: LicenseId -- | libpng-2.0, PNG Reference Library version 2, SPDX License -- List 3.6 Libpng_2_0 :: LicenseId -- | Libpng, libpng License Libpng :: LicenseId -- | libtiff, libtiff License Libtiff :: LicenseId -- | LiLiQ-P-1.1, Licence Libre du Québec – Permissive version 1.1 LiLiQ_P_1_1 :: LicenseId -- | LiLiQ-R-1.1, Licence Libre du Québec – Réciprocité version -- 1.1 LiLiQ_R_1_1 :: LicenseId -- | LiLiQ-Rplus-1.1, Licence Libre du Québec – Réciprocité forte -- version 1.1 LiLiQ_Rplus_1_1 :: LicenseId -- | Linux-OpenIB, Linux Kernel Variant of OpenIB.org license, -- SPDX License List 3.2, SPDX License List 3.6 Linux_OpenIB :: LicenseId -- | LPL-1.02, Lucent Public License v1.02 LPL_1_02 :: LicenseId -- | LPL-1.0, Lucent Public License Version 1.0 LPL_1_0 :: LicenseId -- | LPPL-1.0, LaTeX Project Public License v1.0 LPPL_1_0 :: LicenseId -- | LPPL-1.1, LaTeX Project Public License v1.1 LPPL_1_1 :: LicenseId -- | LPPL-1.2, LaTeX Project Public License v1.2 LPPL_1_2 :: LicenseId -- | LPPL-1.3a, LaTeX Project Public License v1.3a LPPL_1_3a :: LicenseId -- | LPPL-1.3c, LaTeX Project Public License v1.3c LPPL_1_3c :: LicenseId -- | MakeIndex, MakeIndex License MakeIndex :: LicenseId -- | MirOS, MirOS License MirOS :: LicenseId -- | MIT-0, MIT No Attribution, SPDX License List 3.2, SPDX -- License List 3.6 MIT_0 :: LicenseId -- | MIT-advertising, Enlightenment License (e16) MIT_advertising :: LicenseId -- | MIT-CMU, CMU License MIT_CMU :: LicenseId -- | MIT-enna, enna License MIT_enna :: LicenseId -- | MIT-feh, feh License MIT_feh :: LicenseId -- | MITNFA, MIT +no-false-attribs license MITNFA :: LicenseId -- | MIT, MIT License MIT :: LicenseId -- | Motosoto, Motosoto License Motosoto :: LicenseId -- | mpich2, mpich2 License Mpich2 :: LicenseId -- | MPL-1.0, Mozilla Public License 1.0 MPL_1_0 :: LicenseId -- | MPL-1.1, Mozilla Public License 1.1 MPL_1_1 :: LicenseId -- | MPL-2.0-no-copyleft-exception, Mozilla Public License 2.0 (no -- copyleft exception) MPL_2_0_no_copyleft_exception :: LicenseId -- | MPL-2.0, Mozilla Public License 2.0 MPL_2_0 :: LicenseId -- | MS-PL, Microsoft Public License MS_PL :: LicenseId -- | MS-RL, Microsoft Reciprocal License MS_RL :: LicenseId -- | MTLL, Matrix Template Library License MTLL :: LicenseId -- | Multics, Multics License Multics :: LicenseId -- | Mup, Mup License Mup :: LicenseId -- | NASA-1.3, NASA Open Source Agreement 1.3 NASA_1_3 :: LicenseId -- | Naumen, Naumen Public License Naumen :: LicenseId -- | NBPL-1.0, Net Boolean Public License v1 NBPL_1_0 :: LicenseId -- | NCSA, University of Illinois/NCSA Open Source License NCSA :: LicenseId -- | Net-SNMP, Net-SNMP License Net_SNMP :: LicenseId -- | NetCDF, NetCDF license NetCDF :: LicenseId -- | Newsletr, Newsletr License Newsletr :: LicenseId -- | NGPL, Nethack General Public License NGPL :: LicenseId -- | NLOD-1.0, Norwegian Licence for Open Government Data NLOD_1_0 :: LicenseId -- | NLPL, No Limit Public License NLPL :: LicenseId -- | Nokia, Nokia Open Source License Nokia :: LicenseId -- | NOSL, Netizen Open Source License NOSL :: LicenseId -- | Noweb, Noweb License Noweb :: LicenseId -- | NPL-1.0, Netscape Public License v1.0 NPL_1_0 :: LicenseId -- | NPL-1.1, Netscape Public License v1.1 NPL_1_1 :: LicenseId -- | NPOSL-3.0, Non-Profit Open Software License 3.0 NPOSL_3_0 :: LicenseId -- | NRL, NRL License NRL :: LicenseId -- | NTP, NTP License NTP :: LicenseId -- | OCCT-PL, Open CASCADE Technology Public License OCCT_PL :: LicenseId -- | OCLC-2.0, OCLC Research Public License 2.0 OCLC_2_0 :: LicenseId -- | ODbL-1.0, ODC Open Database License v1.0 ODbL_1_0 :: LicenseId -- | ODC-By-1.0, Open Data Commons Attribution License v1.0, SPDX -- License List 3.2, SPDX License List 3.6 ODC_By_1_0 :: LicenseId -- | OFL-1.0, SIL Open Font License 1.0 OFL_1_0 :: LicenseId -- | OFL-1.1, SIL Open Font License 1.1 OFL_1_1 :: LicenseId -- | OGL-UK-1.0, Open Government Licence v1.0, SPDX License List -- 3.6 OGL_UK_1_0 :: LicenseId -- | OGL-UK-2.0, Open Government Licence v2.0, SPDX License List -- 3.6 OGL_UK_2_0 :: LicenseId -- | OGL-UK-3.0, Open Government Licence v3.0, SPDX License List -- 3.6 OGL_UK_3_0 :: LicenseId -- | OGTSL, Open Group Test Suite License OGTSL :: LicenseId -- | OLDAP-1.1, Open LDAP Public License v1.1 OLDAP_1_1 :: LicenseId -- | OLDAP-1.2, Open LDAP Public License v1.2 OLDAP_1_2 :: LicenseId -- | OLDAP-1.3, Open LDAP Public License v1.3 OLDAP_1_3 :: LicenseId -- | OLDAP-1.4, Open LDAP Public License v1.4 OLDAP_1_4 :: LicenseId -- | OLDAP-2.0.1, Open LDAP Public License v2.0.1 OLDAP_2_0_1 :: LicenseId -- | OLDAP-2.0, Open LDAP Public License v2.0 (or possibly 2.0A -- and 2.0B) OLDAP_2_0 :: LicenseId -- | OLDAP-2.1, Open LDAP Public License v2.1 OLDAP_2_1 :: LicenseId -- | OLDAP-2.2.1, Open LDAP Public License v2.2.1 OLDAP_2_2_1 :: LicenseId -- | OLDAP-2.2.2, Open LDAP Public License 2.2.2 OLDAP_2_2_2 :: LicenseId -- | OLDAP-2.2, Open LDAP Public License v2.2 OLDAP_2_2 :: LicenseId -- | OLDAP-2.3, Open LDAP Public License v2.3 OLDAP_2_3 :: LicenseId -- | OLDAP-2.4, Open LDAP Public License v2.4 OLDAP_2_4 :: LicenseId -- | OLDAP-2.5, Open LDAP Public License v2.5 OLDAP_2_5 :: LicenseId -- | OLDAP-2.6, Open LDAP Public License v2.6 OLDAP_2_6 :: LicenseId -- | OLDAP-2.7, Open LDAP Public License v2.7 OLDAP_2_7 :: LicenseId -- | OLDAP-2.8, Open LDAP Public License v2.8 OLDAP_2_8 :: LicenseId -- | OML, Open Market License OML :: LicenseId -- | OpenSSL, OpenSSL License OpenSSL :: LicenseId -- | OPL-1.0, Open Public License v1.0 OPL_1_0 :: LicenseId -- | OSET-PL-2.1, OSET Public License version 2.1 OSET_PL_2_1 :: LicenseId -- | OSL-1.0, Open Software License 1.0 OSL_1_0 :: LicenseId -- | OSL-1.1, Open Software License 1.1 OSL_1_1 :: LicenseId -- | OSL-2.0, Open Software License 2.0 OSL_2_0 :: LicenseId -- | OSL-2.1, Open Software License 2.1 OSL_2_1 :: LicenseId -- | OSL-3.0, Open Software License 3.0 OSL_3_0 :: LicenseId -- | Parity-6.0.0, The Parity Public License 6.0.0, SPDX License -- List 3.6 Parity_6_0_0 :: LicenseId -- | PDDL-1.0, ODC Public Domain Dedication & License 1.0 PDDL_1_0 :: LicenseId -- | PHP-3.01, PHP License v3.01 PHP_3_01 :: LicenseId -- | PHP-3.0, PHP License v3.0 PHP_3_0 :: LicenseId -- | Plexus, Plexus Classworlds License Plexus :: LicenseId -- | PostgreSQL, PostgreSQL License PostgreSQL :: LicenseId -- | psfrag, psfrag License Psfrag :: LicenseId -- | psutils, psutils License Psutils :: LicenseId -- | Python-2.0, Python License 2.0 Python_2_0 :: LicenseId -- | Qhull, Qhull License Qhull :: LicenseId -- | QPL-1.0, Q Public License 1.0 QPL_1_0 :: LicenseId -- | Rdisc, Rdisc License Rdisc :: LicenseId -- | RHeCos-1.1, Red Hat eCos Public License v1.1 RHeCos_1_1 :: LicenseId -- | RPL-1.1, Reciprocal Public License 1.1 RPL_1_1 :: LicenseId -- | RPL-1.5, Reciprocal Public License 1.5 RPL_1_5 :: LicenseId -- | RPSL-1.0, RealNetworks Public Source License v1.0 RPSL_1_0 :: LicenseId -- | RSA-MD, RSA Message-Digest License RSA_MD :: LicenseId -- | RSCPL, Ricoh Source Code Public License RSCPL :: LicenseId -- | Ruby, Ruby License Ruby :: LicenseId -- | SAX-PD, Sax Public Domain Notice SAX_PD :: LicenseId -- | Saxpath, Saxpath License Saxpath :: LicenseId -- | SCEA, SCEA Shared Source License SCEA :: LicenseId -- | Sendmail-8.23, Sendmail License 8.23, SPDX License List 3.6 Sendmail_8_23 :: LicenseId -- | Sendmail, Sendmail License Sendmail :: LicenseId -- | SGI-B-1.0, SGI Free Software License B v1.0 SGI_B_1_0 :: LicenseId -- | SGI-B-1.1, SGI Free Software License B v1.1 SGI_B_1_1 :: LicenseId -- | SGI-B-2.0, SGI Free Software License B v2.0 SGI_B_2_0 :: LicenseId -- | SHL-0.51, Solderpad Hardware License, Version 0.51, SPDX -- License List 3.6 SHL_0_51 :: LicenseId -- | SHL-0.5, Solderpad Hardware License v0.5, SPDX License List -- 3.6 SHL_0_5 :: LicenseId -- | SimPL-2.0, Simple Public License 2.0 SimPL_2_0 :: LicenseId -- | SISSL-1.2, Sun Industry Standards Source License v1.2 SISSL_1_2 :: LicenseId -- | SISSL, Sun Industry Standards Source License v1.1 SISSL :: LicenseId -- | Sleepycat, Sleepycat License Sleepycat :: LicenseId -- | SMLNJ, Standard ML of New Jersey License SMLNJ :: LicenseId -- | SMPPL, Secure Messaging Protocol Public License SMPPL :: LicenseId -- | SNIA, SNIA Public License 1.1 SNIA :: LicenseId -- | Spencer-86, Spencer License 86 Spencer_86 :: LicenseId -- | Spencer-94, Spencer License 94 Spencer_94 :: LicenseId -- | Spencer-99, Spencer License 99 Spencer_99 :: LicenseId -- | SPL-1.0, Sun Public License v1.0 SPL_1_0 :: LicenseId -- | SSPL-1.0, Server Side Public License, v 1, SPDX License List -- 3.6 SSPL_1_0 :: LicenseId -- | SugarCRM-1.1.3, SugarCRM Public License v1.1.3 SugarCRM_1_1_3 :: LicenseId -- | SWL, Scheme Widget Library (SWL) Software License Agreement SWL :: LicenseId -- | TAPR-OHL-1.0, TAPR Open Hardware License v1.0, SPDX License -- List 3.6 TAPR_OHL_1_0 :: LicenseId -- | TCL, TCL/TK License TCL :: LicenseId -- | TCP-wrappers, TCP Wrappers License TCP_wrappers :: LicenseId -- | TMate, TMate Open Source License TMate :: LicenseId -- | TORQUE-1.1, TORQUE v2.5+ Software License v1.1 TORQUE_1_1 :: LicenseId -- | TOSL, Trusster Open Source License TOSL :: LicenseId -- | TU-Berlin-1.0, Technische Universitaet Berlin License 1.0, -- SPDX License List 3.2, SPDX License List 3.6 TU_Berlin_1_0 :: LicenseId -- | TU-Berlin-2.0, Technische Universitaet Berlin License 2.0, -- SPDX License List 3.2, SPDX License List 3.6 TU_Berlin_2_0 :: LicenseId -- | Unicode-DFS-2015, Unicode License Agreement - Data Files and -- Software (2015) Unicode_DFS_2015 :: LicenseId -- | Unicode-DFS-2016, Unicode License Agreement - Data Files and -- Software (2016) Unicode_DFS_2016 :: LicenseId -- | Unicode-TOU, Unicode Terms of Use Unicode_TOU :: LicenseId -- | Unlicense, The Unlicense Unlicense :: LicenseId -- | UPL-1.0, Universal Permissive License v1.0 UPL_1_0 :: LicenseId -- | Vim, Vim License Vim :: LicenseId -- | VOSTROM, VOSTROM Public License for Open Source VOSTROM :: LicenseId -- | VSL-1.0, Vovida Software License v1.0 VSL_1_0 :: LicenseId -- | W3C-19980720, W3C Software Notice and License (1998-07-20) W3C_19980720 :: LicenseId -- | W3C-20150513, W3C Software Notice and Document License -- (2015-05-13) W3C_20150513 :: LicenseId -- | W3C, W3C Software Notice and License (2002-12-31) W3C :: LicenseId -- | Watcom-1.0, Sybase Open Watcom Public License 1.0 Watcom_1_0 :: LicenseId -- | Wsuipa, Wsuipa License Wsuipa :: LicenseId -- | WTFPL, Do What The F*ck You Want To Public License WTFPL :: LicenseId -- | X11, X11 License X11 :: LicenseId -- | Xerox, Xerox License Xerox :: LicenseId -- | XFree86-1.1, XFree86 License 1.1 XFree86_1_1 :: LicenseId -- | xinetd, xinetd License Xinetd :: LicenseId -- | Xnet, X.Net License Xnet :: LicenseId -- | xpp, XPP License Xpp :: LicenseId -- | XSkat, XSkat License XSkat :: LicenseId -- | YPL-1.0, Yahoo! Public License v1.0 YPL_1_0 :: LicenseId -- | YPL-1.1, Yahoo! Public License v1.1 YPL_1_1 :: LicenseId -- | Zed, Zed License Zed :: LicenseId -- | Zend-2.0, Zend License v2.0 Zend_2_0 :: LicenseId -- | Zimbra-1.3, Zimbra Public License v1.3 Zimbra_1_3 :: LicenseId -- | Zimbra-1.4, Zimbra Public License v1.4 Zimbra_1_4 :: LicenseId -- | zlib-acknowledgement, zlib/libpng License with -- Acknowledgement Zlib_acknowledgement :: LicenseId -- | Zlib, zlib License Zlib :: LicenseId -- | ZPL-1.1, Zope Public License 1.1 ZPL_1_1 :: LicenseId -- | ZPL-2.0, Zope Public License 2.0 ZPL_2_0 :: LicenseId -- | ZPL-2.1, Zope Public License 2.1 ZPL_2_1 :: LicenseId -- | License SPDX identifier, e.g. "BSD-3-Clause". licenseId :: LicenseId -> String -- | License name, e.g. "GNU General Public License v2.0 only" licenseName :: LicenseId -> String -- | Whether the license is approved by Open Source Initiative (OSI). -- -- See https://opensource.org/licenses/alphabetical. licenseIsOsiApproved :: LicenseId -> Bool -- | Create a LicenseId from a String. mkLicenseId :: LicenseListVersion -> String -> Maybe LicenseId licenseIdList :: LicenseListVersion -> [LicenseId] -- | Help message for migrating from non-SPDX license identifiers. -- -- Old License is almost SPDX, except for BSD2, -- BSD3. This function suggests SPDX variant: -- --
-- >>> licenseIdMigrationMessage "BSD3" -- "Do you mean BSD-3-Clause?" ---- -- Also OtherLicense, AllRightsReserved, and -- PublicDomain aren't valid SPDX identifiers -- --
-- >>> traverse_ (print . licenseIdMigrationMessage) [ "OtherLicense", "AllRightsReserved", "PublicDomain" ] -- "SPDX license list contains plenty of licenses. See https://spdx.org/licenses/. Also they can be combined into complex expressions with AND and OR." -- "You can use NONE as a value of license field." -- "Public Domain is a complex matter. See https://wiki.spdx.org/view/Legal_Team/Decisions/Dealing_with_Public_Domain_within_SPDX_Files. Consider using a proper license." ---- -- SPDX License list version 3.0 introduced "-only" and "-or-later" -- variants for GNU family of licenses. See -- https://spdx.org/news/news/2018/01/license-list-30-released -- >>> licenseIdMigrationMessage "GPL-2.0" "SPDX license list -- 3.0 deprecated suffixless variants of GNU family of licenses. Use -- GPL-2.0-only or GPL-2.0-or-later." -- -- For other common licenses their old license format coincides with the -- SPDX identifiers: -- --
-- >>> traverse eitherParsec ["GPL-2.0-only", "GPL-3.0-only", "LGPL-2.1-only", "MIT", "ISC", "MPL-2.0", "Apache-2.0"] :: Either String [LicenseId] -- Right [GPL_2_0_only,GPL_3_0_only,LGPL_2_1_only,MIT,ISC,MPL_2_0,Apache_2_0] --licenseIdMigrationMessage :: String -> String instance GHC.Generics.Generic Distribution.SPDX.LicenseId.LicenseId instance Data.Data.Data Distribution.SPDX.LicenseId.LicenseId instance GHC.Read.Read Distribution.SPDX.LicenseId.LicenseId instance GHC.Show.Show Distribution.SPDX.LicenseId.LicenseId instance GHC.Enum.Bounded Distribution.SPDX.LicenseId.LicenseId instance GHC.Enum.Enum Distribution.SPDX.LicenseId.LicenseId instance GHC.Classes.Ord Distribution.SPDX.LicenseId.LicenseId instance GHC.Classes.Eq Distribution.SPDX.LicenseId.LicenseId instance Data.Binary.Class.Binary Distribution.SPDX.LicenseId.LicenseId instance Distribution.Utils.Structured.Structured Distribution.SPDX.LicenseId.LicenseId instance Distribution.Pretty.Pretty Distribution.SPDX.LicenseId.LicenseId instance Distribution.Parsec.Parsec Distribution.SPDX.LicenseId.LicenseId instance Control.DeepSeq.NFData Distribution.SPDX.LicenseId.LicenseId module Distribution.SPDX.LicenseExceptionId -- | SPDX License identifier data LicenseExceptionId -- | 389-exception, 389 Directory Server Exception DS389_exception :: LicenseExceptionId -- | Autoconf-exception-2.0, Autoconf exception 2.0 Autoconf_exception_2_0 :: LicenseExceptionId -- | Autoconf-exception-3.0, Autoconf exception 3.0 Autoconf_exception_3_0 :: LicenseExceptionId -- | Bison-exception-2.2, Bison exception 2.2 Bison_exception_2_2 :: LicenseExceptionId -- | Bootloader-exception, Bootloader Distribution Exception Bootloader_exception :: LicenseExceptionId -- | Classpath-exception-2.0, Classpath exception 2.0 Classpath_exception_2_0 :: LicenseExceptionId -- | CLISP-exception-2.0, CLISP exception 2.0 CLISP_exception_2_0 :: LicenseExceptionId -- | DigiRule-FOSS-exception, DigiRule FOSS License Exception DigiRule_FOSS_exception :: LicenseExceptionId -- | eCos-exception-2.0, eCos exception 2.0 ECos_exception_2_0 :: LicenseExceptionId -- | Fawkes-Runtime-exception, Fawkes Runtime Exception Fawkes_Runtime_exception :: LicenseExceptionId -- | FLTK-exception, FLTK exception FLTK_exception :: LicenseExceptionId -- | Font-exception-2.0, Font exception 2.0 Font_exception_2_0 :: LicenseExceptionId -- | freertos-exception-2.0, FreeRTOS Exception 2.0 Freertos_exception_2_0 :: LicenseExceptionId -- | GCC-exception-2.0, GCC Runtime Library exception 2.0 GCC_exception_2_0 :: LicenseExceptionId -- | GCC-exception-3.1, GCC Runtime Library exception 3.1 GCC_exception_3_1 :: LicenseExceptionId -- | gnu-javamail-exception, GNU JavaMail exception Gnu_javamail_exception :: LicenseExceptionId -- | GPL-CC-1.0, GPL Cooperation Commitment 1.0, SPDX License List -- 3.6 GPL_CC_1_0 :: LicenseExceptionId -- | i2p-gpl-java-exception, i2p GPL+Java Exception I2p_gpl_java_exception :: LicenseExceptionId -- | Libtool-exception, Libtool Exception Libtool_exception :: LicenseExceptionId -- | Linux-syscall-note, Linux Syscall Note Linux_syscall_note :: LicenseExceptionId -- | LLVM-exception, LLVM Exception, SPDX License List 3.2, SPDX -- License List 3.6 LLVM_exception :: LicenseExceptionId -- | LZMA-exception, LZMA exception LZMA_exception :: LicenseExceptionId -- | mif-exception, Macros and Inline Functions Exception Mif_exception :: LicenseExceptionId -- | Nokia-Qt-exception-1.1, Nokia Qt LGPL exception 1.1, SPDX -- License List 3.0, SPDX License List 3.2 Nokia_Qt_exception_1_1 :: LicenseExceptionId -- | OCaml-LGPL-linking-exception, OCaml LGPL Linking Exception, -- SPDX License List 3.6 OCaml_LGPL_linking_exception :: LicenseExceptionId -- | OCCT-exception-1.0, Open CASCADE Exception 1.0 OCCT_exception_1_0 :: LicenseExceptionId -- | OpenJDK-assembly-exception-1.0, OpenJDK Assembly exception -- 1.0, SPDX License List 3.2, SPDX License List 3.6 OpenJDK_assembly_exception_1_0 :: LicenseExceptionId -- | openvpn-openssl-exception, OpenVPN OpenSSL Exception Openvpn_openssl_exception :: LicenseExceptionId -- | PS-or-PDF-font-exception-20170817, PS/PDF font exception -- (2017-08-17), SPDX License List 3.2, SPDX License List 3.6 PS_or_PDF_font_exception_20170817 :: LicenseExceptionId -- | Qt-GPL-exception-1.0, Qt GPL exception 1.0, SPDX License List -- 3.2, SPDX License List 3.6 Qt_GPL_exception_1_0 :: LicenseExceptionId -- | Qt-LGPL-exception-1.1, Qt LGPL exception 1.1, SPDX License -- List 3.2, SPDX License List 3.6 Qt_LGPL_exception_1_1 :: LicenseExceptionId -- | Qwt-exception-1.0, Qwt exception 1.0 Qwt_exception_1_0 :: LicenseExceptionId -- | Swift-exception, Swift Exception, SPDX License List 3.6 Swift_exception :: LicenseExceptionId -- | u-boot-exception-2.0, U-Boot exception 2.0 U_boot_exception_2_0 :: LicenseExceptionId -- | Universal-FOSS-exception-1.0, Universal FOSS Exception, -- Version 1.0, SPDX License List 3.6 Universal_FOSS_exception_1_0 :: LicenseExceptionId -- | WxWindows-exception-3.1, WxWindows Library Exception 3.1 WxWindows_exception_3_1 :: LicenseExceptionId -- | License SPDX identifier, e.g. "BSD-3-Clause". licenseExceptionId :: LicenseExceptionId -> String -- | License name, e.g. "GNU General Public License v2.0 only" licenseExceptionName :: LicenseExceptionId -> String -- | Create a LicenseExceptionId from a String. mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId] instance GHC.Generics.Generic Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Data.Data.Data Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Read.Read Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Show.Show Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Enum.Bounded Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Enum.Enum Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Classes.Ord Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance GHC.Classes.Eq Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Data.Binary.Class.Binary Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Distribution.Utils.Structured.Structured Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Distribution.Pretty.Pretty Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Distribution.Parsec.Parsec Distribution.SPDX.LicenseExceptionId.LicenseExceptionId instance Control.DeepSeq.NFData Distribution.SPDX.LicenseExceptionId.LicenseExceptionId module Distribution.SPDX.LicenseExpression -- | SPDX License Expression. -- --
-- idstring = 1*(ALPHA / DIGIT / "-" / "." ) -- license id = <short form license identifier inAppendix I.1> -- license exception id = <short form license exception identifier inAppendix I.2> -- license ref = ["DocumentRef-"1*(idstring)":"]"LicenseRef-"1*(idstring) -- -- simple expression = license id / license id"+" / license ref -- -- compound expression = 1*1(simple expression / -- simple expression "WITH" license exception id / -- compound expression "AND" compound expression / -- compound expression "OR" compound expression ) / -- "(" compound expression ")" ) -- -- license expression = 1*1(simple expression / compound expression) --data LicenseExpression ELicense :: !SimpleLicenseExpression -> !Maybe LicenseExceptionId -> LicenseExpression EAnd :: !LicenseExpression -> !LicenseExpression -> LicenseExpression EOr :: !LicenseExpression -> !LicenseExpression -> LicenseExpression -- | Simple License Expressions. data SimpleLicenseExpression -- | An SPDX License List Short Form Identifier. For example: -- GPL-2.0-only ELicenseId :: LicenseId -> SimpleLicenseExpression -- | An SPDX License List Short Form Identifier with a unary"+" operator -- suffix to represent the current version of the license or any later -- version. For example: GPL-2.0+ ELicenseIdPlus :: LicenseId -> SimpleLicenseExpression -- | A SPDX user defined license reference: For example: -- LicenseRef-23, LicenseRef-MIT-Style-1, or -- DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2 ELicenseRef :: LicenseRef -> SimpleLicenseExpression simpleLicenseExpression :: LicenseId -> LicenseExpression instance GHC.Generics.Generic Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance Data.Data.Data Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance GHC.Classes.Ord Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance GHC.Classes.Eq Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance GHC.Read.Read Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance GHC.Show.Show Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance GHC.Generics.Generic Distribution.SPDX.LicenseExpression.LicenseExpression instance Data.Data.Data Distribution.SPDX.LicenseExpression.LicenseExpression instance GHC.Classes.Ord Distribution.SPDX.LicenseExpression.LicenseExpression instance GHC.Classes.Eq Distribution.SPDX.LicenseExpression.LicenseExpression instance GHC.Read.Read Distribution.SPDX.LicenseExpression.LicenseExpression instance GHC.Show.Show Distribution.SPDX.LicenseExpression.LicenseExpression instance Data.Binary.Class.Binary Distribution.SPDX.LicenseExpression.LicenseExpression instance Distribution.Utils.Structured.Structured Distribution.SPDX.LicenseExpression.LicenseExpression instance Distribution.Pretty.Pretty Distribution.SPDX.LicenseExpression.LicenseExpression instance Distribution.Parsec.Parsec Distribution.SPDX.LicenseExpression.LicenseExpression instance Control.DeepSeq.NFData Distribution.SPDX.LicenseExpression.LicenseExpression instance Data.Binary.Class.Binary Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance Distribution.Utils.Structured.Structured Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance Distribution.Pretty.Pretty Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance Distribution.Parsec.Parsec Distribution.SPDX.LicenseExpression.SimpleLicenseExpression instance Control.DeepSeq.NFData Distribution.SPDX.LicenseExpression.SimpleLicenseExpression module Distribution.SPDX.License -- | Declared license. See section 3.15 of SPDX Specification 2.1 -- -- Note: the NOASSERTION case is omitted. -- -- Old License can be migrated using following rules: -- --
-- idstring = 1*(ALPHA / DIGIT / "-" / "." ) -- license id = <short form license identifier inAppendix I.1> -- license exception id = <short form license exception identifier inAppendix I.2> -- license ref = ["DocumentRef-"1*(idstring)":"]"LicenseRef-"1*(idstring) -- -- simple expression = license id / license id"+" / license ref -- -- compound expression = 1*1(simple expression / -- simple expression "WITH" license exception id / -- compound expression "AND" compound expression / -- compound expression "OR" compound expression ) / -- "(" compound expression ")" ) -- -- license expression = 1*1(simple expression / compound expression) --data LicenseExpression ELicense :: !SimpleLicenseExpression -> !Maybe LicenseExceptionId -> LicenseExpression EAnd :: !LicenseExpression -> !LicenseExpression -> LicenseExpression EOr :: !LicenseExpression -> !LicenseExpression -> LicenseExpression -- | Simple License Expressions. data SimpleLicenseExpression -- | An SPDX License List Short Form Identifier. For example: -- GPL-2.0-only ELicenseId :: LicenseId -> SimpleLicenseExpression -- | An SPDX License List Short Form Identifier with a unary"+" operator -- suffix to represent the current version of the license or any later -- version. For example: GPL-2.0+ ELicenseIdPlus :: LicenseId -> SimpleLicenseExpression -- | A SPDX user defined license reference: For example: -- LicenseRef-23, LicenseRef-MIT-Style-1, or -- DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2 ELicenseRef :: LicenseRef -> SimpleLicenseExpression simpleLicenseExpression :: LicenseId -> LicenseExpression -- | SPDX License identifier data LicenseId -- | 0BSD, BSD Zero Clause License NullBSD :: LicenseId -- | AAL, Attribution Assurance License AAL :: LicenseId -- | Abstyles, Abstyles License Abstyles :: LicenseId -- | Adobe-2006, Adobe Systems Incorporated Source Code License -- Agreement Adobe_2006 :: LicenseId -- | Adobe-Glyph, Adobe Glyph List License Adobe_Glyph :: LicenseId -- | ADSL, Amazon Digital Services License ADSL :: LicenseId -- | AFL-1.1, Academic Free License v1.1 AFL_1_1 :: LicenseId -- | AFL-1.2, Academic Free License v1.2 AFL_1_2 :: LicenseId -- | AFL-2.0, Academic Free License v2.0 AFL_2_0 :: LicenseId -- | AFL-2.1, Academic Free License v2.1 AFL_2_1 :: LicenseId -- | AFL-3.0, Academic Free License v3.0 AFL_3_0 :: LicenseId -- | Afmparse, Afmparse License Afmparse :: LicenseId -- | AGPL-1.0, Affero General Public License v1.0, SPDX License -- List 3.0 AGPL_1_0 :: LicenseId -- | AGPL-1.0-only, Affero General Public License v1.0 only, SPDX -- License List 3.2, SPDX License List 3.6 AGPL_1_0_only :: LicenseId -- | AGPL-1.0-or-later, Affero General Public License v1.0 or -- later, SPDX License List 3.2, SPDX License List 3.6 AGPL_1_0_or_later :: LicenseId -- | AGPL-3.0-only, GNU Affero General Public License v3.0 only AGPL_3_0_only :: LicenseId -- | AGPL-3.0-or-later, GNU Affero General Public License v3.0 or -- later AGPL_3_0_or_later :: LicenseId -- | Aladdin, Aladdin Free Public License Aladdin :: LicenseId -- | AMDPLPA, AMD's plpa_map.c License AMDPLPA :: LicenseId -- | AML, Apple MIT License AML :: LicenseId -- | AMPAS, Academy of Motion Picture Arts and Sciences BSD AMPAS :: LicenseId -- | ANTLR-PD, ANTLR Software Rights Notice ANTLR_PD :: LicenseId -- | Apache-1.0, Apache License 1.0 Apache_1_0 :: LicenseId -- | Apache-1.1, Apache License 1.1 Apache_1_1 :: LicenseId -- | Apache-2.0, Apache License 2.0 Apache_2_0 :: LicenseId -- | APAFML, Adobe Postscript AFM License APAFML :: LicenseId -- | APL-1.0, Adaptive Public License 1.0 APL_1_0 :: LicenseId -- | APSL-1.0, Apple Public Source License 1.0 APSL_1_0 :: LicenseId -- | APSL-1.1, Apple Public Source License 1.1 APSL_1_1 :: LicenseId -- | APSL-1.2, Apple Public Source License 1.2 APSL_1_2 :: LicenseId -- | APSL-2.0, Apple Public Source License 2.0 APSL_2_0 :: LicenseId -- | Artistic-1.0-cl8, Artistic License 1.0 w/clause 8 Artistic_1_0_cl8 :: LicenseId -- | Artistic-1.0-Perl, Artistic License 1.0 (Perl) Artistic_1_0_Perl :: LicenseId -- | Artistic-1.0, Artistic License 1.0 Artistic_1_0 :: LicenseId -- | Artistic-2.0, Artistic License 2.0 Artistic_2_0 :: LicenseId -- | Bahyph, Bahyph License Bahyph :: LicenseId -- | Barr, Barr License Barr :: LicenseId -- | Beerware, Beerware License Beerware :: LicenseId -- | BitTorrent-1.0, BitTorrent Open Source License v1.0 BitTorrent_1_0 :: LicenseId -- | BitTorrent-1.1, BitTorrent Open Source License v1.1 BitTorrent_1_1 :: LicenseId -- | blessing, SQLite Blessing, SPDX License List 3.6 Blessing :: LicenseId -- | BlueOak-1.0.0, Blue Oak Model License 1.0.0, SPDX License -- List 3.6 BlueOak_1_0_0 :: LicenseId -- | Borceux, Borceux license Borceux :: LicenseId -- | BSD-1-Clause, BSD 1-Clause License BSD_1_Clause :: LicenseId -- | BSD-2-Clause-FreeBSD, BSD 2-Clause FreeBSD License BSD_2_Clause_FreeBSD :: LicenseId -- | BSD-2-Clause-NetBSD, BSD 2-Clause NetBSD License BSD_2_Clause_NetBSD :: LicenseId -- | BSD-2-Clause-Patent, BSD-2-Clause Plus Patent License BSD_2_Clause_Patent :: LicenseId -- | BSD-2-Clause, BSD 2-Clause Simplified License BSD_2_Clause :: LicenseId -- | BSD-3-Clause-Attribution, BSD with attribution BSD_3_Clause_Attribution :: LicenseId -- | BSD-3-Clause-Clear, BSD 3-Clause Clear License BSD_3_Clause_Clear :: LicenseId -- | BSD-3-Clause-LBNL, Lawrence Berkeley National Labs BSD -- variant license BSD_3_Clause_LBNL :: LicenseId -- | BSD-3-Clause-No-Nuclear-License-2014, BSD 3-Clause No Nuclear -- License 2014 BSD_3_Clause_No_Nuclear_License_2014 :: LicenseId -- | BSD-3-Clause-No-Nuclear-License, BSD 3-Clause No Nuclear -- License BSD_3_Clause_No_Nuclear_License :: LicenseId -- | BSD-3-Clause-No-Nuclear-Warranty, BSD 3-Clause No Nuclear -- Warranty BSD_3_Clause_No_Nuclear_Warranty :: LicenseId -- | BSD-3-Clause-Open-MPI, BSD 3-Clause Open MPI variant, SPDX -- License List 3.6 BSD_3_Clause_Open_MPI :: LicenseId -- | BSD-3-Clause, BSD 3-Clause New or Revised -- License BSD_3_Clause :: LicenseId -- | BSD-4-Clause-UC, BSD-4-Clause (University of -- California-Specific) BSD_4_Clause_UC :: LicenseId -- | BSD-4-Clause, BSD 4-Clause Original or Old -- License BSD_4_Clause :: LicenseId -- | BSD-Protection, BSD Protection License BSD_Protection :: LicenseId -- | BSD-Source-Code, BSD Source Code Attribution BSD_Source_Code :: LicenseId -- | BSL-1.0, Boost Software License 1.0 BSL_1_0 :: LicenseId -- | bzip2-1.0.5, bzip2 and libbzip2 License v1.0.5 Bzip2_1_0_5 :: LicenseId -- | bzip2-1.0.6, bzip2 and libbzip2 License v1.0.6 Bzip2_1_0_6 :: LicenseId -- | Caldera, Caldera License Caldera :: LicenseId -- | CATOSL-1.1, Computer Associates Trusted Open Source License -- 1.1 CATOSL_1_1 :: LicenseId -- | CC-BY-1.0, Creative Commons Attribution 1.0 Generic CC_BY_1_0 :: LicenseId -- | CC-BY-2.0, Creative Commons Attribution 2.0 Generic CC_BY_2_0 :: LicenseId -- | CC-BY-2.5, Creative Commons Attribution 2.5 Generic CC_BY_2_5 :: LicenseId -- | CC-BY-3.0, Creative Commons Attribution 3.0 Unported CC_BY_3_0 :: LicenseId -- | CC-BY-4.0, Creative Commons Attribution 4.0 International CC_BY_4_0 :: LicenseId -- | CC-BY-NC-1.0, Creative Commons Attribution Non Commercial 1.0 -- Generic CC_BY_NC_1_0 :: LicenseId -- | CC-BY-NC-2.0, Creative Commons Attribution Non Commercial 2.0 -- Generic CC_BY_NC_2_0 :: LicenseId -- | CC-BY-NC-2.5, Creative Commons Attribution Non Commercial 2.5 -- Generic CC_BY_NC_2_5 :: LicenseId -- | CC-BY-NC-3.0, Creative Commons Attribution Non Commercial 3.0 -- Unported CC_BY_NC_3_0 :: LicenseId -- | CC-BY-NC-4.0, Creative Commons Attribution Non Commercial 4.0 -- International CC_BY_NC_4_0 :: LicenseId -- | CC-BY-NC-ND-1.0, Creative Commons Attribution Non Commercial -- No Derivatives 1.0 Generic CC_BY_NC_ND_1_0 :: LicenseId -- | CC-BY-NC-ND-2.0, Creative Commons Attribution Non Commercial -- No Derivatives 2.0 Generic CC_BY_NC_ND_2_0 :: LicenseId -- | CC-BY-NC-ND-2.5, Creative Commons Attribution Non Commercial -- No Derivatives 2.5 Generic CC_BY_NC_ND_2_5 :: LicenseId -- | CC-BY-NC-ND-3.0, Creative Commons Attribution Non Commercial -- No Derivatives 3.0 Unported CC_BY_NC_ND_3_0 :: LicenseId -- | CC-BY-NC-ND-4.0, Creative Commons Attribution Non Commercial -- No Derivatives 4.0 International CC_BY_NC_ND_4_0 :: LicenseId -- | CC-BY-NC-SA-1.0, Creative Commons Attribution Non Commercial -- Share Alike 1.0 Generic CC_BY_NC_SA_1_0 :: LicenseId -- | CC-BY-NC-SA-2.0, Creative Commons Attribution Non Commercial -- Share Alike 2.0 Generic CC_BY_NC_SA_2_0 :: LicenseId -- | CC-BY-NC-SA-2.5, Creative Commons Attribution Non Commercial -- Share Alike 2.5 Generic CC_BY_NC_SA_2_5 :: LicenseId -- | CC-BY-NC-SA-3.0, Creative Commons Attribution Non Commercial -- Share Alike 3.0 Unported CC_BY_NC_SA_3_0 :: LicenseId -- | CC-BY-NC-SA-4.0, Creative Commons Attribution Non Commercial -- Share Alike 4.0 International CC_BY_NC_SA_4_0 :: LicenseId -- | CC-BY-ND-1.0, Creative Commons Attribution No Derivatives 1.0 -- Generic CC_BY_ND_1_0 :: LicenseId -- | CC-BY-ND-2.0, Creative Commons Attribution No Derivatives 2.0 -- Generic CC_BY_ND_2_0 :: LicenseId -- | CC-BY-ND-2.5, Creative Commons Attribution No Derivatives 2.5 -- Generic CC_BY_ND_2_5 :: LicenseId -- | CC-BY-ND-3.0, Creative Commons Attribution No Derivatives 3.0 -- Unported CC_BY_ND_3_0 :: LicenseId -- | CC-BY-ND-4.0, Creative Commons Attribution No Derivatives 4.0 -- International CC_BY_ND_4_0 :: LicenseId -- | CC-BY-SA-1.0, Creative Commons Attribution Share Alike 1.0 -- Generic CC_BY_SA_1_0 :: LicenseId -- | CC-BY-SA-2.0, Creative Commons Attribution Share Alike 2.0 -- Generic CC_BY_SA_2_0 :: LicenseId -- | CC-BY-SA-2.5, Creative Commons Attribution Share Alike 2.5 -- Generic CC_BY_SA_2_5 :: LicenseId -- | CC-BY-SA-3.0, Creative Commons Attribution Share Alike 3.0 -- Unported CC_BY_SA_3_0 :: LicenseId -- | CC-BY-SA-4.0, Creative Commons Attribution Share Alike 4.0 -- International CC_BY_SA_4_0 :: LicenseId -- | CC-PDDC, Creative Commons Public Domain Dedication and -- Certification, SPDX License List 3.6 CC_PDDC :: LicenseId -- | CC0-1.0, Creative Commons Zero v1.0 Universal CC0_1_0 :: LicenseId -- | CDDL-1.0, Common Development and Distribution License 1.0 CDDL_1_0 :: LicenseId -- | CDDL-1.1, Common Development and Distribution License 1.1 CDDL_1_1 :: LicenseId -- | CDLA-Permissive-1.0, Community Data License Agreement -- Permissive 1.0 CDLA_Permissive_1_0 :: LicenseId -- | CDLA-Sharing-1.0, Community Data License Agreement Sharing -- 1.0 CDLA_Sharing_1_0 :: LicenseId -- | CECILL-1.0, CeCILL Free Software License Agreement v1.0 CECILL_1_0 :: LicenseId -- | CECILL-1.1, CeCILL Free Software License Agreement v1.1 CECILL_1_1 :: LicenseId -- | CECILL-2.0, CeCILL Free Software License Agreement v2.0 CECILL_2_0 :: LicenseId -- | CECILL-2.1, CeCILL Free Software License Agreement v2.1 CECILL_2_1 :: LicenseId -- | CECILL-B, CeCILL-B Free Software License Agreement CECILL_B :: LicenseId -- | CECILL-C, CeCILL-C Free Software License Agreement CECILL_C :: LicenseId -- | CERN-OHL-1.1, CERN Open Hardware License v1.1, SPDX License -- List 3.6 CERN_OHL_1_1 :: LicenseId -- | CERN-OHL-1.2, CERN Open Hardware Licence v1.2, SPDX License -- List 3.6 CERN_OHL_1_2 :: LicenseId -- | ClArtistic, Clarified Artistic License ClArtistic :: LicenseId -- | CNRI-Jython, CNRI Jython License CNRI_Jython :: LicenseId -- | CNRI-Python-GPL-Compatible, CNRI Python Open Source GPL -- Compatible License Agreement CNRI_Python_GPL_Compatible :: LicenseId -- | CNRI-Python, CNRI Python License CNRI_Python :: LicenseId -- | Condor-1.1, Condor Public License v1.1 Condor_1_1 :: LicenseId -- | copyleft-next-0.3.0, copyleft-next 0.3.0, SPDX License List -- 3.6 Copyleft_next_0_3_0 :: LicenseId -- | copyleft-next-0.3.1, copyleft-next 0.3.1, SPDX License List -- 3.6 Copyleft_next_0_3_1 :: LicenseId -- | CPAL-1.0, Common Public Attribution License 1.0 CPAL_1_0 :: LicenseId -- | CPL-1.0, Common Public License 1.0 CPL_1_0 :: LicenseId -- | CPOL-1.02, Code Project Open License 1.02 CPOL_1_02 :: LicenseId -- | Crossword, Crossword License Crossword :: LicenseId -- | CrystalStacker, CrystalStacker License CrystalStacker :: LicenseId -- | CUA-OPL-1.0, CUA Office Public License v1.0 CUA_OPL_1_0 :: LicenseId -- | Cube, Cube License Cube :: LicenseId -- | curl, curl License Curl :: LicenseId -- | D-FSL-1.0, Deutsche Freie Software Lizenz D_FSL_1_0 :: LicenseId -- | diffmark, diffmark license Diffmark :: LicenseId -- | DOC, DOC License DOC :: LicenseId -- | Dotseqn, Dotseqn License Dotseqn :: LicenseId -- | DSDP, DSDP License DSDP :: LicenseId -- | dvipdfm, dvipdfm License Dvipdfm :: LicenseId -- | ECL-1.0, Educational Community License v1.0 ECL_1_0 :: LicenseId -- | ECL-2.0, Educational Community License v2.0 ECL_2_0 :: LicenseId -- | EFL-1.0, Eiffel Forum License v1.0 EFL_1_0 :: LicenseId -- | EFL-2.0, Eiffel Forum License v2.0 EFL_2_0 :: LicenseId -- | eGenix, eGenix.com Public License 1.1.0 EGenix :: LicenseId -- | Entessa, Entessa Public License v1.0 Entessa :: LicenseId -- | EPL-1.0, Eclipse Public License 1.0 EPL_1_0 :: LicenseId -- | EPL-2.0, Eclipse Public License 2.0 EPL_2_0 :: LicenseId -- | ErlPL-1.1, Erlang Public License v1.1 ErlPL_1_1 :: LicenseId -- | EUDatagrid, EU DataGrid Software License EUDatagrid :: LicenseId -- | EUPL-1.0, European Union Public License 1.0 EUPL_1_0 :: LicenseId -- | EUPL-1.1, European Union Public License 1.1 EUPL_1_1 :: LicenseId -- | EUPL-1.2, European Union Public License 1.2 EUPL_1_2 :: LicenseId -- | Eurosym, Eurosym License Eurosym :: LicenseId -- | Fair, Fair License Fair :: LicenseId -- | Frameworx-1.0, Frameworx Open License 1.0 Frameworx_1_0 :: LicenseId -- | FreeImage, FreeImage Public License v1.0 FreeImage :: LicenseId -- | FSFAP, FSF All Permissive License FSFAP :: LicenseId -- | FSFULLR, FSF Unlimited License (with License Retention) FSFULLR :: LicenseId -- | FSFUL, FSF Unlimited License FSFUL :: LicenseId -- | FTL, Freetype Project License FTL :: LicenseId -- | GFDL-1.1-only, GNU Free Documentation License v1.1 only GFDL_1_1_only :: LicenseId -- | GFDL-1.1-or-later, GNU Free Documentation License v1.1 or -- later GFDL_1_1_or_later :: LicenseId -- | GFDL-1.2-only, GNU Free Documentation License v1.2 only GFDL_1_2_only :: LicenseId -- | GFDL-1.2-or-later, GNU Free Documentation License v1.2 or -- later GFDL_1_2_or_later :: LicenseId -- | GFDL-1.3-only, GNU Free Documentation License v1.3 only GFDL_1_3_only :: LicenseId -- | GFDL-1.3-or-later, GNU Free Documentation License v1.3 or -- later GFDL_1_3_or_later :: LicenseId -- | Giftware, Giftware License Giftware :: LicenseId -- | GL2PS, GL2PS License GL2PS :: LicenseId -- | Glide, 3dfx Glide License Glide :: LicenseId -- | Glulxe, Glulxe License Glulxe :: LicenseId -- | gnuplot, gnuplot License Gnuplot :: LicenseId -- | GPL-1.0-only, GNU General Public License v1.0 only GPL_1_0_only :: LicenseId -- | GPL-1.0-or-later, GNU General Public License v1.0 or later GPL_1_0_or_later :: LicenseId -- | GPL-2.0-only, GNU General Public License v2.0 only GPL_2_0_only :: LicenseId -- | GPL-2.0-or-later, GNU General Public License v2.0 or later GPL_2_0_or_later :: LicenseId -- | GPL-3.0-only, GNU General Public License v3.0 only GPL_3_0_only :: LicenseId -- | GPL-3.0-or-later, GNU General Public License v3.0 or later GPL_3_0_or_later :: LicenseId -- | gSOAP-1.3b, gSOAP Public License v1.3b GSOAP_1_3b :: LicenseId -- | HaskellReport, Haskell Language Report License HaskellReport :: LicenseId -- | HPND-sell-variant, Historical Permission Notice and -- Disclaimer - sell variant, SPDX License List 3.6 HPND_sell_variant :: LicenseId -- | HPND, Historical Permission Notice and Disclaimer HPND :: LicenseId -- | IBM-pibs, IBM PowerPC Initialization and Boot Software IBM_pibs :: LicenseId -- | ICU, ICU License ICU :: LicenseId -- | IJG, Independent JPEG Group License IJG :: LicenseId -- | ImageMagick, ImageMagick License ImageMagick :: LicenseId -- | iMatix, iMatix Standard Function Library Agreement IMatix :: LicenseId -- | Imlib2, Imlib2 License Imlib2 :: LicenseId -- | Info-ZIP, Info-ZIP License Info_ZIP :: LicenseId -- | Intel-ACPI, Intel ACPI Software License Agreement Intel_ACPI :: LicenseId -- | Intel, Intel Open Source License Intel :: LicenseId -- | Interbase-1.0, Interbase Public License v1.0 Interbase_1_0 :: LicenseId -- | IPA, IPA Font License IPA :: LicenseId -- | IPL-1.0, IBM Public License v1.0 IPL_1_0 :: LicenseId -- | ISC, ISC License ISC :: LicenseId -- | JasPer-2.0, JasPer License JasPer_2_0 :: LicenseId -- | JPNIC, Japan Network Information Center License, SPDX License -- List 3.6 JPNIC :: LicenseId -- | JSON, JSON License JSON :: LicenseId -- | LAL-1.2, Licence Art Libre 1.2 LAL_1_2 :: LicenseId -- | LAL-1.3, Licence Art Libre 1.3 LAL_1_3 :: LicenseId -- | Latex2e, Latex2e License Latex2e :: LicenseId -- | Leptonica, Leptonica License Leptonica :: LicenseId -- | LGPL-2.0-only, GNU Library General Public License v2 only LGPL_2_0_only :: LicenseId -- | LGPL-2.0-or-later, GNU Library General Public License v2 or -- later LGPL_2_0_or_later :: LicenseId -- | LGPL-2.1-only, GNU Lesser General Public License v2.1 only LGPL_2_1_only :: LicenseId -- | LGPL-2.1-or-later, GNU Lesser General Public License v2.1 or -- later LGPL_2_1_or_later :: LicenseId -- | LGPL-3.0-only, GNU Lesser General Public License v3.0 only LGPL_3_0_only :: LicenseId -- | LGPL-3.0-or-later, GNU Lesser General Public License v3.0 or -- later LGPL_3_0_or_later :: LicenseId -- | LGPLLR, Lesser General Public License For Linguistic -- Resources LGPLLR :: LicenseId -- | libpng-2.0, PNG Reference Library version 2, SPDX License -- List 3.6 Libpng_2_0 :: LicenseId -- | Libpng, libpng License Libpng :: LicenseId -- | libtiff, libtiff License Libtiff :: LicenseId -- | LiLiQ-P-1.1, Licence Libre du Québec – Permissive version 1.1 LiLiQ_P_1_1 :: LicenseId -- | LiLiQ-R-1.1, Licence Libre du Québec – Réciprocité version -- 1.1 LiLiQ_R_1_1 :: LicenseId -- | LiLiQ-Rplus-1.1, Licence Libre du Québec – Réciprocité forte -- version 1.1 LiLiQ_Rplus_1_1 :: LicenseId -- | Linux-OpenIB, Linux Kernel Variant of OpenIB.org license, -- SPDX License List 3.2, SPDX License List 3.6 Linux_OpenIB :: LicenseId -- | LPL-1.02, Lucent Public License v1.02 LPL_1_02 :: LicenseId -- | LPL-1.0, Lucent Public License Version 1.0 LPL_1_0 :: LicenseId -- | LPPL-1.0, LaTeX Project Public License v1.0 LPPL_1_0 :: LicenseId -- | LPPL-1.1, LaTeX Project Public License v1.1 LPPL_1_1 :: LicenseId -- | LPPL-1.2, LaTeX Project Public License v1.2 LPPL_1_2 :: LicenseId -- | LPPL-1.3a, LaTeX Project Public License v1.3a LPPL_1_3a :: LicenseId -- | LPPL-1.3c, LaTeX Project Public License v1.3c LPPL_1_3c :: LicenseId -- | MakeIndex, MakeIndex License MakeIndex :: LicenseId -- | MirOS, MirOS License MirOS :: LicenseId -- | MIT-0, MIT No Attribution, SPDX License List 3.2, SPDX -- License List 3.6 MIT_0 :: LicenseId -- | MIT-advertising, Enlightenment License (e16) MIT_advertising :: LicenseId -- | MIT-CMU, CMU License MIT_CMU :: LicenseId -- | MIT-enna, enna License MIT_enna :: LicenseId -- | MIT-feh, feh License MIT_feh :: LicenseId -- | MITNFA, MIT +no-false-attribs license MITNFA :: LicenseId -- | MIT, MIT License MIT :: LicenseId -- | Motosoto, Motosoto License Motosoto :: LicenseId -- | mpich2, mpich2 License Mpich2 :: LicenseId -- | MPL-1.0, Mozilla Public License 1.0 MPL_1_0 :: LicenseId -- | MPL-1.1, Mozilla Public License 1.1 MPL_1_1 :: LicenseId -- | MPL-2.0-no-copyleft-exception, Mozilla Public License 2.0 (no -- copyleft exception) MPL_2_0_no_copyleft_exception :: LicenseId -- | MPL-2.0, Mozilla Public License 2.0 MPL_2_0 :: LicenseId -- | MS-PL, Microsoft Public License MS_PL :: LicenseId -- | MS-RL, Microsoft Reciprocal License MS_RL :: LicenseId -- | MTLL, Matrix Template Library License MTLL :: LicenseId -- | Multics, Multics License Multics :: LicenseId -- | Mup, Mup License Mup :: LicenseId -- | NASA-1.3, NASA Open Source Agreement 1.3 NASA_1_3 :: LicenseId -- | Naumen, Naumen Public License Naumen :: LicenseId -- | NBPL-1.0, Net Boolean Public License v1 NBPL_1_0 :: LicenseId -- | NCSA, University of Illinois/NCSA Open Source License NCSA :: LicenseId -- | Net-SNMP, Net-SNMP License Net_SNMP :: LicenseId -- | NetCDF, NetCDF license NetCDF :: LicenseId -- | Newsletr, Newsletr License Newsletr :: LicenseId -- | NGPL, Nethack General Public License NGPL :: LicenseId -- | NLOD-1.0, Norwegian Licence for Open Government Data NLOD_1_0 :: LicenseId -- | NLPL, No Limit Public License NLPL :: LicenseId -- | Nokia, Nokia Open Source License Nokia :: LicenseId -- | NOSL, Netizen Open Source License NOSL :: LicenseId -- | Noweb, Noweb License Noweb :: LicenseId -- | NPL-1.0, Netscape Public License v1.0 NPL_1_0 :: LicenseId -- | NPL-1.1, Netscape Public License v1.1 NPL_1_1 :: LicenseId -- | NPOSL-3.0, Non-Profit Open Software License 3.0 NPOSL_3_0 :: LicenseId -- | NRL, NRL License NRL :: LicenseId -- | NTP, NTP License NTP :: LicenseId -- | OCCT-PL, Open CASCADE Technology Public License OCCT_PL :: LicenseId -- | OCLC-2.0, OCLC Research Public License 2.0 OCLC_2_0 :: LicenseId -- | ODbL-1.0, ODC Open Database License v1.0 ODbL_1_0 :: LicenseId -- | ODC-By-1.0, Open Data Commons Attribution License v1.0, SPDX -- License List 3.2, SPDX License List 3.6 ODC_By_1_0 :: LicenseId -- | OFL-1.0, SIL Open Font License 1.0 OFL_1_0 :: LicenseId -- | OFL-1.1, SIL Open Font License 1.1 OFL_1_1 :: LicenseId -- | OGL-UK-1.0, Open Government Licence v1.0, SPDX License List -- 3.6 OGL_UK_1_0 :: LicenseId -- | OGL-UK-2.0, Open Government Licence v2.0, SPDX License List -- 3.6 OGL_UK_2_0 :: LicenseId -- | OGL-UK-3.0, Open Government Licence v3.0, SPDX License List -- 3.6 OGL_UK_3_0 :: LicenseId -- | OGTSL, Open Group Test Suite License OGTSL :: LicenseId -- | OLDAP-1.1, Open LDAP Public License v1.1 OLDAP_1_1 :: LicenseId -- | OLDAP-1.2, Open LDAP Public License v1.2 OLDAP_1_2 :: LicenseId -- | OLDAP-1.3, Open LDAP Public License v1.3 OLDAP_1_3 :: LicenseId -- | OLDAP-1.4, Open LDAP Public License v1.4 OLDAP_1_4 :: LicenseId -- | OLDAP-2.0.1, Open LDAP Public License v2.0.1 OLDAP_2_0_1 :: LicenseId -- | OLDAP-2.0, Open LDAP Public License v2.0 (or possibly 2.0A -- and 2.0B) OLDAP_2_0 :: LicenseId -- | OLDAP-2.1, Open LDAP Public License v2.1 OLDAP_2_1 :: LicenseId -- | OLDAP-2.2.1, Open LDAP Public License v2.2.1 OLDAP_2_2_1 :: LicenseId -- | OLDAP-2.2.2, Open LDAP Public License 2.2.2 OLDAP_2_2_2 :: LicenseId -- | OLDAP-2.2, Open LDAP Public License v2.2 OLDAP_2_2 :: LicenseId -- | OLDAP-2.3, Open LDAP Public License v2.3 OLDAP_2_3 :: LicenseId -- | OLDAP-2.4, Open LDAP Public License v2.4 OLDAP_2_4 :: LicenseId -- | OLDAP-2.5, Open LDAP Public License v2.5 OLDAP_2_5 :: LicenseId -- | OLDAP-2.6, Open LDAP Public License v2.6 OLDAP_2_6 :: LicenseId -- | OLDAP-2.7, Open LDAP Public License v2.7 OLDAP_2_7 :: LicenseId -- | OLDAP-2.8, Open LDAP Public License v2.8 OLDAP_2_8 :: LicenseId -- | OML, Open Market License OML :: LicenseId -- | OpenSSL, OpenSSL License OpenSSL :: LicenseId -- | OPL-1.0, Open Public License v1.0 OPL_1_0 :: LicenseId -- | OSET-PL-2.1, OSET Public License version 2.1 OSET_PL_2_1 :: LicenseId -- | OSL-1.0, Open Software License 1.0 OSL_1_0 :: LicenseId -- | OSL-1.1, Open Software License 1.1 OSL_1_1 :: LicenseId -- | OSL-2.0, Open Software License 2.0 OSL_2_0 :: LicenseId -- | OSL-2.1, Open Software License 2.1 OSL_2_1 :: LicenseId -- | OSL-3.0, Open Software License 3.0 OSL_3_0 :: LicenseId -- | Parity-6.0.0, The Parity Public License 6.0.0, SPDX License -- List 3.6 Parity_6_0_0 :: LicenseId -- | PDDL-1.0, ODC Public Domain Dedication & License 1.0 PDDL_1_0 :: LicenseId -- | PHP-3.01, PHP License v3.01 PHP_3_01 :: LicenseId -- | PHP-3.0, PHP License v3.0 PHP_3_0 :: LicenseId -- | Plexus, Plexus Classworlds License Plexus :: LicenseId -- | PostgreSQL, PostgreSQL License PostgreSQL :: LicenseId -- | psfrag, psfrag License Psfrag :: LicenseId -- | psutils, psutils License Psutils :: LicenseId -- | Python-2.0, Python License 2.0 Python_2_0 :: LicenseId -- | Qhull, Qhull License Qhull :: LicenseId -- | QPL-1.0, Q Public License 1.0 QPL_1_0 :: LicenseId -- | Rdisc, Rdisc License Rdisc :: LicenseId -- | RHeCos-1.1, Red Hat eCos Public License v1.1 RHeCos_1_1 :: LicenseId -- | RPL-1.1, Reciprocal Public License 1.1 RPL_1_1 :: LicenseId -- | RPL-1.5, Reciprocal Public License 1.5 RPL_1_5 :: LicenseId -- | RPSL-1.0, RealNetworks Public Source License v1.0 RPSL_1_0 :: LicenseId -- | RSA-MD, RSA Message-Digest License RSA_MD :: LicenseId -- | RSCPL, Ricoh Source Code Public License RSCPL :: LicenseId -- | Ruby, Ruby License Ruby :: LicenseId -- | SAX-PD, Sax Public Domain Notice SAX_PD :: LicenseId -- | Saxpath, Saxpath License Saxpath :: LicenseId -- | SCEA, SCEA Shared Source License SCEA :: LicenseId -- | Sendmail-8.23, Sendmail License 8.23, SPDX License List 3.6 Sendmail_8_23 :: LicenseId -- | Sendmail, Sendmail License Sendmail :: LicenseId -- | SGI-B-1.0, SGI Free Software License B v1.0 SGI_B_1_0 :: LicenseId -- | SGI-B-1.1, SGI Free Software License B v1.1 SGI_B_1_1 :: LicenseId -- | SGI-B-2.0, SGI Free Software License B v2.0 SGI_B_2_0 :: LicenseId -- | SHL-0.51, Solderpad Hardware License, Version 0.51, SPDX -- License List 3.6 SHL_0_51 :: LicenseId -- | SHL-0.5, Solderpad Hardware License v0.5, SPDX License List -- 3.6 SHL_0_5 :: LicenseId -- | SimPL-2.0, Simple Public License 2.0 SimPL_2_0 :: LicenseId -- | SISSL-1.2, Sun Industry Standards Source License v1.2 SISSL_1_2 :: LicenseId -- | SISSL, Sun Industry Standards Source License v1.1 SISSL :: LicenseId -- | Sleepycat, Sleepycat License Sleepycat :: LicenseId -- | SMLNJ, Standard ML of New Jersey License SMLNJ :: LicenseId -- | SMPPL, Secure Messaging Protocol Public License SMPPL :: LicenseId -- | SNIA, SNIA Public License 1.1 SNIA :: LicenseId -- | Spencer-86, Spencer License 86 Spencer_86 :: LicenseId -- | Spencer-94, Spencer License 94 Spencer_94 :: LicenseId -- | Spencer-99, Spencer License 99 Spencer_99 :: LicenseId -- | SPL-1.0, Sun Public License v1.0 SPL_1_0 :: LicenseId -- | SSPL-1.0, Server Side Public License, v 1, SPDX License List -- 3.6 SSPL_1_0 :: LicenseId -- | SugarCRM-1.1.3, SugarCRM Public License v1.1.3 SugarCRM_1_1_3 :: LicenseId -- | SWL, Scheme Widget Library (SWL) Software License Agreement SWL :: LicenseId -- | TAPR-OHL-1.0, TAPR Open Hardware License v1.0, SPDX License -- List 3.6 TAPR_OHL_1_0 :: LicenseId -- | TCL, TCL/TK License TCL :: LicenseId -- | TCP-wrappers, TCP Wrappers License TCP_wrappers :: LicenseId -- | TMate, TMate Open Source License TMate :: LicenseId -- | TORQUE-1.1, TORQUE v2.5+ Software License v1.1 TORQUE_1_1 :: LicenseId -- | TOSL, Trusster Open Source License TOSL :: LicenseId -- | TU-Berlin-1.0, Technische Universitaet Berlin License 1.0, -- SPDX License List 3.2, SPDX License List 3.6 TU_Berlin_1_0 :: LicenseId -- | TU-Berlin-2.0, Technische Universitaet Berlin License 2.0, -- SPDX License List 3.2, SPDX License List 3.6 TU_Berlin_2_0 :: LicenseId -- | Unicode-DFS-2015, Unicode License Agreement - Data Files and -- Software (2015) Unicode_DFS_2015 :: LicenseId -- | Unicode-DFS-2016, Unicode License Agreement - Data Files and -- Software (2016) Unicode_DFS_2016 :: LicenseId -- | Unicode-TOU, Unicode Terms of Use Unicode_TOU :: LicenseId -- | Unlicense, The Unlicense Unlicense :: LicenseId -- | UPL-1.0, Universal Permissive License v1.0 UPL_1_0 :: LicenseId -- | Vim, Vim License Vim :: LicenseId -- | VOSTROM, VOSTROM Public License for Open Source VOSTROM :: LicenseId -- | VSL-1.0, Vovida Software License v1.0 VSL_1_0 :: LicenseId -- | W3C-19980720, W3C Software Notice and License (1998-07-20) W3C_19980720 :: LicenseId -- | W3C-20150513, W3C Software Notice and Document License -- (2015-05-13) W3C_20150513 :: LicenseId -- | W3C, W3C Software Notice and License (2002-12-31) W3C :: LicenseId -- | Watcom-1.0, Sybase Open Watcom Public License 1.0 Watcom_1_0 :: LicenseId -- | Wsuipa, Wsuipa License Wsuipa :: LicenseId -- | WTFPL, Do What The F*ck You Want To Public License WTFPL :: LicenseId -- | X11, X11 License X11 :: LicenseId -- | Xerox, Xerox License Xerox :: LicenseId -- | XFree86-1.1, XFree86 License 1.1 XFree86_1_1 :: LicenseId -- | xinetd, xinetd License Xinetd :: LicenseId -- | Xnet, X.Net License Xnet :: LicenseId -- | xpp, XPP License Xpp :: LicenseId -- | XSkat, XSkat License XSkat :: LicenseId -- | YPL-1.0, Yahoo! Public License v1.0 YPL_1_0 :: LicenseId -- | YPL-1.1, Yahoo! Public License v1.1 YPL_1_1 :: LicenseId -- | Zed, Zed License Zed :: LicenseId -- | Zend-2.0, Zend License v2.0 Zend_2_0 :: LicenseId -- | Zimbra-1.3, Zimbra Public License v1.3 Zimbra_1_3 :: LicenseId -- | Zimbra-1.4, Zimbra Public License v1.4 Zimbra_1_4 :: LicenseId -- | zlib-acknowledgement, zlib/libpng License with -- Acknowledgement Zlib_acknowledgement :: LicenseId -- | Zlib, zlib License Zlib :: LicenseId -- | ZPL-1.1, Zope Public License 1.1 ZPL_1_1 :: LicenseId -- | ZPL-2.0, Zope Public License 2.0 ZPL_2_0 :: LicenseId -- | ZPL-2.1, Zope Public License 2.1 ZPL_2_1 :: LicenseId -- | License SPDX identifier, e.g. "BSD-3-Clause". licenseId :: LicenseId -> String -- | License name, e.g. "GNU General Public License v2.0 only" licenseName :: LicenseId -> String -- | Whether the license is approved by Open Source Initiative (OSI). -- -- See https://opensource.org/licenses/alphabetical. licenseIsOsiApproved :: LicenseId -> Bool -- | Create a LicenseId from a String. mkLicenseId :: LicenseListVersion -> String -> Maybe LicenseId licenseIdList :: LicenseListVersion -> [LicenseId] -- | SPDX License identifier data LicenseExceptionId -- | 389-exception, 389 Directory Server Exception DS389_exception :: LicenseExceptionId -- | Autoconf-exception-2.0, Autoconf exception 2.0 Autoconf_exception_2_0 :: LicenseExceptionId -- | Autoconf-exception-3.0, Autoconf exception 3.0 Autoconf_exception_3_0 :: LicenseExceptionId -- | Bison-exception-2.2, Bison exception 2.2 Bison_exception_2_2 :: LicenseExceptionId -- | Bootloader-exception, Bootloader Distribution Exception Bootloader_exception :: LicenseExceptionId -- | Classpath-exception-2.0, Classpath exception 2.0 Classpath_exception_2_0 :: LicenseExceptionId -- | CLISP-exception-2.0, CLISP exception 2.0 CLISP_exception_2_0 :: LicenseExceptionId -- | DigiRule-FOSS-exception, DigiRule FOSS License Exception DigiRule_FOSS_exception :: LicenseExceptionId -- | eCos-exception-2.0, eCos exception 2.0 ECos_exception_2_0 :: LicenseExceptionId -- | Fawkes-Runtime-exception, Fawkes Runtime Exception Fawkes_Runtime_exception :: LicenseExceptionId -- | FLTK-exception, FLTK exception FLTK_exception :: LicenseExceptionId -- | Font-exception-2.0, Font exception 2.0 Font_exception_2_0 :: LicenseExceptionId -- | freertos-exception-2.0, FreeRTOS Exception 2.0 Freertos_exception_2_0 :: LicenseExceptionId -- | GCC-exception-2.0, GCC Runtime Library exception 2.0 GCC_exception_2_0 :: LicenseExceptionId -- | GCC-exception-3.1, GCC Runtime Library exception 3.1 GCC_exception_3_1 :: LicenseExceptionId -- | gnu-javamail-exception, GNU JavaMail exception Gnu_javamail_exception :: LicenseExceptionId -- | GPL-CC-1.0, GPL Cooperation Commitment 1.0, SPDX License List -- 3.6 GPL_CC_1_0 :: LicenseExceptionId -- | i2p-gpl-java-exception, i2p GPL+Java Exception I2p_gpl_java_exception :: LicenseExceptionId -- | Libtool-exception, Libtool Exception Libtool_exception :: LicenseExceptionId -- | Linux-syscall-note, Linux Syscall Note Linux_syscall_note :: LicenseExceptionId -- | LLVM-exception, LLVM Exception, SPDX License List 3.2, SPDX -- License List 3.6 LLVM_exception :: LicenseExceptionId -- | LZMA-exception, LZMA exception LZMA_exception :: LicenseExceptionId -- | mif-exception, Macros and Inline Functions Exception Mif_exception :: LicenseExceptionId -- | Nokia-Qt-exception-1.1, Nokia Qt LGPL exception 1.1, SPDX -- License List 3.0, SPDX License List 3.2 Nokia_Qt_exception_1_1 :: LicenseExceptionId -- | OCaml-LGPL-linking-exception, OCaml LGPL Linking Exception, -- SPDX License List 3.6 OCaml_LGPL_linking_exception :: LicenseExceptionId -- | OCCT-exception-1.0, Open CASCADE Exception 1.0 OCCT_exception_1_0 :: LicenseExceptionId -- | OpenJDK-assembly-exception-1.0, OpenJDK Assembly exception -- 1.0, SPDX License List 3.2, SPDX License List 3.6 OpenJDK_assembly_exception_1_0 :: LicenseExceptionId -- | openvpn-openssl-exception, OpenVPN OpenSSL Exception Openvpn_openssl_exception :: LicenseExceptionId -- | PS-or-PDF-font-exception-20170817, PS/PDF font exception -- (2017-08-17), SPDX License List 3.2, SPDX License List 3.6 PS_or_PDF_font_exception_20170817 :: LicenseExceptionId -- | Qt-GPL-exception-1.0, Qt GPL exception 1.0, SPDX License List -- 3.2, SPDX License List 3.6 Qt_GPL_exception_1_0 :: LicenseExceptionId -- | Qt-LGPL-exception-1.1, Qt LGPL exception 1.1, SPDX License -- List 3.2, SPDX License List 3.6 Qt_LGPL_exception_1_1 :: LicenseExceptionId -- | Qwt-exception-1.0, Qwt exception 1.0 Qwt_exception_1_0 :: LicenseExceptionId -- | Swift-exception, Swift Exception, SPDX License List 3.6 Swift_exception :: LicenseExceptionId -- | u-boot-exception-2.0, U-Boot exception 2.0 U_boot_exception_2_0 :: LicenseExceptionId -- | Universal-FOSS-exception-1.0, Universal FOSS Exception, -- Version 1.0, SPDX License List 3.6 Universal_FOSS_exception_1_0 :: LicenseExceptionId -- | WxWindows-exception-3.1, WxWindows Library Exception 3.1 WxWindows_exception_3_1 :: LicenseExceptionId -- | License SPDX identifier, e.g. "BSD-3-Clause". licenseExceptionId :: LicenseExceptionId -> String -- | License name, e.g. "GNU General Public License v2.0 only" licenseExceptionName :: LicenseExceptionId -> String -- | Create a LicenseExceptionId from a String. mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId] -- | A user defined license reference denoted by -- LicenseRef-[idstring] (for a license not on the SPDX License -- List); data LicenseRef -- | License reference. licenseRef :: LicenseRef -> String -- | Document reference. licenseDocumentRef :: LicenseRef -> Maybe String -- | Create LicenseRef from optional document ref and name. mkLicenseRef :: Maybe String -> String -> Maybe LicenseRef -- | Like mkLicenseRef but convert invalid characters into -- -. mkLicenseRef' :: Maybe String -> String -> LicenseRef -- | SPDX License List version Cabal is aware of. data LicenseListVersion LicenseListVersion_3_0 :: LicenseListVersion LicenseListVersion_3_2 :: LicenseListVersion LicenseListVersion_3_6 :: LicenseListVersion cabalSpecVersionToSPDXListVersion :: CabalSpecVersion -> LicenseListVersion -- | 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 readEOrFail :: ReadE a -> String -> a parsecToReadE :: (String -> ErrorMsg) -> ParsecParser a -> ReadE a instance GHC.Base.Functor Distribution.ReadE.ReadE -- | 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 validModuleComponent :: String -> Bool 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.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.Binary.Class.Binary Distribution.ModuleName.ModuleName instance Distribution.Utils.Structured.Structured Distribution.ModuleName.ModuleName instance Control.DeepSeq.NFData Distribution.ModuleName.ModuleName instance Distribution.Pretty.Pretty Distribution.ModuleName.ModuleName instance Distribution.Parsec.Parsec 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 instance Distribution.Utils.Structured.Structured 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 -- | Interpret a ModuleRenaming as a partial map from -- ModuleName to ModuleName. For efficiency, you should -- partially apply it with ModuleRenaming and then reuse it. interpModuleRenaming :: ModuleRenaming -> ModuleName -> Maybe ModuleName -- | 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.Utils.Structured.Structured Distribution.Types.ModuleRenaming.ModuleRenaming instance Control.DeepSeq.NFData Distribution.Types.ModuleRenaming.ModuleRenaming instance Distribution.Pretty.Pretty Distribution.Types.ModuleRenaming.ModuleRenaming instance Distribution.Parsec.Parsec 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.Utils.Structured.Structured Distribution.Types.IncludeRenaming.IncludeRenaming instance Control.DeepSeq.NFData Distribution.Types.IncludeRenaming.IncludeRenaming instance Distribution.Pretty.Pretty Distribution.Types.IncludeRenaming.IncludeRenaming instance Distribution.Parsec.Parsec Distribution.Types.IncludeRenaming.IncludeRenaming 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.Utils.Structured.Structured Distribution.Types.Mixin.Mixin instance Control.DeepSeq.NFData Distribution.Types.Mixin.Mixin instance Distribution.Pretty.Pretty Distribution.Types.Mixin.Mixin instance Distribution.Parsec.Parsec Distribution.Types.Mixin.Mixin 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.Utils.Structured.Structured Distribution.Types.ModuleReexport.ModuleReexport instance Control.DeepSeq.NFData Distribution.Types.ModuleReexport.ModuleReexport instance Distribution.Pretty.Pretty Distribution.Types.ModuleReexport.ModuleReexport instance Distribution.Parsec.Parsec Distribution.Types.ModuleReexport.ModuleReexport module Distribution.FieldGrammar.Class -- | FieldGrammar is parametrised by -- --
-- isVerboseNoWrap (modifyVerbosity (max verbose) v) == isVerboseNoWrap v ---- -- Note: you can use modifyVerbosity (const v1) v0 to -- overwrite v1's flags with v0's flags. modifyVerbosity :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity -- | Turn on verbose call-site printing when we log. verboseCallSite :: Verbosity -> Verbosity -- | Turn on verbose call-stack printing when we log. verboseCallStack :: Verbosity -> Verbosity -- | Test if we should output call sites when we log. isVerboseCallSite :: Verbosity -> Bool -- | Test if we should output call stacks when we log. isVerboseCallStack :: Verbosity -> Bool -- | Turn on -----BEGIN CABAL OUTPUT----- markers for output from -- Cabal (as opposed to GHC, or system dependent). verboseMarkOutput :: Verbosity -> Verbosity -- | Test if we should output markets. isVerboseMarkOutput :: Verbosity -> Bool -- | Turn off marking; useful for suppressing nondeterministic output. verboseUnmarkOutput :: Verbosity -> Verbosity -- | Disable line-wrapping for log messages. verboseNoWrap :: Verbosity -> Verbosity -- | Test if line-wrapping is disabled for log messages. isVerboseNoWrap :: Verbosity -> Bool -- | Turn on timestamps for log messages. verboseTimestamp :: Verbosity -> Verbosity -- | Test if if we should output timestamps when we log. isVerboseTimestamp :: Verbosity -> Bool -- | Turn off timestamps for log messages. verboseNoTimestamp :: Verbosity -> Verbosity instance GHC.Read.Read Distribution.Verbosity.Verbosity instance GHC.Show.Show Distribution.Verbosity.Verbosity instance GHC.Generics.Generic Distribution.Verbosity.Verbosity instance GHC.Classes.Eq Distribution.Verbosity.Verbosity instance GHC.Classes.Ord Distribution.Verbosity.Verbosity instance GHC.Enum.Enum Distribution.Verbosity.Verbosity instance GHC.Enum.Bounded Distribution.Verbosity.Verbosity instance Data.Binary.Class.Binary Distribution.Verbosity.Verbosity instance Distribution.Utils.Structured.Structured Distribution.Verbosity.Verbosity -- | 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 -- | Version 0. A lower bound of Version. version0 :: 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 mkVersion 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 data 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. majorBoundVersion :: 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 -- | Normalise VersionRange. -- -- In particular collapse (== v || > v) into >= -- v, and so on. normaliseVersionRange :: VersionRange -> VersionRange -- | Remove VersionRangeParens constructors. stripParensVersionRange :: VersionRange -> VersionRange -- | 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 -- | F-Algebra of VersionRange. See cataVersionRange. data VersionRangeF a AnyVersionF :: VersionRangeF a ThisVersionF :: Version -> VersionRangeF a LaterVersionF :: Version -> VersionRangeF a OrLaterVersionF :: Version -> VersionRangeF a EarlierVersionF :: Version -> VersionRangeF a OrEarlierVersionF :: Version -> VersionRangeF a WildcardVersionF :: Version -> VersionRangeF a MajorBoundVersionF :: Version -> VersionRangeF a UnionVersionRangesF :: a -> a -> VersionRangeF a IntersectVersionRangesF :: a -> a -> VersionRangeF a VersionRangeParensF :: a -> VersionRangeF a -- | Fold VersionRange. cataVersionRange :: (VersionRangeF a -> a) -> VersionRange -> a -- | Unfold VersionRange. anaVersionRange :: (a -> VersionRangeF a) -> a -> VersionRange -- | Refold VersionRange hyloVersionRange :: (VersionRangeF VersionRange -> VersionRange) -> (VersionRange -> VersionRangeF VersionRange) -> VersionRange -> VersionRange projectVersionRange :: VersionRange -> VersionRangeF VersionRange embedVersionRange :: VersionRangeF VersionRange -> VersionRange wildcardUpperBound :: Version -> Version -- | Compute next greater major version to be used as upper bound -- -- Example: 0.4.1 produces the version 0.5 which then -- can be used to construct a range >= 0.4.1 && < -- 0.5 majorUpperBound :: Version -> Version -- | 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. -- -- In Cabal-2.2 the Maybe is dropped from the result -- type. mkVersionIntervals :: [VersionInterval] -> VersionIntervals unionVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals intersectVersionIntervals :: VersionIntervals -> VersionIntervals -> VersionIntervals invertVersionIntervals :: VersionIntervals -> VersionIntervals 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.Utils.Structured.Structured Distribution.Types.TestType.TestType instance Control.DeepSeq.NFData Distribution.Types.TestType.TestType instance Distribution.Pretty.Pretty Distribution.Types.TestType.TestType instance Distribution.Parsec.Parsec 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 Distribution.Utils.Structured.Structured Distribution.Types.TestSuiteInterface.TestSuiteInterface instance Control.DeepSeq.NFData Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Base.Monoid Distribution.Types.TestSuiteInterface.TestSuiteInterface instance GHC.Base.Semigroup Distribution.Types.TestSuiteInterface.TestSuiteInterface 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.Utils.Structured.Structured Distribution.Types.PackageId.PackageIdentifier instance Distribution.Pretty.Pretty Distribution.Types.PackageId.PackageIdentifier instance Distribution.Parsec.Parsec 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: -- --
-- >>> licenseFromSPDX . licenseToSPDX $ BSD3 -- BSD3 ---- --
-- >>> licenseFromSPDX . licenseToSPDX $ GPL (Just (mkVersion [3])) -- GPL (Just (mkVersion [3])) ---- --
-- >>> licenseFromSPDX . licenseToSPDX $ PublicDomain -- UnknownLicense "LicenseRefPublicDomain" ---- --
-- >>> licenseFromSPDX $ SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1 -- UnknownLicense "EUPL-1.1" ---- --
-- >>> licenseFromSPDX . licenseToSPDX $ AllRightsReserved -- AllRightsReserved ---- --
-- >>> licenseFromSPDX <$> simpleParsec "BSD-3-Clause OR GPL-3.0-only" -- Just (UnknownLicense "BSD3ClauseORGPL30only") --licenseFromSPDX :: License -> 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.Utils.Structured.Structured Distribution.License.License instance Control.DeepSeq.NFData Distribution.License.License instance Distribution.Pretty.Pretty Distribution.License.License instance Distribution.Parsec.Parsec Distribution.License.License module Distribution.Types.InstalledPackageInfo data InstalledPackageInfo InstalledPackageInfo :: PackageId -> LibraryName -> ComponentId -> LibraryVisibility -> UnitId -> [(ModuleName, OpenModule)] -> String -> Either License License -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> AbiHash -> Bool -> Bool -> [ExposedModule] -> [ModuleName] -> Bool -> [FilePath] -> [FilePath] -> [FilePath] -> FilePath -> [String] -> [String] -> [String] -> [FilePath] -> [String] -> [UnitId] -> [AbiDependency] -> [String] -> [String] -> [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> Maybe FilePath -> InstalledPackageInfo [sourcePackageId] :: InstalledPackageInfo -> PackageId [sourceLibName] :: InstalledPackageInfo -> LibraryName [installedComponentId_] :: InstalledPackageInfo -> ComponentId [libVisibility] :: InstalledPackageInfo -> LibraryVisibility [installedUnitId] :: InstalledPackageInfo -> UnitId [instantiatedWith] :: InstalledPackageInfo -> [(ModuleName, OpenModule)] [compatPackageKey] :: InstalledPackageInfo -> String [license] :: InstalledPackageInfo -> Either License License [copyright] :: InstalledPackageInfo -> !ShortText [maintainer] :: InstalledPackageInfo -> !ShortText [author] :: InstalledPackageInfo -> !ShortText [stability] :: InstalledPackageInfo -> !ShortText [homepage] :: InstalledPackageInfo -> !ShortText [pkgUrl] :: InstalledPackageInfo -> !ShortText [synopsis] :: InstalledPackageInfo -> !ShortText [description] :: InstalledPackageInfo -> !ShortText [category] :: InstalledPackageInfo -> !ShortText [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] [cxxOptions] :: InstalledPackageInfo -> [String] [ldOptions] :: InstalledPackageInfo -> [String] [frameworkDirs] :: InstalledPackageInfo -> [FilePath] [frameworks] :: InstalledPackageInfo -> [String] [haddockInterfaces] :: InstalledPackageInfo -> [FilePath] [haddockHTMLs] :: InstalledPackageInfo -> [FilePath] [pkgRoot] :: InstalledPackageInfo -> Maybe FilePath emptyInstalledPackageInfo :: InstalledPackageInfo mungedPackageId :: InstalledPackageInfo -> MungedPackageId -- | Returns the munged package name, which we write into name for -- compatibility with old versions of GHC. mungedPackageName :: InstalledPackageInfo -> MungedPackageName -- | 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 ExposedModule ExposedModule :: ModuleName -> Maybe OpenModule -> ExposedModule [exposedName] :: ExposedModule -> ModuleName [exposedReexport] :: ExposedModule -> Maybe OpenModule instance GHC.Show.Show Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance GHC.Read.Read Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance GHC.Generics.Generic Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance GHC.Classes.Eq Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Data.Binary.Class.Binary Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Utils.Structured.Structured Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Control.DeepSeq.NFData Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.HasMungedPackageId Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.Package Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.HasUnitId Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Package.PackageInstalled Distribution.Types.InstalledPackageInfo.InstalledPackageInfo instance Distribution.Compat.Graph.IsNode Distribution.Types.InstalledPackageInfo.InstalledPackageInfo module Distribution.Types.InstalledPackageInfo.Lens data InstalledPackageInfo sourcePackageId :: Lens' InstalledPackageInfo PackageIdentifier installedUnitId :: Lens' InstalledPackageInfo UnitId installedComponentId_ :: Lens' InstalledPackageInfo ComponentId instantiatedWith :: Lens' InstalledPackageInfo [(ModuleName, OpenModule)] sourceLibName :: Lens' InstalledPackageInfo LibraryName compatPackageKey :: Lens' InstalledPackageInfo String license :: Lens' InstalledPackageInfo (Either License License) copyright :: Lens' InstalledPackageInfo ShortText maintainer :: Lens' InstalledPackageInfo ShortText author :: Lens' InstalledPackageInfo ShortText stability :: Lens' InstalledPackageInfo ShortText homepage :: Lens' InstalledPackageInfo ShortText pkgUrl :: Lens' InstalledPackageInfo ShortText synopsis :: Lens' InstalledPackageInfo ShortText description :: Lens' InstalledPackageInfo ShortText category :: Lens' InstalledPackageInfo ShortText abiHash :: Lens' InstalledPackageInfo AbiHash indefinite :: Lens' InstalledPackageInfo Bool exposed :: Lens' InstalledPackageInfo Bool exposedModules :: Lens' InstalledPackageInfo [ExposedModule] hiddenModules :: Lens' InstalledPackageInfo [ModuleName] trusted :: Lens' InstalledPackageInfo Bool importDirs :: Lens' InstalledPackageInfo [FilePath] libraryDirs :: Lens' InstalledPackageInfo [FilePath] libraryDynDirs :: Lens' InstalledPackageInfo [FilePath] dataDir :: Lens' InstalledPackageInfo FilePath hsLibraries :: Lens' InstalledPackageInfo [String] extraLibraries :: Lens' InstalledPackageInfo [String] extraGHCiLibraries :: Lens' InstalledPackageInfo [String] includeDirs :: Lens' InstalledPackageInfo [FilePath] includes :: Lens' InstalledPackageInfo [String] depends :: Lens' InstalledPackageInfo [UnitId] abiDepends :: Lens' InstalledPackageInfo [AbiDependency] ccOptions :: Lens' InstalledPackageInfo [String] cxxOptions :: Lens' InstalledPackageInfo [String] ldOptions :: Lens' InstalledPackageInfo [String] frameworkDirs :: Lens' InstalledPackageInfo [FilePath] frameworks :: Lens' InstalledPackageInfo [String] haddockInterfaces :: Lens' InstalledPackageInfo [FilePath] haddockHTMLs :: Lens' InstalledPackageInfo [FilePath] pkgRoot :: Lens' InstalledPackageInfo (Maybe FilePath) libVisibility :: Lens' InstalledPackageInfo LibraryVisibility -- | 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) Deprecated in favour of RecursiveDo. -- -- Old description: Allow recursive bindings in do blocks, using -- the rec keyword. See also RecursiveDo. DoRec :: KnownExtension -- | Allow recursive bindings in do blocks, using the rec -- keyword, or mdo, a variant of do. -- --
-- import "network" Network.Socket ---- --
-- 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. -- --
-- case compilerFlavor comp of -- GHC -> GHC.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 Eta :: 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 classifyCompilerFlavor :: String -> CompilerFlavor knownCompilerFlavors :: [CompilerFlavor] -- | PerCompilerFlavor carries only info per GHC and GHCJS -- -- Cabal parses only ghc-options and ghcjs-options, -- others are omitted. data PerCompilerFlavor v PerCompilerFlavor :: v -> v -> PerCompilerFlavor v perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)] 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 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.Data.Data v => Data.Data.Data (Distribution.Compiler.PerCompilerFlavor v) instance GHC.Classes.Eq v => GHC.Classes.Eq (Distribution.Compiler.PerCompilerFlavor v) instance GHC.Read.Read v => GHC.Read.Read (Distribution.Compiler.PerCompilerFlavor v) instance GHC.Show.Show v => GHC.Show.Show (Distribution.Compiler.PerCompilerFlavor v) instance GHC.Generics.Generic (Distribution.Compiler.PerCompilerFlavor v) 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 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.Read.Read Distribution.Compiler.CompilerInfo instance GHC.Show.Show Distribution.Compiler.CompilerInfo instance GHC.Generics.Generic Distribution.Compiler.CompilerInfo instance Data.Binary.Class.Binary Distribution.Compiler.CompilerInfo instance Data.Binary.Class.Binary Distribution.Compiler.AbiTag instance Distribution.Utils.Structured.Structured Distribution.Compiler.AbiTag instance Distribution.Pretty.Pretty Distribution.Compiler.AbiTag instance Distribution.Parsec.Parsec Distribution.Compiler.AbiTag instance Data.Binary.Class.Binary Distribution.Compiler.CompilerId instance Distribution.Utils.Structured.Structured Distribution.Compiler.CompilerId instance Control.DeepSeq.NFData Distribution.Compiler.CompilerId instance Distribution.Pretty.Pretty Distribution.Compiler.CompilerId instance Distribution.Parsec.Parsec Distribution.Compiler.CompilerId instance Data.Binary.Class.Binary a => Data.Binary.Class.Binary (Distribution.Compiler.PerCompilerFlavor a) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Compiler.PerCompilerFlavor a) instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (Distribution.Compiler.PerCompilerFlavor a) instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Distribution.Compiler.PerCompilerFlavor a) instance (GHC.Base.Semigroup a, GHC.Base.Monoid a) => GHC.Base.Monoid (Distribution.Compiler.PerCompilerFlavor a) instance Data.Binary.Class.Binary Distribution.Compiler.CompilerFlavor instance Distribution.Utils.Structured.Structured Distribution.Compiler.CompilerFlavor instance Control.DeepSeq.NFData Distribution.Compiler.CompilerFlavor instance Distribution.Pretty.Pretty Distribution.Compiler.CompilerFlavor instance Distribution.Parsec.Parsec Distribution.Compiler.CompilerFlavor module Distribution.Types.ConfVar -- | 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.ConfVar.ConfVar instance Data.Data.Data Distribution.Types.ConfVar.ConfVar instance GHC.Show.Show Distribution.Types.ConfVar.ConfVar instance GHC.Classes.Eq Distribution.Types.ConfVar.ConfVar instance Data.Binary.Class.Binary Distribution.Types.ConfVar.ConfVar instance Distribution.Utils.Structured.Structured Distribution.Types.ConfVar.ConfVar instance Control.DeepSeq.NFData Distribution.Types.ConfVar.ConfVar module Distribution.Types.BuildInfo data BuildInfo BuildInfo :: Bool -> [LegacyExeDependency] -> [ExeDependency] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [PkgconfigDependency] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> [ModuleName] -> [ModuleName] -> [ModuleName] -> Maybe Language -> [Language] -> [Extension] -> [Extension] -> [Extension] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> PerCompilerFlavor [String] -> PerCompilerFlavor [String] -> PerCompilerFlavor [String] -> PerCompilerFlavor [String] -> [(String, String)] -> [Dependency] -> [Mixin] -> BuildInfo -- | component is buildable here [buildable] :: BuildInfo -> Bool -- | Tools needed to build this bit. -- -- This is a legacy field that buildToolDepends largely -- supersedes. -- -- Unless use are very sure what you are doing, use the functions in -- Distribution.Simple.BuildToolDepends rather than accessing this -- field directly. [buildTools] :: BuildInfo -> [LegacyExeDependency] -- | Haskell tools needed to build this bit -- -- This field is better than buildTools 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 -- Distribution.Simple.BuildToolDepends rather than accessing this -- field directly. [buildToolDepends] :: BuildInfo -> [ExeDependency] -- | options for pre-processing Haskell code [cppOptions] :: BuildInfo -> [String] -- | options for assmebler [asmOptions] :: BuildInfo -> [String] -- | options for C-- compiler [cmmOptions] :: BuildInfo -> [String] -- | options for C compiler [ccOptions] :: BuildInfo -> [String] -- | options for C++ compiler [cxxOptions] :: 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] -- | Assembly files. [asmSources] :: BuildInfo -> [FilePath] -- | C-- files. [cmmSources] :: BuildInfo -> [FilePath] [cSources] :: BuildInfo -> [FilePath] [cxxSources] :: 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] -- | exposed modules that do not have a source file (e.g. GHC.Prim -- from ghc-prim package) [virtualModules] :: 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] -- | if present, adds libs to hs-libraries, which become part of the -- package. Example: the Cffi library shipping with the rts, alognside -- the HSrts-1.0.a,.o,... Example 2: a library that is being built by a -- foreing tool (e.g. rust) and copied and registered together with this -- library. The logic on how this library is built will have to be -- encoded in a custom Setup for now. Otherwise cabal would need to lear -- how to call arbitrary library builders. [extraBundledLibs] :: BuildInfo -> [String] -- | Hidden Flag. This set of strings, will be appended to all libraries -- when copying. E.g. [libHSname_flavour | flavour <- -- extraLibFlavours]. This should only be needed in very specific cases, -- e.g. the rts package, where there are multiple copies of -- slightly differently built libs. [extraLibFlavours] :: BuildInfo -> [String] -- | Hidden Flag. This set of strings will be be appended to all -- dynamic libraries when copying. This is particularly useful -- with the rts package, where we want different dynamic -- flavours of the RTS library to be installed. [extraDynLibFlavours] :: BuildInfo -> [String] [extraLibDirs] :: BuildInfo -> [String] -- | directories to find .h files [includeDirs] :: BuildInfo -> [FilePath] -- | The .h files to be found in includeDirs [includes] :: BuildInfo -> [FilePath] -- | The .h files to be generated (e.g. by autoconf) [autogenIncludes] :: BuildInfo -> [FilePath] -- | .h files to install with the package [installIncludes] :: BuildInfo -> [FilePath] [options] :: BuildInfo -> PerCompilerFlavor [String] [profOptions] :: BuildInfo -> PerCompilerFlavor [String] [sharedOptions] :: BuildInfo -> PerCompilerFlavor [String] [staticOptions] :: BuildInfo -> PerCompilerFlavor [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] -- | Whether any modules in this component use Template Haskell or Quasi -- Quotes usesTemplateHaskellOrQQ :: BuildInfo -> Bool -- | Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> BuildInfo -> [String] hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] hcSharedOptions :: CompilerFlavor -> BuildInfo -> [String] hcStaticOptions :: 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 Distribution.Utils.Structured.Structured Distribution.Types.BuildInfo.BuildInfo instance Control.DeepSeq.NFData Distribution.Types.BuildInfo.BuildInfo instance GHC.Base.Monoid Distribution.Types.BuildInfo.BuildInfo instance GHC.Base.Semigroup Distribution.Types.BuildInfo.BuildInfo 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: -- --
-- null (findDuplicateFlagAssignments fa) ==> (mkFlagAssignment . unFlagAssignment) fa == fa --unFlagAssignment :: FlagAssignment -> [(FlagName, Bool)] -- | Test whether FlagAssignment is empty. nullFlagAssignment :: FlagAssignment -> Bool -- | String representation of a flag-value pair. showFlagValue :: (FlagName, Bool) -> String -- | Remove all flag-assignments from the first FlagAssignment that -- are contained in the second FlagAssignment -- -- NB/TODO: This currently only removes flag assignments which also match -- the value assignment! We should review the code which uses this -- operation to figure out if this it's not enough to only compare the -- flagnames without the values. diffFlagAssignment :: FlagAssignment -> FlagAssignment -> FlagAssignment -- | Lookup the value for a flag -- -- Returns Nothing if the flag isn't contained in the -- FlagAssignment. lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool -- | Insert or update the boolean value of a flag. -- -- If the flag is already present in the FlagAssigment, the -- value will be updated and the fact that multiple values have been -- provided for that flag will be recorded so that a warning can be -- generated later on. insertFlagAssignment :: FlagName -> Bool -> FlagAssignment -> FlagAssignment -- | Pretty-prints a flag assignment. dispFlagAssignment :: FlagAssignment -> Doc -- | Parses a flag assignment. parsecFlagAssignment :: CabalParsing m => m FlagAssignment -- | Find the FlagNames that have been listed more than once. findDuplicateFlagAssignments :: FlagAssignment -> [FlagName] -- | 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: -- --
-- >>> :t alaList VCat -- alaList VCat :: [a] -> List VCat (Identity a) a ---- --
-- >>> :t alaList' FSep Token -- alaList' FSep Token :: [String] -> List FSep Token String --alaList :: sep -> [a] -> List sep (Identity a) a -- | More general version of alaList. alaList' :: sep -> (a -> b) -> [a] -> List sep b a -- | Vertical list with commas. Displayed with vcat data CommaVCat CommaVCat :: CommaVCat -- | Paragraph fill list with commas. Displayed with fsep data CommaFSep CommaFSep :: CommaFSep -- | Vertical list with optional commas. Displayed with vcat. data VCat VCat :: VCat -- | Paragraph fill list with optional commas. Displayed with fsep. data FSep FSep :: FSep -- | Paragraph fill list without commas. Displayed with fsep. data NoCommaFSep NoCommaFSep :: NoCommaFSep class Sep sep prettySep :: Sep sep => Proxy sep -> [Doc] -> Doc parseSep :: (Sep sep, CabalParsing m) => Proxy sep -> m a -> m [a] -- | List separated with optional commas. Displayed with sep, -- arguments of type a are parsed and pretty-printed as -- b. data List sep b a -- | alaSet and alaSet' are simply Set' constructor, -- with additional phantom arguments to constraint the resulting type -- --
-- >>> :t alaSet VCat -- alaSet VCat :: Set a -> Set' VCat (Identity a) a ---- --
-- >>> :t alaSet' FSep Token -- alaSet' FSep Token :: Set String -> Set' FSep Token String ---- --
-- >>> unpack' (alaSet' FSep Token) <$> eitherParsec "foo bar foo" -- Right (fromList ["bar","foo"]) --alaSet :: sep -> Set a -> Set' sep (Identity a) a -- | More general version of alaSet. alaSet' :: sep -> (a -> b) -> Set a -> Set' sep b a -- | Like List, but for Set. data Set' sep b a -- | Version range or just version, i.e. cabal-version field. -- -- There are few things to consider: -- --
-- xargs (32*1024) (rawSystemExit verbosity) prog fixedArgs bigArgs --xargs :: Int -> ([String] -> IO ()) -> [String] -> [String] -> IO () -- | Look for a program and try to find it's version number. It can accept -- either an absolute path or the name of a program binary, in which case -- we will look for the program on the path. findProgramVersion :: String -> (String -> String) -> Verbosity -> FilePath -> IO (Maybe Version) -- | Represents either textual or binary data passed via I/O functions -- which support binary/text mode data IOData -- | How Text gets encoded is usually locale-dependent. IODataText :: String -> IOData -- | Raw binary which gets read/written in binary mode. IODataBinary :: ByteString -> IOData class NFData mode => KnownIODataMode mode -- | IOData Wrapper for hGetContents -- -- Note: This operation uses lazy I/O. Use NFData to force -- all data to be read and consequently the internal file handle to be -- closed. hGetIODataContents :: KnownIODataMode mode => Handle -> IO mode toIOData :: KnownIODataMode mode => mode -> IOData iodataMode :: KnownIODataMode mode => IODataMode mode data IODataMode mode [IODataModeText] :: IODataMode String [IODataModeBinary] :: IODataMode ByteString -- | Same as createDirectoryIfMissing but logs at higher verbosity -- levels. createDirectoryIfMissingVerbose :: Verbosity -> Bool -> FilePath -> IO () -- | Copies a file without copying file permissions. The target file is -- created with default permissions. Any existing target file is -- replaced. -- -- At higher verbosity levels it logs an info message. copyFileVerbose :: Verbosity -> FilePath -> FilePath -> IO () -- | Copies a bunch of files to a target directory, preserving the -- directory structure in the target location. The target directories are -- created if they do not exist. -- -- The files are identified by a pair of base directory and a path -- relative to that base. It is only the relative part that is preserved -- in the destination. -- -- For example: -- --
-- copyFiles normal "dist/src" -- [("", "src/Foo.hs"), ("dist/build/", "src/Bar.hs")] ---- -- This would copy "src/Foo.hs" to "dist/src/src/Foo.hs" and copy -- "dist/build/src/Bar.hs" to "dist/src/src/Bar.hs". -- -- This operation is not atomic. Any IO failure during the copy -- (including any missing source files) leaves the target in an unknown -- state so it is best to use it with a freshly created directory so that -- it can be simply deleted if anything goes wrong. copyFiles :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO () -- | Given a relative path to a file, copy it to the given directory, -- preserving the relative path and creating the parent directories if -- needed. copyFileTo :: Verbosity -> FilePath -> FilePath -> IO () -- | 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 build -- platform. exeExtensions :: [String] -- | Find a file by looking in a search path. The file path must match -- exactly. findFileEx :: Verbosity -> [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. findModuleFileEx :: Verbosity -> [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. findModuleFilesEx :: Verbosity -> [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)] -- | 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 createTempDirectory :: FilePath -> String -> IO FilePath -- | 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 :: Verbosity -> FilePath -> IO FilePath -- | Find auxiliary package information in the given directory. Looks for -- .buildinfo files. findHookedPackageDesc :: Verbosity -> 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 () -- | Write a file but only if it would have new content. If we would be -- writing the same as the existing content then leave the file as is so -- that we do not update the file's modification time. -- -- NB: Before Cabal-3.0 the file content was assumed to be -- ASCII-representable. Since Cabal-3.0 the file is assumed to be UTF-8 -- encoded. rewriteFileEx :: Verbosity -> FilePath -> String -> IO () -- | Decode String from UTF8-encoded ByteString -- -- Invalid data in the UTF8 stream (this includes code-points -- U+D800 through U+DFFF) will be decoded as the -- replacement character (U+FFFD). fromUTF8BS :: ByteString -> String -- | Variant of fromUTF8BS for lazy ByteStrings fromUTF8LBS :: ByteString -> String -- | Encode String to to UTF8-encoded ByteString -- -- Code-points in the U+D800-U+DFFF range will be -- encoded as the replacement character (i.e. U+FFFD). toUTF8BS :: String -> ByteString -- | Variant of toUTF8BS for lazy ByteStrings toUTF8LBS :: String -> ByteString -- | 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 -- | 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: -- --
-- >>> safeTail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] -- *** Exception: Prelude.undefined -- ... ---- --
-- >>> safeTail $ 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. -- --
-- >>> 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 ", " ["Lorem", "ipsum", "dolor"] -- "Lorem, ipsum, dolor" --intercalate :: [a] -> [[a]] -> [a] -- | Lower case string -- --
-- >>> lowercase "Foobar" -- "foobar" --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] :: [Int] -- [1,2] ---- --
-- >>> ordNubRight [1,2,1] :: [Int] -- [2,1] --ordNubRight :: Ord a => [a] -> [a] -- | A total variant of head. safeHead :: [a] -> Maybe a -- | A total variant of tail. safeTail :: [a] -> [a] -- | A total variant of last. safeLast :: [a] -> Maybe a -- | A total variant of init. safeInit :: [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 -- | Deprecated: Use findFileEx instead. This symbol will be removed in -- Cabal 3.2 (est. December 2019) findFile :: [FilePath] -> FilePath -> IO FilePath -- | Deprecated: Use findModuleFileEx instead. This symbol will be -- removed in Cabal 3.2 (est. December 2019) findModuleFile :: [FilePath] -> [String] -> ModuleName -> IO (FilePath, FilePath) -- | Deprecated: Use findModuleFilesEx instead. This symbol will be -- removed in Cabal 3.2 (est. December 2019) findModuleFiles :: [FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)] 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.Generics.Generic (Distribution.Utils.NubList.NubList a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubList a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Utils.NubList.NubListR a) instance GHC.Classes.Ord a => GHC.Base.Monoid (Distribution.Utils.NubList.NubListR a) instance GHC.Classes.Ord a => GHC.Base.Semigroup (Distribution.Utils.NubList.NubListR a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Utils.NubList.NubListR a) instance (GHC.Classes.Ord a, GHC.Read.Read a) => GHC.Read.Read (Distribution.Utils.NubList.NubListR a) instance GHC.Classes.Ord a => GHC.Base.Monoid (Distribution.Utils.NubList.NubList a) instance GHC.Classes.Ord a => GHC.Base.Semigroup (Distribution.Utils.NubList.NubList a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Utils.NubList.NubList a) instance (GHC.Classes.Ord a, GHC.Read.Read a) => GHC.Read.Read (Distribution.Utils.NubList.NubList a) instance (GHC.Classes.Ord a, Data.Binary.Class.Binary a) => Data.Binary.Class.Binary (Distribution.Utils.NubList.NubList a) instance Distribution.Utils.Structured.Structured a => Distribution.Utils.Structured.Structured (Distribution.Utils.NubList.NubList a) module Distribution.Utils.LogProgress -- | The Progress monad with specialized logging and error messages. data LogProgress a -- | Run LogProgress, outputting traces according to -- Verbosity, die if there is an error. runLogProgress :: Verbosity -> LogProgress a -> 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 -- | Created : 23 July 2017 module Distribution.Simple.Program.ResponseFile withResponseFile :: Verbosity -> TempFileOptions -> FilePath -> FilePath -> Maybe TextEncoding -> [String] -> (FilePath -> IO a) -> IO a -- | 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 instance Distribution.Utils.Structured.Structured 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) -> (Maybe Version -> PackageDescription -> [String] -> [String]) -> Program -- | The simple name of the program, eg. ghc [programName] :: Program -> String -- | A function to search for the program if its location was not specified -- by the user. Usually this will just be a call to -- findProgramOnSearchPath. -- -- It is supplied with the prevailing search path which will typically -- just be used as-is, but can be extended or ignored as needed. -- -- For the purpose of change monitoring, in addition to the location -- where the program was found, it returns all the other places that were -- tried. [programFindLocation] :: Program -> Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath])) -- | Try to find the version of the program. For many programs this is not -- possible or is not necessary so it's OK to return Nothing. [programFindVersion] :: Program -> Verbosity -> FilePath -> IO (Maybe Version) -- | A function to do any additional configuration after we have located -- the program (and perhaps identified its version). For example it could -- add args, or environment vars. [programPostConf] :: Program -> Verbosity -> ConfiguredProgram -> IO ConfiguredProgram -- | A function that filters any arguments that don't impact the output -- from a commandline. Used to limit the volatility of dependency hashes -- when using new-build. [programNormaliseArgs] :: Program -> Maybe Version -> PackageDescription -> [String] -> [String] -- | A search path to use when locating executables. This is analogous to -- the unix $PATH or win32 %PATH% but with the ability -- to use the system default method for finding executables -- (findExecutable which on unix is simply looking on the -- $PATH but on win32 is a bit more complicated). -- -- The default to use is [ProgSearchPathDefault] but you can add -- extra dirs either before, after or instead of the default, e.g. here -- we add an extra dir to search after the usual ones. -- --
-- ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir] --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.ProgramLocation instance GHC.Read.Read Distribution.Simple.Program.Types.ProgramLocation instance GHC.Generics.Generic Distribution.Simple.Program.Types.ProgramLocation instance GHC.Classes.Eq Distribution.Simple.Program.Types.ProgramLocation instance GHC.Show.Show Distribution.Simple.Program.Types.ConfiguredProgram instance GHC.Read.Read Distribution.Simple.Program.Types.ConfiguredProgram instance GHC.Generics.Generic Distribution.Simple.Program.Types.ConfiguredProgram instance GHC.Classes.Eq Distribution.Simple.Program.Types.ConfiguredProgram instance GHC.Show.Show Distribution.Simple.Program.Types.Program instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ConfiguredProgram instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Types.ConfiguredProgram instance Data.Binary.Class.Binary Distribution.Simple.Program.Types.ProgramLocation instance Distribution.Utils.Structured.Structured Distribution.Simple.Program.Types.ProgramLocation -- | 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 IOData -> IOEncoding -> IOEncoding -> ProgramInvocation [progInvokePath] :: ProgramInvocation -> FilePath [progInvokeArgs] :: ProgramInvocation -> [String] [progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)] [progInvokePathEnv] :: ProgramInvocation -> [FilePath] [progInvokeCwd] :: ProgramInvocation -> Maybe FilePath [progInvokeInput] :: ProgramInvocation -> Maybe IOData -- | TODO: remove this, make user decide when constructing -- progInvokeInput. [progInvokeInputEncoding] :: ProgramInvocation -> IOEncoding [progInvokeOutputEncoding] :: ProgramInvocation -> IOEncoding data IOEncoding IOEncodingText :: IOEncoding IOEncodingUTF8 :: IOEncoding emptyProgramInvocation :: ProgramInvocation simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation -- | Like the unix xargs program. Useful for when we've got very long -- command lines that might overflow an OS limit on command line length -- and so you need to invoke a command multiple times to get all the args -- in. -- -- It takes four template invocations corresponding to the simple, -- initial, middle and last invocations. If the number of args given is -- small enough that we can get away with just a single invocation then -- the simple one is used: -- --
-- $ simple args ---- -- If the number of args given means that we need to use multiple -- invocations then the templates for the initial, middle and last -- invocations are used: -- --
-- $ initial args_0 -- $ middle args_1 -- $ middle args_2 -- ... -- $ final args_n --multiStageProgramInvocation :: ProgramInvocation -> (ProgramInvocation, ProgramInvocation, ProgramInvocation) -> [String] -> [ProgramInvocation] runProgramInvocation :: Verbosity -> ProgramInvocation -> IO () getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString getProgramInvocationOutputAndErrors :: Verbosity -> ProgramInvocation -> IO (String, String, ExitCode) -- | 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 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 () -- | Simple file globbing. module Distribution.Simple.Glob data GlobSyntaxError StarInDirectory :: GlobSyntaxError StarInFileName :: GlobSyntaxError StarInExtension :: GlobSyntaxError NoExtensionOnStar :: GlobSyntaxError EmptyGlob :: GlobSyntaxError LiteralFileNameGlobStar :: GlobSyntaxError VersionDoesNotSupportGlobStar :: GlobSyntaxError VersionDoesNotSupportGlob :: GlobSyntaxError data GlobResult a -- | The glob matched the value supplied. GlobMatch :: a -> GlobResult a -- | The glob did not match the value supplied because the cabal-version is -- too low and the extensions on the file did not precisely match the -- glob's extensions, but rather the glob was a proper suffix of the -- file's extensions; i.e., if not for the low cabal-version, it would -- have matched. GlobWarnMultiDot :: a -> GlobResult a -- | The glob couldn't match because the directory named doesn't exist. The -- directory will be as it appears in the glob (i.e., relative to the -- directory passed to matchDirFileGlob, and, for 'data-files', -- relative to 'data-dir'). GlobMissingDirectory :: FilePath -> GlobResult a -- | This will die' when the glob matches no files, or if the glob -- refers to a missing directory, or if the glob fails to parse. -- -- The Version argument must be the spec version of the package -- description being processed, as globs behave slightly differently in -- different spec versions. -- -- The first FilePath argument is the directory that the glob is -- relative to. It must be a valid directory (and hence it can't be the -- empty string). The returned values will not include this prefix. -- -- The second FilePath is the glob itself. matchDirFileGlob :: Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath] -- | Match files against a pre-parsed glob, starting in a directory. -- -- The Version argument must be the spec version of the package -- description being processed, as globs behave slightly differently in -- different spec versions. -- -- The FilePath argument is the directory that the glob is -- relative to. It must be a valid directory (and hence it can't be the -- empty string). The returned values will not include this prefix. runDirFileGlob :: Verbosity -> FilePath -> Glob -> IO [GlobResult FilePath] -- | Returns Nothing if the glob didn't match at all, or Just -- the result if the glob matched (or would have matched with a higher -- cabal-version). fileGlobMatches :: Glob -> FilePath -> Maybe (GlobResult FilePath) parseFileGlob :: Version -> FilePath -> Either GlobSyntaxError Glob explainGlobSyntaxError :: FilePath -> GlobSyntaxError -> String data Glob instance GHC.Base.Functor Distribution.Simple.Glob.GlobResult instance GHC.Classes.Ord a => GHC.Classes.Ord (Distribution.Simple.Glob.GlobResult a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Distribution.Simple.Glob.GlobResult a) instance GHC.Show.Show a => GHC.Show.Show (Distribution.Simple.Glob.GlobResult a) instance GHC.Show.Show Distribution.Simple.Glob.GlobSyntaxError instance GHC.Classes.Eq Distribution.Simple.Glob.GlobSyntaxError -- | This should be a much more sophisticated abstraction than it is. -- Currently it's just a bit of data about the compiler, like its flavour -- and name and version. The reason it's just data is because currently -- it has to be in Read and Show so it can be saved along -- with the LocalBuildInfo. The only interesting bit of info it -- contains is a mapping between language extensions and compiler command -- line flags. This module also defines a PackageDB type which is -- used to refer to package databases. Most compilers only know about a -- single global package collection but GHC has a global and per-user one -- and it lets you create arbitrary other package databases. We do not -- yet fully support this latter feature. module Distribution.Simple.Compiler data Compiler Compiler :: CompilerId -> AbiTag -> [CompilerId] -> [(Language, Flag)] -> [(Extension, Maybe 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, Maybe 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's "ar" command supports response file arguments -- (i.e. @file-style arguments). arResponseFilesSupported :: 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.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 GHC.Show.Show Distribution.Simple.Compiler.OptimisationLevel instance GHC.Read.Read Distribution.Simple.Compiler.OptimisationLevel instance GHC.Generics.Generic Distribution.Simple.Compiler.OptimisationLevel instance GHC.Classes.Eq Distribution.Simple.Compiler.OptimisationLevel instance GHC.Enum.Enum Distribution.Simple.Compiler.OptimisationLevel instance GHC.Enum.Bounded Distribution.Simple.Compiler.OptimisationLevel instance GHC.Show.Show Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Read.Read Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Generics.Generic Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Classes.Eq Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Enum.Enum Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Enum.Bounded Distribution.Simple.Compiler.DebugInfoLevel instance GHC.Read.Read Distribution.Simple.Compiler.Compiler instance GHC.Show.Show Distribution.Simple.Compiler.Compiler instance GHC.Generics.Generic Distribution.Simple.Compiler.Compiler instance GHC.Classes.Eq Distribution.Simple.Compiler.Compiler instance GHC.Show.Show Distribution.Simple.Compiler.ProfDetailLevel instance GHC.Read.Read Distribution.Simple.Compiler.ProfDetailLevel instance GHC.Generics.Generic Distribution.Simple.Compiler.ProfDetailLevel instance GHC.Classes.Eq Distribution.Simple.Compiler.ProfDetailLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.ProfDetailLevel instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.ProfDetailLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.Compiler instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.Compiler instance Data.Binary.Class.Binary Distribution.Simple.Compiler.DebugInfoLevel instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.DebugInfoLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.OptimisationLevel instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.OptimisationLevel instance Data.Binary.Class.Binary Distribution.Simple.Compiler.PackageDB instance Distribution.Utils.Structured.Structured Distribution.Simple.Compiler.PackageDB module Distribution.Simple.Program.GHC -- | A structured set of GHC options/flags -- -- Note that options containing lists fall into two categories: -- --
-- 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 () -- | GHC >= 7.6 uses the '-package-db' flag. See -- https://ghc.haskell.org/trac/ghc/ticket/5977. packageDbArgsDb :: PackageDBStack -> [String] normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String] instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcMode instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcMode instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcOptimisation instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptimisation instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcDynLinkMode instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcDynLinkMode instance GHC.Classes.Eq Distribution.Simple.Program.GHC.GhcProfAuto instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcProfAuto instance GHC.Generics.Generic Distribution.Simple.Program.GHC.GhcOptions instance GHC.Show.Show Distribution.Simple.Program.GHC.GhcOptions instance GHC.Base.Monoid Distribution.Simple.Program.GHC.GhcOptions instance GHC.Base.Semigroup Distribution.Simple.Program.GHC.GhcOptions -- | The module defines all the known built-in Programs. -- -- Where possible we try to find their version numbers. module Distribution.Simple.Program.Builtin -- | The default list of programs. These programs are typically used -- internally to Cabal. builtinPrograms :: [Program] ghcProgram :: Program ghcPkgProgram :: Program runghcProgram :: Program ghcjsProgram :: Program ghcjsPkgProgram :: Program hmakeProgram :: Program jhcProgram :: Program haskellSuiteProgram :: Program haskellSuitePkgProgram :: Program uhcProgram :: Program gccProgram :: Program arProgram :: Program stripProgram :: Program happyProgram :: Program alexProgram :: Program hsc2hsProgram :: Program c2hsProgram :: Program cpphsProgram :: Program hscolourProgram :: Program doctestProgram :: Program haddockProgram :: Program greencardProgram :: Program ldProgram :: Program tarProgram :: Program cppProgram :: Program pkgConfigProgram :: Program hpcProgram :: Program -- | This provides a ProgramDb type which holds configured and -- not-yet configured programs. It is the parameter to lots of actions -- elsewhere in Cabal that need to look up and run programs. If we had a -- Cabal monad, the ProgramDb would probably be a reader or state -- component of it. -- -- One nice thing about using it is that any program that is registered -- with Cabal will get some "configure" and ".cabal" helpers like -- --with-foo-args --foo-path= and extra-foo-args. -- -- There's also a hook for adding programs in a Setup.lhs script. See -- hookedPrograms in UserHooks. This gives a hook user the ability -- to get the above flags and such so that they don't have to write all -- the PATH logic inside Setup.lhs. module Distribution.Simple.Program.Db -- | The configuration is a collection of information about programs. It -- contains information both about configured programs and also about -- programs that we are yet to configure. -- -- The idea is that we start from a collection of unconfigured programs -- and one by one we try to configure them at which point we move them -- into the configured collection. For unconfigured programs we record -- not just the Program but also any user-provided arguments and -- location for the program. data ProgramDb 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. -- --
-- ['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 IOData -> IOEncoding -> IOEncoding -> ProgramInvocation [progInvokePath] :: ProgramInvocation -> FilePath [progInvokeArgs] :: ProgramInvocation -> [String] [progInvokeEnv] :: ProgramInvocation -> [(String, Maybe String)] [progInvokePathEnv] :: ProgramInvocation -> [FilePath] [progInvokeCwd] :: ProgramInvocation -> Maybe FilePath [progInvokeInput] :: ProgramInvocation -> Maybe IOData -- | TODO: remove this, make user decide when constructing -- progInvokeInput. [progInvokeInputEncoding] :: ProgramInvocation -> IOEncoding [progInvokeOutputEncoding] :: ProgramInvocation -> IOEncoding emptyProgramInvocation :: ProgramInvocation simpleProgramInvocation :: FilePath -> [String] -> ProgramInvocation programInvocation :: ConfiguredProgram -> [String] -> ProgramInvocation runProgramInvocation :: Verbosity -> ProgramInvocation -> IO () getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO ByteString -- | The default list of programs. These programs are typically used -- internally to Cabal. builtinPrograms :: [Program] -- | The configuration is a collection of information about programs. It -- contains information both about configured programs and also about -- programs that we are yet to configure. -- -- The idea is that we start from a collection of unconfigured programs -- and one by one we try to configure them at which point we move them -- into the configured collection. For unconfigured programs we record -- not just the Program but also any user-provided arguments and -- location for the program. data ProgramDb defaultProgramDb :: ProgramDb emptyProgramDb :: ProgramDb -- | The 'Read'\/'Show' and Binary instances do not preserve all the -- unconfigured Programs because Program is not in -- 'Read'\/'Show' because it contains functions. So to fully restore a -- deserialised ProgramDb use this function to add back all the -- known Programs. -- --
-- 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: -- --
-- --ghc-option=foo --ghc-option=bar ---- -- gives us all the values ["foo", "bar"] -- --
-- --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 instance GHC.Generics.Generic Distribution.Simple.Setup.GlobalFlags 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.CopyFlags instance GHC.Show.Show Distribution.Simple.Setup.CopyFlags instance GHC.Generics.Generic Distribution.Simple.Setup.InstallFlags instance GHC.Show.Show Distribution.Simple.Setup.InstallFlags instance GHC.Generics.Generic Distribution.Simple.Setup.SDistFlags instance GHC.Show.Show Distribution.Simple.Setup.SDistFlags instance GHC.Generics.Generic Distribution.Simple.Setup.RegisterFlags instance GHC.Show.Show Distribution.Simple.Setup.RegisterFlags instance GHC.Generics.Generic Distribution.Simple.Setup.HscolourFlags instance GHC.Show.Show Distribution.Simple.Setup.HscolourFlags instance GHC.Generics.Generic Distribution.Simple.Setup.DoctestFlags instance GHC.Show.Show Distribution.Simple.Setup.DoctestFlags 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.HaddockFlags instance GHC.Show.Show Distribution.Simple.Setup.HaddockFlags instance GHC.Generics.Generic Distribution.Simple.Setup.CleanFlags instance GHC.Show.Show Distribution.Simple.Setup.CleanFlags 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.ReplFlags instance GHC.Show.Show Distribution.Simple.Setup.ReplFlags instance GHC.Show.Show Distribution.Simple.Setup.TestShowDetails instance GHC.Generics.Generic 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.TestFlags instance GHC.Generics.Generic Distribution.Simple.Setup.BenchmarkFlags instance GHC.Show.Show Distribution.Simple.Setup.ShowBuildInfoFlags instance GHC.Base.Monoid Distribution.Simple.Setup.BenchmarkFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.BenchmarkFlags instance GHC.Base.Monoid Distribution.Simple.Setup.TestFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.TestFlags instance Data.Binary.Class.Binary Distribution.Simple.Setup.TestShowDetails instance Distribution.Utils.Structured.Structured Distribution.Simple.Setup.TestShowDetails instance Distribution.Pretty.Pretty Distribution.Simple.Setup.TestShowDetails instance Distribution.Parsec.Parsec Distribution.Simple.Setup.TestShowDetails instance GHC.Base.Monoid Distribution.Simple.Setup.TestShowDetails instance GHC.Base.Semigroup Distribution.Simple.Setup.TestShowDetails instance GHC.Base.Monoid Distribution.Simple.Setup.ReplFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.ReplFlags instance GHC.Base.Monoid Distribution.Simple.Setup.BuildFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.BuildFlags instance GHC.Base.Monoid Distribution.Simple.Setup.CleanFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.CleanFlags instance GHC.Base.Monoid Distribution.Simple.Setup.HaddockFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.HaddockFlags instance Data.Binary.Class.Binary Distribution.Simple.Setup.HaddockTarget instance Distribution.Utils.Structured.Structured Distribution.Simple.Setup.HaddockTarget instance Distribution.Pretty.Pretty Distribution.Simple.Setup.HaddockTarget instance Distribution.Parsec.Parsec Distribution.Simple.Setup.HaddockTarget instance GHC.Base.Monoid Distribution.Simple.Setup.DoctestFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.DoctestFlags instance GHC.Base.Monoid Distribution.Simple.Setup.HscolourFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.HscolourFlags instance GHC.Base.Monoid Distribution.Simple.Setup.RegisterFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.RegisterFlags instance GHC.Base.Monoid Distribution.Simple.Setup.SDistFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.SDistFlags instance GHC.Base.Monoid Distribution.Simple.Setup.InstallFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.InstallFlags instance GHC.Base.Monoid Distribution.Simple.Setup.CopyFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.CopyFlags instance Data.Binary.Class.Binary Distribution.Simple.Setup.ConfigFlags instance Distribution.Utils.Structured.Structured Distribution.Simple.Setup.ConfigFlags instance GHC.Classes.Eq Distribution.Simple.Setup.ConfigFlags instance GHC.Base.Monoid Distribution.Simple.Setup.ConfigFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.ConfigFlags instance GHC.Base.Monoid Distribution.Simple.Setup.GlobalFlags instance GHC.Base.Semigroup Distribution.Simple.Setup.GlobalFlags -- | 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) -- | 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 :: CabalParsing m => m (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 GHC.Base.Semigroup Distribution.PackageDescription.Configuration.PDTagged instance GHC.Base.Semigroup d => GHC.Base.Monoid (Distribution.PackageDescription.Configuration.DepTestRslt d) instance GHC.Base.Semigroup d => GHC.Base.Semigroup (Distribution.PackageDescription.Configuration.DepTestRslt d) -- | 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: -- --
-- buildable: True -- if os(linux) -- buildable: False ---- -- and -- --
-- if os(linux) -- buildable: False -- buildable: True ---- -- behave the same! This is the limitation of -- GeneralPackageDescription structure. -- -- So we transform the list of fields [Field ann] into a -- map of grouped ordinary fields and a list of lists of sections: -- Fields ann = Map FieldName -- [NamelessField ann] and [[Section ann]]. -- -- We need list of list of sections, because we need to distinguish -- situations where there are fields in between. For example -- --
-- if flag(bytestring-lt-0_10_4) -- build-depends: bytestring < 0.10.4 -- -- default-language: Haskell2020 -- -- else -- build-depends: bytestring >= 0.10.4 ---- -- is obviously invalid specification. -- -- We can parse Fields like we parse aeson objects, yet -- we use slightly higher-level API, so we can process unspecified -- fields, to report unknown fields and save custom x-fields. module Distribution.FieldGrammar.Parsec data ParsecFieldGrammar s a parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName] type Fields ann = Map FieldName [NamelessField ann] -- | Single field, without name, but with its annotation. data NamelessField ann MkNamelessField :: !ann -> [FieldLine ann] -> NamelessField ann namelessFieldAnn :: NamelessField ann -> ann -- | The Section constructor of Field. data Section ann MkSection :: !Name ann -> [SectionArg ann] -> [Field ann] -> Section ann runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a fieldLinesToStream :: [FieldLine ann] -> FieldLineStream instance GHC.Base.Functor Distribution.FieldGrammar.Parsec.NamelessField instance GHC.Show.Show ann => GHC.Show.Show (Distribution.FieldGrammar.Parsec.NamelessField ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.FieldGrammar.Parsec.NamelessField ann) instance GHC.Base.Functor Distribution.FieldGrammar.Parsec.Section instance GHC.Show.Show ann => GHC.Show.Show (Distribution.FieldGrammar.Parsec.Section ann) instance GHC.Classes.Eq ann => GHC.Classes.Eq (Distribution.FieldGrammar.Parsec.Section ann) instance GHC.Base.Functor (Distribution.FieldGrammar.Parsec.ParsecFieldGrammar s) instance GHC.Base.Applicative (Distribution.FieldGrammar.Parsec.ParsecFieldGrammar s) instance Distribution.FieldGrammar.Class.FieldGrammar Distribution.FieldGrammar.Parsec.ParsecFieldGrammar -- | This module provides a way to specify a grammar of .cabal -- -like files. module Distribution.FieldGrammar -- | FieldGrammar is parametrised by -- --
-- <*> monoidalFieldAla "extensions" (alaList' FSep MQuoted) oldExtensions -- ^^^ deprecatedSince [1,12] "Please use 'default-extensions' or 'other-extensions' fields." --(^^^) :: a -> (a -> b) -> b infixl 5 ^^^ -- | The Section constructor of Field. data Section ann MkSection :: !Name ann -> [SectionArg ann] -> [Field ann] -> Section ann type Fields ann = Map FieldName [NamelessField ann] -- | Partition field list into field map and groups of sections. partitionFields :: [Field ann] -> (Fields ann, [[Section ann]]) -- | Take all fields from the front. takeFields :: [Field ann] -> (Fields ann, [Field ann]) runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a -- | Default implementation for freeTextFieldDefST. defaultFreeTextFieldDefST :: (Functor (g s), FieldGrammar g) => FieldName -> ALens' s ShortText -> g s ShortText -- | GenericPackageDescription Field descriptions module Distribution.PackageDescription.FieldGrammar packageDescriptionFieldGrammar :: (FieldGrammar g, Applicative (g PackageDescription), Applicative (g PackageIdentifier)) => g PackageDescription PackageDescription libraryFieldGrammar :: (FieldGrammar g, Applicative (g Library), Applicative (g BuildInfo)) => LibraryName -> g Library Library foreignLibFieldGrammar :: (FieldGrammar g, Applicative (g ForeignLib), Applicative (g BuildInfo)) => UnqualComponentName -> g ForeignLib ForeignLib executableFieldGrammar :: (FieldGrammar g, Applicative (g Executable), Applicative (g BuildInfo)) => UnqualComponentName -> g Executable Executable -- | 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 testSuiteFieldGrammar :: (FieldGrammar g, Applicative (g TestSuiteStanza), Applicative (g BuildInfo)) => g TestSuiteStanza TestSuiteStanza validateTestSuite :: Position -> TestSuiteStanza -> ParseResult TestSuite unvalidateTestSuite :: TestSuite -> TestSuiteStanza testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType) testStanzaMainIs :: Lens' TestSuiteStanza (Maybe FilePath) testStanzaTestModule :: Lens' TestSuiteStanza (Maybe ModuleName) testStanzaBuildInfo :: Lens' 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 benchmarkFieldGrammar :: (FieldGrammar g, Applicative (g BenchmarkStanza), Applicative (g BuildInfo)) => g BenchmarkStanza BenchmarkStanza validateBenchmark :: Position -> BenchmarkStanza -> ParseResult Benchmark unvalidateBenchmark :: Benchmark -> BenchmarkStanza benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType) benchmarkStanzaMainIs :: Lens' BenchmarkStanza (Maybe FilePath) benchmarkStanzaBenchmarkModule :: Lens' BenchmarkStanza (Maybe ModuleName) benchmarkStanzaBuildInfo :: Lens' BenchmarkStanza BuildInfo flagFieldGrammar :: (FieldGrammar g, Applicative (g Flag)) => FlagName -> g Flag Flag sourceRepoFieldGrammar :: (FieldGrammar g, Applicative (g SourceRepo)) => RepoKind -> g SourceRepo SourceRepo setupBInfoFieldGrammar :: (FieldGrammar g, Functor (g SetupBuildInfo)) => Bool -> g SetupBuildInfo SetupBuildInfo buildInfoFieldGrammar :: (FieldGrammar g, Applicative (g BuildInfo)) => g BuildInfo BuildInfo instance Distribution.Types.BuildInfo.Lens.HasBuildInfo Distribution.PackageDescription.FieldGrammar.BenchmarkStanza instance Distribution.Types.BuildInfo.Lens.HasBuildInfo Distribution.PackageDescription.FieldGrammar.TestSuiteStanza -- | 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 -- | Convert a generic package description to PrettyFields. ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()] writePackageDescription :: FilePath -> PackageDescription -> NoCallStackIO () showPackageDescription :: PackageDescription -> String writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> NoCallStackIO () showHookedBuildInfo :: HookedBuildInfo -> String -- | This defined parsers and partial pretty printers for the -- .cabal format. module Distribution.PackageDescription.Parsec -- | 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 :: ByteString -> ParseResult GenericPackageDescription -- | Maybe variant of parseGenericPackageDescription parseGenericPackageDescriptionMaybe :: ByteString -> Maybe GenericPackageDescription -- | A monad with failure and accumulating errors and warnings. data ParseResult a -- | Destruct a ParseResult into the emitted warnings and either a -- successful value or list of errors and possibly recovered a -- spec-version declaration. runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a) -- | Quickly scan new-style spec-version -- -- A new-style spec-version declaration begins the .cabal file and follow -- the following case-insensitive grammar (expressed in RFC5234 ABNF): -- --
-- newstyle-spec-version-decl = "cabal-version" *WS ":" *WS newstyle-pec-version *WS -- -- spec-version = NUM "." NUM [ "." NUM ] -- -- NUM = DIGIT0 / DIGITP 1*DIGIT0 -- DIGIT0 = %x30-39 -- DIGITP = %x31-39 -- WS = %20 --scanSpecVersion :: ByteString -> Maybe Version readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo parseHookedBuildInfo :: ByteString -> ParseResult HookedBuildInfo instance GHC.Show.Show Distribution.PackageDescription.Parsec.Syntax instance GHC.Classes.Eq Distribution.PackageDescription.Parsec.Syntax instance Distribution.PackageDescription.Parsec.FromBuildInfo Distribution.Types.BuildInfo.BuildInfo instance Distribution.PackageDescription.Parsec.FromBuildInfo Distribution.Types.ForeignLib.ForeignLib instance Distribution.PackageDescription.Parsec.FromBuildInfo Distribution.Types.Executable.Executable instance Distribution.PackageDescription.Parsec.FromBuildInfo Distribution.PackageDescription.FieldGrammar.TestSuiteStanza instance Distribution.PackageDescription.Parsec.FromBuildInfo Distribution.PackageDescription.FieldGrammar.BenchmarkStanza module Distribution.FieldGrammar.FieldDescrs -- | A collection field parsers and pretty-printers. data FieldDescrs s a -- | Lookup a field value pretty-printer. fieldDescrPretty :: FieldDescrs s a -> FieldName -> Maybe (s -> Doc) -- | Lookup a field value parser. fieldDescrParse :: CabalParsing m => FieldDescrs s a -> FieldName -> Maybe (s -> m s) fieldDescrsToList :: CabalParsing m => FieldDescrs s a -> [(FieldName, s -> Doc, s -> m s)] instance GHC.Base.Functor (Distribution.FieldGrammar.FieldDescrs.FieldDescrs s) instance GHC.Base.Applicative (Distribution.FieldGrammar.FieldDescrs.FieldDescrs s) instance Distribution.FieldGrammar.Class.FieldGrammar Distribution.FieldGrammar.FieldDescrs.FieldDescrs module Distribution.Types.InstalledPackageInfo.FieldGrammar ipiFieldGrammar :: (FieldGrammar g, Applicative (g InstalledPackageInfo), Applicative (g Basic)) => g InstalledPackageInfo InstalledPackageInfo instance Distribution.Compat.Newtype.Newtype (Data.Either.Either Distribution.SPDX.License.License Distribution.License.License) Distribution.Types.InstalledPackageInfo.FieldGrammar.SpecLicenseLenient instance Distribution.Parsec.Parsec Distribution.Types.InstalledPackageInfo.FieldGrammar.SpecLicenseLenient instance Distribution.Pretty.Pretty Distribution.Types.InstalledPackageInfo.FieldGrammar.SpecLicenseLenient instance Distribution.Compat.Newtype.Newtype [(Distribution.ModuleName.ModuleName, Distribution.Backpack.OpenModule)] Distribution.Types.InstalledPackageInfo.FieldGrammar.InstWith instance Distribution.Pretty.Pretty Distribution.Types.InstalledPackageInfo.FieldGrammar.InstWith instance Distribution.Parsec.Parsec Distribution.Types.InstalledPackageInfo.FieldGrammar.InstWith instance Distribution.Compat.Newtype.Newtype GHC.Base.String Distribution.Types.InstalledPackageInfo.FieldGrammar.CompatPackageKey instance Distribution.Pretty.Pretty Distribution.Types.InstalledPackageInfo.FieldGrammar.CompatPackageKey instance Distribution.Parsec.Parsec Distribution.Types.InstalledPackageInfo.FieldGrammar.CompatPackageKey instance Distribution.Compat.Newtype.Newtype [Distribution.Types.ExposedModule.ExposedModule] Distribution.Types.InstalledPackageInfo.FieldGrammar.ExposedModules instance Distribution.Parsec.Parsec Distribution.Types.InstalledPackageInfo.FieldGrammar.ExposedModules instance Distribution.Pretty.Pretty Distribution.Types.InstalledPackageInfo.FieldGrammar.ExposedModules -- | 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 -> LibraryName -> ComponentId -> LibraryVisibility -> UnitId -> [(ModuleName, OpenModule)] -> String -> Either License License -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> !ShortText -> AbiHash -> Bool -> Bool -> [ExposedModule] -> [ModuleName] -> Bool -> [FilePath] -> [FilePath] -> [FilePath] -> FilePath -> [String] -> [String] -> [String] -> [FilePath] -> [String] -> [UnitId] -> [AbiDependency] -> [String] -> [String] -> [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> Maybe FilePath -> InstalledPackageInfo [sourcePackageId] :: InstalledPackageInfo -> PackageId [sourceLibName] :: InstalledPackageInfo -> LibraryName [installedComponentId_] :: InstalledPackageInfo -> ComponentId [libVisibility] :: InstalledPackageInfo -> LibraryVisibility [installedUnitId] :: InstalledPackageInfo -> UnitId [instantiatedWith] :: InstalledPackageInfo -> [(ModuleName, OpenModule)] [compatPackageKey] :: InstalledPackageInfo -> String [license] :: InstalledPackageInfo -> Either License License [copyright] :: InstalledPackageInfo -> !ShortText [maintainer] :: InstalledPackageInfo -> !ShortText [author] :: InstalledPackageInfo -> !ShortText [stability] :: InstalledPackageInfo -> !ShortText [homepage] :: InstalledPackageInfo -> !ShortText [pkgUrl] :: InstalledPackageInfo -> !ShortText [synopsis] :: InstalledPackageInfo -> !ShortText [description] :: InstalledPackageInfo -> !ShortText [category] :: InstalledPackageInfo -> !ShortText [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] [cxxOptions] :: InstalledPackageInfo -> [String] [ldOptions] :: InstalledPackageInfo -> [String] [frameworkDirs] :: InstalledPackageInfo -> [FilePath] [frameworks] :: InstalledPackageInfo -> [String] [haddockInterfaces] :: InstalledPackageInfo -> [FilePath] [haddockHTMLs] :: InstalledPackageInfo -> [FilePath] [pkgRoot] :: InstalledPackageInfo -> Maybe FilePath 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 emptyInstalledPackageInfo :: InstalledPackageInfo -- | Return either errors, or IPI with list of warnings parseInstalledPackageInfo :: ByteString -> Either (NonEmpty String) ([String], InstalledPackageInfo) -- | Pretty print InstalledPackageInfo. -- -- pkgRoot isn't printed, as ghc-pkg prints it manually (as -- GHC-8.4). showInstalledPackageInfo :: InstalledPackageInfo -> String -- | The variant of showInstalledPackageInfo which outputs -- pkgroot field too. showFullInstalledPackageInfo :: InstalledPackageInfo -> String -- |
-- >>> let ipi = emptyInstalledPackageInfo { maintainer = "Tester" } -- -- >>> fmap ($ ipi) $ showInstalledPackageInfoField "maintainer" -- Just "maintainer: Tester" --showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) module Distribution.Types.ComponentLocalBuildInfo -- | The first five fields are common across all algebraic variants. data ComponentLocalBuildInfo LibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> Bool -> [(ModuleName, OpenModule)] -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> String -> MungedPackageName -> [ExposedModule] -> Bool -> ComponentLocalBuildInfo -- | It would be very convenient to store the literal Library here, but if -- we do that, it will get serialized (via the Binary) instance twice. So -- instead we just provide the ComponentName, which can be used to find -- the Component in the PackageDescription. NB: eventually, this will NOT -- uniquely identify the ComponentLocalBuildInfo. [componentLocalName] :: ComponentLocalBuildInfo -> ComponentName -- | The computed ComponentId of this component. [componentComponentId] :: ComponentLocalBuildInfo -> ComponentId -- | The computed UnitId which uniquely identifies this component. -- Might be hashed. [componentUnitId] :: ComponentLocalBuildInfo -> UnitId -- | Is this an indefinite component (i.e. has unfilled holes)? [componentIsIndefinite_] :: ComponentLocalBuildInfo -> Bool -- | How the component was instantiated [componentInstantiatedWith] :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)] -- | Resolved internal and external package dependencies for this -- component. The BuildInfo specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This field fixes -- those dependencies to the specific versions available on this machine -- for this compiler. [componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)] -- | The set of packages that are brought into scope during compilation, -- including a ModuleRenaming which may used to hide or rename -- modules. This is what gets translated into -package-id -- arguments. This is a modernized version of -- componentPackageDeps, which is kept around for BC purposes. [componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] [componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | The internal dependencies which induce a graph on the -- ComponentLocalBuildInfo of this package. This does NOT coincide -- with componentPackageDeps because it ALSO records 'build-tool' -- dependencies on executables. Maybe one day cabal-install will -- also handle these correctly too! [componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | Compatibility "package key" that we pass to older versions of GHC. [componentCompatPackageKey] :: ComponentLocalBuildInfo -> String -- | Compatibility "package name" that we register this component as. [componentCompatPackageName] :: ComponentLocalBuildInfo -> MungedPackageName -- | A list of exposed modules (either defined in this component, or -- reexported from another component.) [componentExposedModules] :: ComponentLocalBuildInfo -> [ExposedModule] -- | Convenience field, specifying whether or not this is the "public -- library" that has the same name as the package. [componentIsPublic] :: ComponentLocalBuildInfo -> Bool FLibComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo -- | It would be very convenient to store the literal Library here, but if -- we do that, it will get serialized (via the Binary) instance twice. So -- instead we just provide the ComponentName, which can be used to find -- the Component in the PackageDescription. NB: eventually, this will NOT -- uniquely identify the ComponentLocalBuildInfo. [componentLocalName] :: ComponentLocalBuildInfo -> ComponentName -- | The computed ComponentId of this component. [componentComponentId] :: ComponentLocalBuildInfo -> ComponentId -- | The computed UnitId which uniquely identifies this component. -- Might be hashed. [componentUnitId] :: ComponentLocalBuildInfo -> UnitId -- | Resolved internal and external package dependencies for this -- component. The BuildInfo specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This field fixes -- those dependencies to the specific versions available on this machine -- for this compiler. [componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)] -- | The set of packages that are brought into scope during compilation, -- including a ModuleRenaming which may used to hide or rename -- modules. This is what gets translated into -package-id -- arguments. This is a modernized version of -- componentPackageDeps, which is kept around for BC purposes. [componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] [componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | The internal dependencies which induce a graph on the -- ComponentLocalBuildInfo of this package. This does NOT coincide -- with componentPackageDeps because it ALSO records 'build-tool' -- dependencies on executables. Maybe one day cabal-install will -- also handle these correctly too! [componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId] ExeComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo -- | It would be very convenient to store the literal Library here, but if -- we do that, it will get serialized (via the Binary) instance twice. So -- instead we just provide the ComponentName, which can be used to find -- the Component in the PackageDescription. NB: eventually, this will NOT -- uniquely identify the ComponentLocalBuildInfo. [componentLocalName] :: ComponentLocalBuildInfo -> ComponentName -- | The computed ComponentId of this component. [componentComponentId] :: ComponentLocalBuildInfo -> ComponentId -- | The computed UnitId which uniquely identifies this component. -- Might be hashed. [componentUnitId] :: ComponentLocalBuildInfo -> UnitId -- | Resolved internal and external package dependencies for this -- component. The BuildInfo specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This field fixes -- those dependencies to the specific versions available on this machine -- for this compiler. [componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)] -- | The set of packages that are brought into scope during compilation, -- including a ModuleRenaming which may used to hide or rename -- modules. This is what gets translated into -package-id -- arguments. This is a modernized version of -- componentPackageDeps, which is kept around for BC purposes. [componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] [componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | The internal dependencies which induce a graph on the -- ComponentLocalBuildInfo of this package. This does NOT coincide -- with componentPackageDeps because it ALSO records 'build-tool' -- dependencies on executables. Maybe one day cabal-install will -- also handle these correctly too! [componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId] TestComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo -- | It would be very convenient to store the literal Library here, but if -- we do that, it will get serialized (via the Binary) instance twice. So -- instead we just provide the ComponentName, which can be used to find -- the Component in the PackageDescription. NB: eventually, this will NOT -- uniquely identify the ComponentLocalBuildInfo. [componentLocalName] :: ComponentLocalBuildInfo -> ComponentName -- | The computed ComponentId of this component. [componentComponentId] :: ComponentLocalBuildInfo -> ComponentId -- | The computed UnitId which uniquely identifies this component. -- Might be hashed. [componentUnitId] :: ComponentLocalBuildInfo -> UnitId -- | Resolved internal and external package dependencies for this -- component. The BuildInfo specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This field fixes -- those dependencies to the specific versions available on this machine -- for this compiler. [componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)] -- | The set of packages that are brought into scope during compilation, -- including a ModuleRenaming which may used to hide or rename -- modules. This is what gets translated into -package-id -- arguments. This is a modernized version of -- componentPackageDeps, which is kept around for BC purposes. [componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] [componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | The internal dependencies which induce a graph on the -- ComponentLocalBuildInfo of this package. This does NOT coincide -- with componentPackageDeps because it ALSO records 'build-tool' -- dependencies on executables. Maybe one day cabal-install will -- also handle these correctly too! [componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId] BenchComponentLocalBuildInfo :: ComponentName -> ComponentId -> UnitId -> [(UnitId, MungedPackageId)] -> [(OpenUnitId, ModuleRenaming)] -> [UnitId] -> [UnitId] -> ComponentLocalBuildInfo -- | It would be very convenient to store the literal Library here, but if -- we do that, it will get serialized (via the Binary) instance twice. So -- instead we just provide the ComponentName, which can be used to find -- the Component in the PackageDescription. NB: eventually, this will NOT -- uniquely identify the ComponentLocalBuildInfo. [componentLocalName] :: ComponentLocalBuildInfo -> ComponentName -- | The computed ComponentId of this component. [componentComponentId] :: ComponentLocalBuildInfo -> ComponentId -- | The computed UnitId which uniquely identifies this component. -- Might be hashed. [componentUnitId] :: ComponentLocalBuildInfo -> UnitId -- | Resolved internal and external package dependencies for this -- component. The BuildInfo specifies a set of build dependencies -- that must be satisfied in terms of version ranges. This field fixes -- those dependencies to the specific versions available on this machine -- for this compiler. [componentPackageDeps] :: ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)] -- | The set of packages that are brought into scope during compilation, -- including a ModuleRenaming which may used to hide or rename -- modules. This is what gets translated into -package-id -- arguments. This is a modernized version of -- componentPackageDeps, which is kept around for BC purposes. [componentIncludes] :: ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] [componentExeDeps] :: ComponentLocalBuildInfo -> [UnitId] -- | The internal dependencies which induce a graph on the -- ComponentLocalBuildInfo of this package. This does NOT coincide -- with componentPackageDeps because it ALSO records 'build-tool' -- dependencies on executables. Maybe one day cabal-install will -- also handle these correctly too! [componentInternalDeps] :: ComponentLocalBuildInfo -> [UnitId] componentIsIndefinite :: ComponentLocalBuildInfo -> Bool maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)] instance GHC.Show.Show Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo instance GHC.Read.Read Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo instance GHC.Generics.Generic Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo instance Data.Binary.Class.Binary Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo instance Distribution.Utils.Structured.Structured Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo instance Distribution.Compat.Graph.IsNode Distribution.Types.ComponentLocalBuildInfo.ComponentLocalBuildInfo module Distribution.Types.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 -- | This module provides an library interface to the hc-pkg -- program. Currently only GHC and GHCJS have hc-pkg programs. module Distribution.Simple.Program.HcPkg -- | Information about the features and capabilities of an hc-pkg -- program. data HcPkgInfo HcPkgInfo :: ConfiguredProgram -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> HcPkgInfo [hcPkgProgram] :: HcPkgInfo -> ConfiguredProgram -- | no package DB stack supported [noPkgDbStack] :: HcPkgInfo -> Bool -- | hc-pkg does not support verbosity flags [noVerboseFlag] :: HcPkgInfo -> Bool -- | use package-conf option instead of package-db [flagPackageConf] :: HcPkgInfo -> Bool -- | supports directory style package databases [supportsDirDbs] :: HcPkgInfo -> Bool -- | requires directory style package databases [requiresDirDbs] :: HcPkgInfo -> Bool -- | supports --enable-multi-instance flag [nativeMultiInstance] :: HcPkgInfo -> Bool -- | supports multi-instance via recache [recacheMultiInstance] :: HcPkgInfo -> Bool -- | supports --force-files or equivalent [suppressFilesCheck] :: HcPkgInfo -> Bool -- | Additional variations in the behaviour for register. data RegisterOptions RegisterOptions :: Bool -> Bool -> Bool -> RegisterOptions -- | Allows re-registering / overwriting an existing package [registerAllowOverwrite] :: RegisterOptions -> Bool -- | Insist on the ability to register multiple instances of a single -- version of a single package. This will fail if the hc-pkg -- does not support it, see nativeMultiInstance and -- recacheMultiInstance. [registerMultiInstance] :: RegisterOptions -> Bool -- | Require that no checks are performed on the existence of package files -- mentioned in the registration info. This must be used if registering -- prior to putting the files in their final place. This will fail if the -- hc-pkg does not support it, see suppressFilesCheck. [registerSuppressFilesCheck] :: RegisterOptions -> Bool -- | Defaults are True, False and False defaultRegisterOptions :: RegisterOptions -- | Call hc-pkg to initialise a package database at the location -- {path}. -- --
-- hc-pkg init {path} --init :: HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO () -- | Run hc-pkg using a given package DB stack, directly -- forwarding the provided command-line arguments to it. invoke :: HcPkgInfo -> Verbosity -> 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 -- | 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: -- --
-- $ 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 -- | 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 -- |
-- 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. generateCabalMacrosHeader :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String -- | Helper function that generates just the VERSION_pkg and -- MIN_VERSION_pkg macros for a list of package ids (usually -- used with the specific deps of a configured package). generatePackageVersionMacros :: Version -> [PackageId] -> String -- | See -- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst module Distribution.Backpack.ConfiguredComponent -- | A configured component, we know exactly what its ComponentId -- is, and the ComponentIds of the things it depends on. data ConfiguredComponent ConfiguredComponent :: AnnotatedId ComponentId -> Component -> Bool -> [AnnotatedId ComponentId] -> [ComponentInclude ComponentId IncludeRenaming] -> ConfiguredComponent -- | Unique identifier of component, plus extra useful info. [cc_ann_id] :: ConfiguredComponent -> AnnotatedId ComponentId -- | The fragment of syntax from the Cabal file describing this component. [cc_component] :: ConfiguredComponent -> Component -- | Is this the public library component of the package? (If we invoke -- Setup with an instantiation, this is the component the instantiation -- applies to.) Note that in one-component configure mode, this is always -- True, because any component is the "public" one.) [cc_public] :: ConfiguredComponent -> Bool -- | Dependencies on executables from build-tools and -- build-tool-depends. [cc_exe_deps] :: ConfiguredComponent -> [AnnotatedId ComponentId] -- | The mixins of this package, including both explicit (from the -- mixins field) and implicit (from build-depends). Not -- mix-in linked yet; component configuration only looks at -- ComponentIds. [cc_includes] :: ConfiguredComponent -> [ComponentInclude ComponentId IncludeRenaming] -- | The ComponentName of a component; this uniquely identifies a -- fragment of syntax within a specified Cabal file describing the -- component. cc_name :: ConfiguredComponent -> ComponentName -- | Uniquely identifies a configured component. cc_cid :: ConfiguredComponent -> ComponentId -- | The package this component came from. cc_pkgid :: ConfiguredComponent -> PackageId toConfiguredComponent :: PackageDescription -> ComponentId -> ConfiguredComponentMap -> ConfiguredComponentMap -> Component -> LogProgress ConfiguredComponent toConfiguredComponents :: Bool -> FlagAssignment -> Bool -> Flag String -> Flag ComponentId -> PackageDescription -> ConfiguredComponentMap -> [Component] -> LogProgress [ConfiguredComponent] -- | Pretty-print a ConfiguredComponent. dispConfiguredComponent :: ConfiguredComponent -> Doc type ConfiguredComponentMap = Map PackageName (Map ComponentName (AnnotatedId ComponentId)) extendConfiguredComponentMap :: ConfiguredComponent -> ConfiguredComponentMap -> ConfiguredComponentMap newPackageDepsBehaviour :: PackageDescription -> Bool -- | See -- https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst module Distribution.Backpack.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.HaskellSuite configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version) numericVersion :: Verbosity -> FilePath -> IO (Maybe Version) getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version) getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe 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 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 -> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex -- | Get the packages from specific PackageDBs, not cumulative. 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 :: [String] -> Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () replFLib :: [String] -> Verbosity -> Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> ForeignLib -> ComponentLocalBuildInfo -> IO () replExe :: [String] -> 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 GHCJS. installExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> (FilePath, FilePath) -> PackageDescription -> Executable -> IO () -- | Extracts a String representing a hash of the ABI of a built library. -- It can fail if the library has not yet been built. libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO String hcPkgInfo :: ProgramDb -> HcPkgInfo registerPackage :: Verbosity -> ProgramDb -> 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 -- | Get the JavaScript file name and command and arguments to run a -- program compiled by GHCJS the exe should be the base program name -- without exe extension runCmd :: ProgramDb -> FilePath -> (FilePath, FilePath, [String]) -- | The kinds of entries we can stick in a .ghc.environment file. data GhcEnvironmentFileEntry -- |
-- -- 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] -- | Render a bunch of GHC environment file entries renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry] -> String -- | Write a .ghc.environment-$arch-$os-$ver file in the given -- directory. -- -- The Platform and GHC Version are needed as part of the -- file name. -- -- Returns the name of the file written. writeGhcEnvironmentFile :: FilePath -> Platform -> Version -> [GhcEnvironmentFileEntry] -> NoCallStackIO FilePath -- | GHC's rendering of its platform and compiler version string as used in -- certain file locations (such as user package db location). For example -- x86_64-linux-7.10.4 ghcPlatformAndVersionString :: Platform -> Version -> String readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry] parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry] newtype ParseErrorExc ParseErrorExc :: ParseError -> ParseErrorExc getImplInfo :: Compiler -> GhcImplInfo -- | Information about features and quirks of a GHC-based implementation. -- -- Compiler flavors based on GHC behave similarly enough that some of the -- support code for them is shared. Every implementation has its own -- peculiarities, that may or may not be a direct result of the -- underlying GHC version. This record keeps track of these differences. -- -- All shared code (i.e. everything not in the Distribution.Simple.FLAVOR -- module) should use implementation info rather than version numbers to -- test for supported features. data GhcImplInfo GhcImplInfo :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> GhcImplInfo -- |
-- -- 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] -- | Render a bunch of GHC environment file entries renderGhcEnvironmentFile :: [GhcEnvironmentFileEntry] -> String -- | Write a .ghc.environment-$arch-$os-$ver file in the given -- directory. -- -- The Platform and GHC Version are needed as part of the -- file name. -- -- Returns the name of the file written. writeGhcEnvironmentFile :: FilePath -> Platform -> Version -> [GhcEnvironmentFileEntry] -> NoCallStackIO FilePath -- | GHC's rendering of its platform and compiler version string as used in -- certain file locations (such as user package db location). For example -- x86_64-linux-7.10.4 ghcPlatformAndVersionString :: Platform -> Version -> String readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry] parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry] newtype ParseErrorExc ParseErrorExc :: ParseError -> ParseErrorExc getImplInfo :: Compiler -> GhcImplInfo -- | Information about features and quirks of a GHC-based implementation. -- -- Compiler flavors based on GHC behave similarly enough that some of the -- support code for them is shared. Every implementation has its own -- peculiarities, that may or may not be a direct result of the -- underlying GHC version. This record keeps track of these differences. -- -- All shared code (i.e. everything not in the Distribution.Simple.FLAVOR -- module) should use implementation info rather than version numbers to -- test for supported features. data GhcImplInfo GhcImplInfo :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> GhcImplInfo -- |
-- { "cabal-version": "1.23.0.0", -- "compiler": { -- "flavour": GHC, -- "compiler-id": "ghc-7.10.2", -- "path": "usrbin/ghc", -- }, -- "components": [ -- { "type": "lib", -- "name": "lib:Cabal", -- "compiler-args": -- ["-O", "-XHaskell98", "-Wall", -- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"] -- "modules": [Project.ModA, Project.ModB, Paths_project], -- "src-files": [], -- "src-dirs": ["src"] -- } -- ] -- } ---- -- The cabal-version property provides the version of the Cabal -- library which generated the output. The compiler property -- gives some basic information about the compiler Cabal would use to -- compile the package. -- -- The components property gives a list of the Cabal -- Components defined by the package. Each has, -- --
-- 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. -- --
-- 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] instance GHC.Show.Show Distribution.Simple.Configure.ConfigStateFileError instance GHC.Exception.Type.Exception Distribution.Simple.Configure.ConfigStateFileError -- | This handles the sdist command. The module exports an -- sdist action but also some of the phases that make it up so -- that other tools can use just the bits they need. In particular the -- preparation of the tree of files to go into the source tarball is -- separated from actually building the source tarball. -- -- The createArchive action uses the external tar program -- and assumes that it accepts the -z flag. Neither of these -- assumptions are valid on Windows. The sdist action now also -- does some distribution QA checks. module Distribution.Simple.SrcDist -- | Create a source distribution. sdist :: PackageDescription -> Maybe LocalBuildInfo -> SDistFlags -> (FilePath -> FilePath) -> [PPSuffixHandler] -> IO () -- | Note: must be called with the CWD set to the directory containing the -- '.cabal' file. printPackageProblems :: Verbosity -> PackageDescription -> IO () -- | Prepare a directory tree of source files. prepareTree :: Verbosity -> 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 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 () showBuildInfo :: PackageDescription -> LocalBuildInfo -> BuildFlags -> IO String 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 () -- | Initialize a new package db file for libraries defined internally to -- the package. createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath -> IO PackageDB -- | 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 FilePath)], Maybe String) 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.Generics.Generic Distribution.Simple.Haddock.HaddockArgs instance GHC.Base.Monoid Distribution.Simple.Haddock.HaddockArgs instance GHC.Base.Semigroup Distribution.Simple.Haddock.HaddockArgs instance GHC.Base.Monoid Distribution.Simple.Haddock.Directory instance GHC.Base.Semigroup Distribution.Simple.Haddock.Directory -- | This 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 GHC.Base.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 data AbiTag NoAbiTag :: AbiTag AbiTag :: String -> AbiTag -- | 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] data CompilerId CompilerId :: CompilerFlavor -> Version -> CompilerId -- | PerCompilerFlavor carries only info per GHC and GHCJS -- -- Cabal parses only ghc-options and ghcjs-options, -- others are omitted. data PerCompilerFlavor v PerCompilerFlavor :: v -> v -> PerCompilerFlavor v data CompilerFlavor GHC :: CompilerFlavor GHCJS :: CompilerFlavor NHC :: CompilerFlavor YHC :: CompilerFlavor Hugs :: CompilerFlavor HBC :: CompilerFlavor Helium :: CompilerFlavor JHC :: CompilerFlavor LHC :: CompilerFlavor UHC :: CompilerFlavor Eta :: CompilerFlavor HaskellSuite :: String -> CompilerFlavor OtherCompiler :: String -> CompilerFlavor knownCompilerFlavors :: [CompilerFlavor] classifyCompilerFlavor :: String -> CompilerFlavor buildCompilerFlavor :: CompilerFlavor buildCompilerId :: CompilerId -- | 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 perCompilerFlavorToList :: PerCompilerFlavor v -> [(CompilerFlavor, v)] abiTagString :: AbiTag -> String -- | 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 -- | 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 -- | 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 -- | 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 -- | 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] -- | 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 data Compiler Compiler :: CompilerId -> AbiTag -> [CompilerId] -> [(Language, Flag)] -> [(Extension, Maybe 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, Maybe 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 -- | 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 flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel unsupportedLanguages :: Compiler -> [Language] -> [Language] languageToFlags :: Compiler -> Maybe Language -> [Flag] -- | For the given compiler, return the extensions it does not support. unsupportedExtensions :: Compiler -> [Extension] -> [Extension] -- | For the given compiler, return the flags for the supported extensions. extensionsToFlags :: Compiler -> [Extension] -> [Flag] -- | 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 Backpack? backpackSupported :: Compiler -> Bool -- | Does this compiler support a package database entry with: -- "dynamic-library-dirs"? libraryDynDirSupported :: Compiler -> Bool -- | Does this compiler's "ar" command supports response file arguments -- (i.e. @file-style arguments). arResponseFilesSupported :: Compiler -> Bool -- | Does this compiler support Haskell program coverage? coverageSupported :: Compiler -> Bool -- | Does this compiler support profiling? profilingSupported :: Compiler -> Bool flagToProfDetailLevel :: String -> ProfDetailLevel knownProfDetailLevels :: [(String, [String], ProfDetailLevel)] showProfDetailLevel :: ProfDetailLevel -> String -- | 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. -- --