Package.hs 10.7 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable #-}
2
3
4
5
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Package
-- Copyright   :  Isaac Jones 2003-2004
6
-- License     :  BSD3
7
--
Duncan Coutts's avatar
Duncan Coutts committed
8
-- Maintainer  :  cabal-devel@haskell.org
simonmar's avatar
simonmar committed
9
-- Portability :  portable
10
--
Duncan Coutts's avatar
Duncan Coutts committed
11
12
13
14
-- 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\"@.
15

16
module Distribution.Package (
17
        -- * Package ids
Duncan Coutts's avatar
Duncan Coutts committed
18
        PackageName(..),
19
        PackageIdentifier(..),
20
        PackageId,
21

22
23
24
        -- * Installed package identifiers
        InstalledPackageId(..),

25
26
27
28
        -- * Package keys (used for linker symbols)
        PackageKey(..),
        mkPackageKey,

29
        -- * Package source dependencies
30
        Dependency(..),
31
32
        thisPackageVersion,
        notThisPackageVersion,
33
        simplifyDependency,
34

35
36
37
        -- * Package classes
        Package(..), packageName, packageVersion,
        PackageFixedDeps(..),
38
  ) where
39

40
import Distribution.Version
41
42
         ( Version(..), VersionRange, anyVersion, thisVersion
         , notThisVersion, simplifyVersionRange )
43
44
45
46
47

import Distribution.Text (Text(..))
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP ((<++))
import qualified Text.PrettyPrint as Disp
48
import Text.PrettyPrint ((<>), (<+>), text)
49
import Control.DeepSeq (NFData(..))
50
51
52
import qualified Data.Char as Char
    ( isDigit, isAlphaNum, isUpper, isLower, ord, chr )
import Data.List ( intercalate, sort, foldl' )
53
import Data.Data ( Data )
54
import Data.Typeable ( Typeable )
55
56
57
import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
import Data.Word ( Word64 )
import Numeric ( showIntAtBase )
ijones's avatar
ijones committed
58

59
newtype PackageName = PackageName { unPackageName :: String }
60
    deriving (Read, Show, Eq, Ord, Typeable, Data)
Duncan Coutts's avatar
Duncan Coutts committed
61
62
63
64
65

instance Text PackageName where
  disp (PackageName n) = Disp.text n
  parse = do
    ns <- Parse.sepBy1 component (Parse.char '-')
66
    return (PackageName (intercalate "-" ns))
Duncan Coutts's avatar
Duncan Coutts committed
67
68
69
70
71
72
73
    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).

74
75
76
instance NFData PackageName where
    rnf (PackageName pkg) = rnf pkg

77
78
79
-- | Type alias so we can use the shorter name PackageId.
type PackageId = PackageIdentifier

ijones's avatar
ijones committed
80
-- | The name and version of a package.
81
data PackageIdentifier
simonmar's avatar
simonmar committed
82
    = PackageIdentifier {
83
84
        pkgName    :: PackageName, -- ^The name of this package, eg. foo
        pkgVersion :: Version -- ^the version of this package, eg 1.2
simonmar's avatar
simonmar committed
85
     }
86
     deriving (Read, Show, Eq, Ord, Typeable, Data)
87

88
89
instance Text PackageIdentifier where
  disp (PackageIdentifier n v) = case v of
Duncan Coutts's avatar
Duncan Coutts committed
90
91
    Version [] _ -> disp n -- if no version, don't show version.
    _            -> disp n <> Disp.char '-' <> disp v
92
93

  parse = do
Duncan Coutts's avatar
Duncan Coutts committed
94
    n <- parse
95
96
    v <- (Parse.char '-' >> parse) <++ return (Version [] [])
    return (PackageIdentifier n v)
simonmar's avatar
simonmar committed
97

98
99
100
instance NFData PackageIdentifier where
    rnf (PackageIdentifier name version) = rnf name `seq` rnf version

101
-- ------------------------------------------------------------
102
103
104
-- * Installed Package Ids
-- ------------------------------------------------------------

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
105
106
-- | An InstalledPackageId uniquely identifies an instance of an installed
-- package.  There can be at most one package with a given 'InstalledPackageId'
107
108
109
-- in a package database, or overlay of databases.
--
newtype InstalledPackageId = InstalledPackageId String
110
 deriving (Read,Show,Eq,Ord,Typeable,Data)
111
112
113
114
115
116
117

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` ":-_."

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
-- ------------------------------------------------------------
-- * 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.
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 (Read, Show, Eq, Ord, Typeable, Data)

-- | 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
             -> PackageKey
mkPackageKey True pid deps = fingerprintPackageKey stubName
                           . fingerprintString
                           . ((show pid ++ "\n") ++)
                           $ show (sort 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)

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

226
227
-- ------------------------------------------------------------
-- * Package source dependencies
228
229
-- ------------------------------------------------------------

230
231
-- | Describes a dependency on a source package (API)
--
Duncan Coutts's avatar
Duncan Coutts committed
232
data Dependency = Dependency PackageName VersionRange
233
                  deriving (Read, Show, Eq, Typeable, Data)
234

235
236
instance Text Dependency where
  disp (Dependency name ver) =
Duncan Coutts's avatar
Duncan Coutts committed
237
    disp name <+> disp ver
238

Duncan Coutts's avatar
Duncan Coutts committed
239
  parse = do name <- parse
240
             Parse.skipSpaces
Duncan Coutts's avatar
Duncan Coutts committed
241
             ver <- parse <++ return anyVersion
242
243
             Parse.skipSpaces
             return (Dependency name ver)
244

245
246
thisPackageVersion :: PackageIdentifier -> Dependency
thisPackageVersion (PackageIdentifier n v) =
Duncan Coutts's avatar
Duncan Coutts committed
247
  Dependency n (thisVersion v)
248
249
250
251
252

notThisPackageVersion :: PackageIdentifier -> Dependency
notThisPackageVersion (PackageIdentifier n v) =
  Dependency n (notThisVersion v)

253
254
255
256
257
258
259
-- | Simplify the 'VersionRange' expression in a 'Dependency'.
-- See 'simplifyVersionRange'.
--
simplifyDependency :: Dependency -> Dependency
simplifyDependency (Dependency name range) =
  Dependency name (simplifyVersionRange range)

Duncan Coutts's avatar
Duncan Coutts committed
260
-- | Class of things that have a 'PackageIdentifier'
261
262
263
264
265
--
-- 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.
--
Duncan Coutts's avatar
Duncan Coutts committed
266
267
268
269
-- 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.
--
270
271
272
class Package pkg where
  packageId :: pkg -> PackageIdentifier

Duncan Coutts's avatar
Duncan Coutts committed
273
packageName    :: Package pkg => pkg -> PackageName
274
275
276
277
278
packageName     = pkgName    . packageId

packageVersion :: Package pkg => pkg -> Version
packageVersion  = pkgVersion . packageId

279
280
281
282
283
284
285
286
287
288
289
290
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]