1{-# LANGUAGE FlexibleInstances #-} 2{-# LANGUAGE RankNTypes #-} 3{-# LANGUAGE PatternGuards #-} 4-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> 5module Distribution.Backpack.Id( 6 computeComponentId, 7 computeCompatPackageKey, 8) where 9 10import Prelude () 11import Distribution.Compat.Prelude 12 13import Distribution.Types.UnqualComponentName 14import Distribution.Simple.Compiler 15import Distribution.PackageDescription 16import Distribution.Simple.Setup as Setup 17import qualified Distribution.Simple.InstallDirs as InstallDirs 18import Distribution.Simple.LocalBuildInfo 19import Distribution.Types.ComponentId 20import Distribution.Types.UnitId 21import Distribution.Types.MungedPackageName 22import Distribution.Utils.Base62 23import Distribution.Version 24 25import Distribution.Pretty 26 ( prettyShow ) 27import Distribution.Parsec ( simpleParsec ) 28 29-- | This method computes a default, "good enough" 'ComponentId' 30-- for a package. The intent is that cabal-install (or the user) will 31-- specify a more detailed IPID via the @--ipid@ flag if necessary. 32computeComponentId 33 :: Bool -- deterministic mode 34 -> Flag String 35 -> Flag ComponentId 36 -> PackageIdentifier 37 -> ComponentName 38 -- This is used by cabal-install's legacy codepath 39 -> Maybe ([ComponentId], FlagAssignment) 40 -> ComponentId 41computeComponentId deterministic mb_ipid mb_cid pid cname mb_details = 42 -- show is found to be faster than intercalate and then replacement of 43 -- special character used in intercalating. We cannot simply hash by 44 -- doubly concating list, as it just flatten out the nested list, so 45 -- different sources can produce same hash 46 let hash_suffix 47 | Just (dep_ipids, flags) <- mb_details 48 = "-" ++ hashToBase62 49 -- For safety, include the package + version here 50 -- for GHC 7.10, where just the hash is used as 51 -- the package key 52 ( prettyShow pid 53 ++ show dep_ipids 54 ++ show flags ) 55 | otherwise = "" 56 generated_base = prettyShow pid ++ hash_suffix 57 explicit_base cid0 = fromPathTemplate (InstallDirs.substPathTemplate env 58 (toPathTemplate cid0)) 59 -- Hack to reuse install dirs machinery 60 -- NB: no real IPID available at this point 61 where env = packageTemplateEnv pid (mkUnitId "") 62 actual_base = case mb_ipid of 63 Flag ipid0 -> explicit_base ipid0 64 NoFlag | deterministic -> prettyShow pid 65 | otherwise -> generated_base 66 in case mb_cid of 67 Flag cid -> cid 68 NoFlag -> mkComponentId $ actual_base 69 ++ (case componentNameString cname of 70 Nothing -> "" 71 Just s -> "-" ++ unUnqualComponentName s) 72 73-- | In GHC 8.0, the string we pass to GHC to use for symbol 74-- names for a package can be an arbitrary, IPID-compatible string. 75-- However, prior to GHC 8.0 there are some restrictions on what 76-- format this string can be (due to how ghc-pkg parsed the key): 77-- 78-- 1. In GHC 7.10, the string had either be of the form 79-- foo_ABCD, where foo is a non-semantic alphanumeric/hyphenated 80-- prefix and ABCD is two base-64 encoded 64-bit integers, 81-- or a GHC 7.8 style identifier. 82-- 83-- 2. In GHC 7.8, the string had to be a valid package identifier 84-- like foo-0.1. 85-- 86-- So, the problem is that Cabal, in general, has a general IPID, 87-- but needs to figure out a package key / package ID that the 88-- old ghc-pkg will actually accept. But there's an EVERY WORSE 89-- problem: if ghc-pkg decides to parse an identifier foo-0.1-xxx 90-- as if it were a package identifier, which means it will SILENTLY 91-- DROP the "xxx" (because it's a tag, and Cabal does not allow tags.) 92-- So we must CONNIVE to ensure that we don't pick something that 93-- looks like this. 94-- 95-- So this function attempts to define a mapping into the old formats. 96-- 97-- The mapping for GHC 7.8 and before: 98-- 99-- * We use the *compatibility* package name and version. For 100-- public libraries this is just the package identifier; for 101-- internal libraries, it's something like "z-pkgname-z-libname-0.1". 102-- See 'computeCompatPackageName' for more details. 103-- 104-- The mapping for GHC 7.10: 105-- 106-- * For CLibName: 107-- If the IPID is of the form foo-0.1-ABCDEF where foo_ABCDEF would 108-- validly parse as a package key, we pass "ABCDEF". (NB: not 109-- all hashes parse this way, because GHC 7.10 mandated that 110-- these hashes be two base-62 encoded 64 bit integers), 111-- but hashes that Cabal generated using 'computeComponentId' 112-- are guaranteed to have this form. 113-- 114-- If it is not of this form, we rehash the IPID into the 115-- correct form and pass that. 116-- 117-- * For sub-components, we rehash the IPID into the correct format 118-- and pass that. 119-- 120computeCompatPackageKey 121 :: Compiler 122 -> MungedPackageName 123 -> Version 124 -> UnitId 125 -> String 126computeCompatPackageKey comp pkg_name pkg_version uid 127 | not (packageKeySupported comp || unitIdSupported comp) 128 = prettyShow pkg_name ++ "-" ++ prettyShow pkg_version 129 | not (unifiedIPIDRequired comp) = 130 let str = unUnitId uid -- assume no Backpack support 131 mb_verbatim_key 132 = case simpleParsec str :: Maybe PackageId of 133 -- Something like 'foo-0.1', use it verbatim. 134 -- (NB: hash tags look like tags, so they are parsed, 135 -- so the extra equality check tests if a tag was dropped.) 136 Just pid0 | prettyShow pid0 == str -> Just str 137 _ -> Nothing 138 mb_truncated_key 139 = let cand = reverse (takeWhile isAlphaNum (reverse str)) 140 in if length cand == 22 && all isAlphaNum cand 141 then Just cand 142 else Nothing 143 rehashed_key = hashToBase62 str 144 in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key) 145 | otherwise = prettyShow uid 146