module Distribution.Package (
PackageName(..),
PackageIdentifier(..),
PackageId,
InstalledPackageId(..),
PackageKey(..),
mkPackageKey,
packageKeyHash,
packageKeyLibraryName,
Dependency(..),
thisPackageVersion,
notThisPackageVersion,
simplifyDependency,
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
instance NFData PackageName where
rnf (PackageName pkg) = rnf pkg
type PackageId = PackageIdentifier
data PackageIdentifier
= PackageIdentifier {
pkgName :: PackageName,
pkgVersion :: Version
}
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
_ -> 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
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` "-_."
data PackageKey
= PackageKey !String !Word64 !Word64
| OldPackageKey !PackageId
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
instance Binary PackageKey
fingerprintPackageKey :: String -> Fingerprint -> PackageKey
fingerprintPackageKey s (Fingerprint a b) = PackageKey s a b
mkPackageKey :: Bool
-> PackageId
-> [PackageKey]
-> [(ModuleName, (PackageKey, ModuleName))]
-> PackageKey
mkPackageKey True pid deps holes =
fingerprintPackageKey stubName . fingerprintString $
display pid ++ "\n" ++
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
word64Base62Len :: Int
word64Base62Len = 11
toBase62 :: Word64 -> String
toBase62 w = pad ++ str
where
pad = replicate len '0'
len = word64Base62Len length str
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!")
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)
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 '_'
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
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)
simplifyDependency :: Dependency -> Dependency
simplifyDependency (Dependency name range) =
Dependency name (simplifyVersionRange range)
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
class Package pkg => PackageFixedDeps pkg where
depends :: pkg -> [PackageIdentifier]
class Package pkg => PackageInstalled pkg where
installedPackageId :: pkg -> InstalledPackageId
installedDepends :: pkg -> [InstalledPackageId]