379 lines
14 KiB
Haskell
379 lines
14 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : Distribution.Package
|
|
-- Copyright : Isaac Jones 2003-2004
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : cabal-devel@haskell.org
|
|
-- Portability : portable
|
|
--
|
|
-- Defines a package identifier along with a parser and pretty printer for it.
|
|
-- 'PackageIdentifier's consist of a name and an exact version. It also defines
|
|
-- a 'Dependency' data type. A dependency is a package name and a version
|
|
-- range, like @\"foo >= 1.2 && < 2\"@.
|
|
|
|
module Distribution.Package (
|
|
-- * Package ids
|
|
PackageName(..),
|
|
PackageIdentifier(..),
|
|
PackageId,
|
|
|
|
-- * Installed package identifiers
|
|
InstalledPackageId(..),
|
|
|
|
-- * Package keys (used for linker symbols and library name)
|
|
PackageKey(..),
|
|
mkPackageKey,
|
|
packageKeyHash,
|
|
packageKeyLibraryName,
|
|
|
|
-- * Package source dependencies
|
|
Dependency(..),
|
|
thisPackageVersion,
|
|
notThisPackageVersion,
|
|
simplifyDependency,
|
|
|
|
-- * Package classes
|
|
Package(..), packageName, packageVersion,
|
|
PackageFixedDeps(..),
|
|
PackageInstalled(..),
|
|
) where
|
|
|
|
import Distribution.ModuleName ( ModuleName )
|
|
import Distribution.Version
|
|
( Version(..), VersionRange, anyVersion, thisVersion
|
|
, notThisVersion, simplifyVersionRange )
|
|
|
|
import Distribution.Text (Text(..), display)
|
|
import qualified Distribution.Compat.ReadP as Parse
|
|
import Distribution.Compat.ReadP ((<++))
|
|
import qualified Text.PrettyPrint as Disp
|
|
|
|
import Control.DeepSeq (NFData(..))
|
|
import Data.Ord ( comparing )
|
|
import Distribution.Compat.Binary (Binary)
|
|
import qualified Data.Char as Char
|
|
( isDigit, isAlphaNum, isUpper, isLower, ord, chr )
|
|
import Data.Data ( Data )
|
|
import Data.List ( intercalate, foldl', sortBy )
|
|
import Data.Typeable ( Typeable )
|
|
import Data.Word ( Word64 )
|
|
import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
|
|
import GHC.Generics (Generic)
|
|
import Numeric ( showIntAtBase )
|
|
import Text.PrettyPrint ((<>), (<+>), text)
|
|
|
|
newtype PackageName = PackageName { unPackageName :: String }
|
|
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
|
|
|
|
instance Binary PackageName
|
|
|
|
instance Text PackageName where
|
|
disp (PackageName n) = Disp.text n
|
|
parse = do
|
|
ns <- Parse.sepBy1 component (Parse.char '-')
|
|
return (PackageName (intercalate "-" ns))
|
|
where
|
|
component = do
|
|
cs <- Parse.munch1 Char.isAlphaNum
|
|
if all Char.isDigit cs then Parse.pfail else return cs
|
|
-- each component must contain an alphabetic character, to avoid
|
|
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
|
|
|
|
instance NFData PackageName where
|
|
rnf (PackageName pkg) = rnf pkg
|
|
|
|
-- | Type alias so we can use the shorter name PackageId.
|
|
type PackageId = PackageIdentifier
|
|
|
|
-- | The name and version of a package.
|
|
data PackageIdentifier
|
|
= PackageIdentifier {
|
|
pkgName :: PackageName, -- ^The name of this package, eg. foo
|
|
pkgVersion :: Version -- ^the version of this package, eg 1.2
|
|
}
|
|
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
|
|
|
|
instance Binary PackageIdentifier
|
|
|
|
instance Text PackageIdentifier where
|
|
disp (PackageIdentifier n v) = case v of
|
|
Version [] _ -> disp n -- if no version, don't show version.
|
|
_ -> disp n <> Disp.char '-' <> disp v
|
|
|
|
parse = do
|
|
n <- parse
|
|
v <- (Parse.char '-' >> parse) <++ return (Version [] [])
|
|
return (PackageIdentifier n v)
|
|
|
|
instance NFData PackageIdentifier where
|
|
rnf (PackageIdentifier name version) = rnf name `seq` rnf version
|
|
|
|
-- ------------------------------------------------------------
|
|
-- * Installed Package Ids
|
|
-- ------------------------------------------------------------
|
|
|
|
-- | An InstalledPackageId uniquely identifies an instance of an installed
|
|
-- package. There can be at most one package with a given 'InstalledPackageId'
|
|
-- in a package database, or overlay of databases.
|
|
--
|
|
newtype InstalledPackageId = InstalledPackageId String
|
|
deriving (Generic, Read,Show,Eq,Ord,Typeable,Data)
|
|
|
|
instance Binary InstalledPackageId
|
|
|
|
instance Text InstalledPackageId where
|
|
disp (InstalledPackageId str) = text str
|
|
|
|
parse = InstalledPackageId `fmap` Parse.munch1 abi_char
|
|
where abi_char c = Char.isAlphaNum c || c `elem` "-_."
|
|
|
|
-- ------------------------------------------------------------
|
|
-- * Package Keys
|
|
-- ------------------------------------------------------------
|
|
|
|
-- | A 'PackageKey' is the notion of "package ID" which is visible to the
|
|
-- compiler. Why is this not a 'PackageId'? The 'PackageId' is a user-visible
|
|
-- concept written explicity in Cabal files; on the other hand, a 'PackageKey'
|
|
-- may contain, for example, information about the transitive dependency
|
|
-- tree of a package. Why is this not an 'InstalledPackageId'? A 'PackageKey'
|
|
-- affects the ABI because it is used for linker symbols; however, an
|
|
-- 'InstalledPackageId' can be used to distinguish two ABI-compatible versions
|
|
-- of a library.
|
|
--
|
|
-- The key is defined to be a 128-bit MD5 hash, separated into two 64-bit
|
|
-- components (the most significant component coming first) which are
|
|
-- individually base-62 encoded (A-Z, a-z, 0-9).
|
|
--
|
|
-- @
|
|
-- key ::= hash64 hash64
|
|
-- hash64 ::= [A-Za-z0-9]{11}
|
|
-- @
|
|
--
|
|
-- The string that is hashed is specified as raw_key:
|
|
--
|
|
-- @
|
|
-- raw_key ::= package_id "\n"
|
|
-- holes_nl
|
|
-- depends_nl
|
|
-- package_id ::= package_name "-" package_version
|
|
-- holes_nl ::= ""
|
|
-- | hole_inst "\n" holes_nl
|
|
-- hole_inst ::= modulename " " key ":" modulename
|
|
-- depends_nl ::= ""
|
|
-- | depend "\n" depends_nl
|
|
-- depend ::= key
|
|
-- @
|
|
--
|
|
-- The holes list MUST be sorted by the first modulename; the depends list
|
|
-- MUST be sorted by the key. holes describes the backing implementations of
|
|
-- all holes in the package; depends describes all of the build-depends of
|
|
-- a package. A package key MAY be used in holes even if it is not
|
|
-- mentioned in depends: depends contains STRICTLY packages which are
|
|
-- textually mentioned in the package description.
|
|
--
|
|
-- The trailing newline is MANDATORY.
|
|
--
|
|
-- There is also a variant of package key which is prefixed by a informational
|
|
-- string. This key MUST NOT be used in the computation of the hash proper,
|
|
-- but it is useful for human-readable consumption.
|
|
--
|
|
-- @
|
|
-- infokey ::= infostring "_" key
|
|
-- infostring ::= [A-Za-z0-9-]+
|
|
-- @
|
|
--
|
|
-- For example, Cabal provides a key with the first five characters of the
|
|
-- package name for linker symbols.
|
|
--
|
|
data PackageKey
|
|
-- | Modern package key which is a hash of the PackageId and the transitive
|
|
-- dependency key. Manually inline it here so we can get the instances
|
|
-- we need. Also contains a short informative string
|
|
= PackageKey !String {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
|
|
-- | Old-style package key which is just a 'PackageId'. Required because
|
|
-- old versions of GHC assume that the 'sourcePackageId' recorded for an
|
|
-- installed package coincides with the package key it was compiled with.
|
|
| OldPackageKey !PackageId
|
|
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
|
|
|
|
instance Binary PackageKey
|
|
|
|
-- | Convenience function which converts a fingerprint into a new-style package
|
|
-- key.
|
|
fingerprintPackageKey :: String -> Fingerprint -> PackageKey
|
|
fingerprintPackageKey s (Fingerprint a b) = PackageKey s a b
|
|
|
|
-- | Generates a 'PackageKey' from a 'PackageId', sorted package keys of the
|
|
-- immediate dependencies.
|
|
mkPackageKey :: Bool -- are modern style package keys supported?
|
|
-> PackageId
|
|
-> [PackageKey] -- dependencies
|
|
-> [(ModuleName, (PackageKey, ModuleName))] -- hole instantiations
|
|
-> PackageKey
|
|
mkPackageKey True pid deps holes =
|
|
fingerprintPackageKey stubName . fingerprintString $
|
|
display pid ++ "\n" ++
|
|
-- NB: packageKeyHash, NOT display
|
|
concat [ display m ++ " " ++ packageKeyHash p' ++ ":" ++ display m' ++ "\n"
|
|
| (m, (p', m')) <- sortBy (comparing fst) holes] ++
|
|
concat [ packageKeyHash d ++ "\n"
|
|
| d <- sortBy (comparing packageKeyHash) deps]
|
|
where stubName = take 5 (filter (/= '-') (unPackageName (pkgName pid)))
|
|
mkPackageKey False pid _ _ = OldPackageKey pid
|
|
|
|
-- The base-62 code is based off of 'locators'
|
|
-- ((c) Operational Dynamics Consulting, BSD3 licensed)
|
|
|
|
-- Note: Instead of base-62 encoding a single 128-bit integer
|
|
-- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
|
|
-- (2 * ceil(10.75) characters). Luckily for us, it's the same number of
|
|
-- characters! In the long term, this should go in GHC.Fingerprint,
|
|
-- but not now...
|
|
|
|
-- | Size of a 64-bit word when written as a base-62 string
|
|
word64Base62Len :: Int
|
|
word64Base62Len = 11
|
|
|
|
-- | Converts a 64-bit word into a base-62 string
|
|
toBase62 :: Word64 -> String
|
|
toBase62 w = pad ++ str
|
|
where
|
|
pad = replicate len '0'
|
|
len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)
|
|
str = showIntAtBase 62 represent w ""
|
|
represent :: Int -> Char
|
|
represent x
|
|
| x < 10 = Char.chr (48 + x)
|
|
| x < 36 = Char.chr (65 + x - 10)
|
|
| x < 62 = Char.chr (97 + x - 36)
|
|
| otherwise = error ("represent (base 62): impossible!")
|
|
|
|
-- | Parses a base-62 string into a 64-bit word
|
|
fromBase62 :: String -> Word64
|
|
fromBase62 ss = foldl' multiply 0 ss
|
|
where
|
|
value :: Char -> Int
|
|
value c
|
|
| Char.isDigit c = Char.ord c - 48
|
|
| Char.isUpper c = Char.ord c - 65 + 10
|
|
| Char.isLower c = Char.ord c - 97 + 36
|
|
| otherwise = error ("value (base 62): impossible!")
|
|
|
|
multiply :: Word64 -> Char -> Word64
|
|
multiply acc c = acc * 62 + (fromIntegral $ value c)
|
|
|
|
-- | Parses a base-62 string into a fingerprint.
|
|
readBase62Fingerprint :: String -> Fingerprint
|
|
readBase62Fingerprint s = Fingerprint w1 w2
|
|
where (s1,s2) = splitAt word64Base62Len s
|
|
w1 = fromBase62 s1
|
|
w2 = fromBase62 (take word64Base62Len s2)
|
|
|
|
packageKeyHash :: PackageKey -> String
|
|
packageKeyHash (PackageKey _ w1 w2) = toBase62 w1 ++ toBase62 w2
|
|
packageKeyHash (OldPackageKey pid) = display pid
|
|
|
|
packageKeyLibraryName :: PackageId -> PackageKey -> String
|
|
packageKeyLibraryName pid (PackageKey _ w1 w2) = display pid ++ "-" ++ toBase62 w1 ++ toBase62 w2
|
|
packageKeyLibraryName _ (OldPackageKey pid) = display pid
|
|
|
|
instance Text PackageKey where
|
|
disp (PackageKey prefix w1 w2) = Disp.text prefix <> Disp.char '_'
|
|
<> Disp.text (toBase62 w1) <> Disp.text (toBase62 w2)
|
|
disp (OldPackageKey pid) = disp pid
|
|
|
|
parse = parseNew <++ parseOld
|
|
where parseNew = do
|
|
prefix <- Parse.munch1 (\c -> Char.isAlphaNum c || c `elem` "-")
|
|
_ <- Parse.char '_' -- if we use '-' it's ambiguous
|
|
fmap (fingerprintPackageKey prefix . readBase62Fingerprint)
|
|
. Parse.count (word64Base62Len * 2)
|
|
$ Parse.satisfy Char.isAlphaNum
|
|
parseOld = do pid <- parse
|
|
return (OldPackageKey pid)
|
|
|
|
instance NFData PackageKey where
|
|
rnf (PackageKey prefix _ _) = rnf prefix
|
|
rnf (OldPackageKey pid) = rnf pid
|
|
|
|
-- ------------------------------------------------------------
|
|
-- * Package source dependencies
|
|
-- ------------------------------------------------------------
|
|
|
|
-- | Describes a dependency on a source package (API)
|
|
--
|
|
data Dependency = Dependency PackageName VersionRange
|
|
deriving (Generic, Read, Show, Eq, Typeable, Data)
|
|
|
|
instance Binary Dependency
|
|
|
|
instance Text Dependency where
|
|
disp (Dependency name ver) =
|
|
disp name <+> disp ver
|
|
|
|
parse = do name <- parse
|
|
Parse.skipSpaces
|
|
ver <- parse <++ return anyVersion
|
|
Parse.skipSpaces
|
|
return (Dependency name ver)
|
|
|
|
thisPackageVersion :: PackageIdentifier -> Dependency
|
|
thisPackageVersion (PackageIdentifier n v) =
|
|
Dependency n (thisVersion v)
|
|
|
|
notThisPackageVersion :: PackageIdentifier -> Dependency
|
|
notThisPackageVersion (PackageIdentifier n v) =
|
|
Dependency n (notThisVersion v)
|
|
|
|
-- | Simplify the 'VersionRange' expression in a 'Dependency'.
|
|
-- See 'simplifyVersionRange'.
|
|
--
|
|
simplifyDependency :: Dependency -> Dependency
|
|
simplifyDependency (Dependency name range) =
|
|
Dependency name (simplifyVersionRange range)
|
|
|
|
-- | Class of things that have a 'PackageIdentifier'
|
|
--
|
|
-- Types in this class are all notions of a package. This allows us to have
|
|
-- different types for the different phases that packages go though, from
|
|
-- simple name\/id, package description, configured or installed packages.
|
|
--
|
|
-- Not all kinds of packages can be uniquely identified by a
|
|
-- 'PackageIdentifier'. In particular, installed packages cannot, there may be
|
|
-- many installed instances of the same source package.
|
|
--
|
|
class Package pkg where
|
|
packageId :: pkg -> PackageIdentifier
|
|
|
|
packageName :: Package pkg => pkg -> PackageName
|
|
packageName = pkgName . packageId
|
|
|
|
packageVersion :: Package pkg => pkg -> Version
|
|
packageVersion = pkgVersion . packageId
|
|
|
|
instance Package PackageIdentifier where
|
|
packageId = id
|
|
|
|
-- | Subclass of packages that have specific versioned dependencies.
|
|
--
|
|
-- So for example a not-yet-configured package has dependencies on version
|
|
-- ranges, not specific versions. A configured or an already installed package
|
|
-- depends on exact versions. Some operations or data structures (like
|
|
-- dependency graphs) only make sense on this subclass of package types.
|
|
--
|
|
class Package pkg => PackageFixedDeps pkg where
|
|
depends :: pkg -> [PackageIdentifier]
|
|
|
|
-- | Class of installed packages.
|
|
--
|
|
-- The primary data type which is an instance of this package is
|
|
-- 'InstalledPackageInfo', but when we are doing install plans in Cabal install
|
|
-- we may have other, installed package-like things which contain more metadata.
|
|
-- Installed packages have exact dependencies 'installedDepends'.
|
|
class Package pkg => PackageInstalled pkg where
|
|
installedPackageId :: pkg -> InstalledPackageId
|
|
installedDepends :: pkg -> [InstalledPackageId]
|