1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3module Distribution.Solver.Types.SourcePackage
4    ( PackageDescriptionOverride
5    , SourcePackage(..)
6    ) where
7
8import Distribution.Package
9         ( PackageId, Package(..) )
10import Distribution.PackageDescription
11         ( GenericPackageDescription(..) )
12
13import Data.ByteString.Lazy (ByteString)
14import GHC.Generics (Generic)
15import Distribution.Compat.Binary (Binary)
16import Data.Typeable
17import Distribution.Utils.Structured (Structured)
18
19-- | A package description along with the location of the package sources.
20--
21data SourcePackage loc = SourcePackage {
22    packageInfoId        :: PackageId,
23    packageDescription   :: GenericPackageDescription,
24    packageSource        :: loc,
25    packageDescrOverride :: PackageDescriptionOverride
26  }
27  deriving (Eq, Show, Generic, Typeable)
28
29instance Binary loc => Binary (SourcePackage loc)
30instance Structured loc => Structured (SourcePackage loc)
31
32instance Package (SourcePackage a) where packageId = packageInfoId
33
34-- | We sometimes need to override the .cabal file in the tarball with
35-- the newer one from the package index.
36type PackageDescriptionOverride = Maybe ByteString
37