{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternGuards #-}
module Distribution.Backpack.Id(
computeComponentId,
computeCompatPackageKey,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.UnqualComponentName
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Simple.Setup as Setup
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentId
import Distribution.Types.PackageId
import Distribution.Types.UnitId
import Distribution.Types.MungedPackageName
import Distribution.Utils.Base62
import Distribution.Version
import Distribution.Pretty
( prettyShow )
import Distribution.Parsec ( simpleParsec )
computeComponentId
:: Bool
-> Flag String
-> Flag ComponentId
-> PackageIdentifier
-> ComponentName
-> Maybe ([ComponentId], FlagAssignment)
-> ComponentId
computeComponentId :: Bool
-> Flag String
-> Flag ComponentId
-> PackageIdentifier
-> ComponentName
-> Maybe ([ComponentId], FlagAssignment)
-> ComponentId
computeComponentId deterministic :: Bool
deterministic mb_ipid :: Flag String
mb_ipid mb_cid :: Flag ComponentId
mb_cid pid :: PackageIdentifier
pid cname :: ComponentName
cname mb_details :: Maybe ([ComponentId], FlagAssignment)
mb_details =
let hash_suffix :: String
hash_suffix
| Just (dep_ipids :: [ComponentId]
dep_ipids, flags :: FlagAssignment
flags) <- Maybe ([ComponentId], FlagAssignment)
mb_details
= "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
hashToBase62
( PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pid
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ComponentId] -> String
forall a. Show a => a -> String
show [ComponentId]
dep_ipids
String -> String -> String
forall a. [a] -> [a] -> [a]
++ FlagAssignment -> String
forall a. Show a => a -> String
show FlagAssignment
flags )
| Bool
otherwise = ""
generated_base :: String
generated_base = PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hash_suffix
explicit_base :: String -> String
explicit_base cid0 :: String
cid0 = PathTemplate -> String
fromPathTemplate (PathTemplateEnv -> PathTemplate -> PathTemplate
InstallDirs.substPathTemplate PathTemplateEnv
env
(String -> PathTemplate
toPathTemplate String
cid0))
where env :: PathTemplateEnv
env = PackageIdentifier -> UnitId -> PathTemplateEnv
packageTemplateEnv PackageIdentifier
pid (String -> UnitId
mkUnitId "")
actual_base :: String
actual_base = case Flag String
mb_ipid of
Flag ipid0 :: String
ipid0 -> String -> String
explicit_base String
ipid0
NoFlag | Bool
deterministic -> PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pid
| Bool
otherwise -> String
generated_base
in case Flag ComponentId
mb_cid of
Flag cid :: ComponentId
cid -> ComponentId
cid
NoFlag -> String -> ComponentId
mkComponentId (String -> ComponentId) -> String -> ComponentId
forall a b. (a -> b) -> a -> b
$ String
actual_base
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (case ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
cname of
Nothing -> ""
Just s :: UnqualComponentName
s -> "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s)
computeCompatPackageKey
:: Compiler
-> MungedPackageName
-> Version
-> UnitId
-> String
computeCompatPackageKey :: Compiler -> MungedPackageName -> Version -> UnitId -> String
computeCompatPackageKey comp :: Compiler
comp pkg_name :: MungedPackageName
pkg_name pkg_version :: Version
pkg_version uid :: UnitId
uid
| Bool -> Bool
not (Compiler -> Bool
packageKeySupported Compiler
comp) =
MungedPackageName -> String
forall a. Pretty a => a -> String
prettyShow MungedPackageName
pkg_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
pkg_version
| Bool -> Bool
not (Compiler -> Bool
unifiedIPIDRequired Compiler
comp) =
let str :: String
str = UnitId -> String
unUnitId UnitId
uid
mb_verbatim_key :: Maybe String
mb_verbatim_key
= case String -> Maybe PackageIdentifier
forall a. Parsec a => String -> Maybe a
simpleParsec String
str :: Maybe PackageId of
Just pid0 :: PackageIdentifier
pid0 | PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pid0 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str -> String -> Maybe String
forall a. a -> Maybe a
Just String
str
_ -> Maybe String
forall a. Maybe a
Nothing
mb_truncated_key :: Maybe String
mb_truncated_key
= let cand :: String
cand = String -> String
forall a. [a] -> [a]
reverse ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isAlphaNum (String -> String
forall a. [a] -> [a]
reverse String
str))
in if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cand Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 22 Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum String
cand
then String -> Maybe String
forall a. a -> Maybe a
Just String
cand
else Maybe String
forall a. Maybe a
Nothing
rehashed_key :: String
rehashed_key = String -> String
hashToBase62 String
str
in String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
rehashed_key (Maybe String
mb_verbatim_key Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
mb_truncated_key)
| Bool
otherwise = UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
uid