cabal-install/Distribution/Solver/Modular/Package.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 module Distribution.Solver.Modular.Package
   3   ( I(..)
   4   , Loc(..)
   5   , PackageId
   6   , PackageIdentifier(..)
   7   , PackageName, mkPackageName, unPackageName
   8   , PkgconfigName, mkPkgconfigName, unPkgconfigName
   9   , PI(..)
  10   , PN
  11   , QPV
  12   , instI
  13   , makeIndependent
  14   , primaryPP
  15   , showI
  16   , showPI
  17   , unPN
  18   ) where
  19
  20 import Data.List as L
  21
  22 import Distribution.Package -- from Cabal
  23 import Distribution.Text (display)
  24
  25 import Distribution.Solver.Modular.Version
  26 import Distribution.Solver.Types.PackagePath
  27
  28 -- | A package name.
  29 type PN = PackageName
  30
  31 -- | Unpacking a package name.
  32 unPN :: PN -> String
  33 unPN = unPackageName
  34
  35 -- | Package version. A package name plus a version number.
  36 type PV = PackageId
  37
  38 -- | Qualified package version.
  39 type QPV = Qualified PV
  40
  41 -- | Package id. Currently just a black-box string.
  42 type PId = UnitId
  43
  44 -- | Location. Info about whether a package is installed or not, and where
  45 -- exactly it is located. For installed packages, uniquely identifies the
  46 -- package instance via its 'PId'.
  47 --
  48 -- TODO: More information is needed about the repo.
  49 data Loc = Inst PId | InRepo
  50   deriving (Eq, Ord, Show)
  51
  52 -- | Instance. A version number and a location.
  53 data I = I Ver Loc
  54   deriving (Eq, Ord, Show)
  55
  56 -- | String representation of an instance.
  57 showI :: I -> String
  58 showI (I v InRepo)   = showVer v
  59 showI (I v (Inst uid)) = showVer v ++ "/installed" ++ shortId uid
  60   where
  61     -- A hack to extract the beginning of the package ABI hash
  62     shortId = snip (splitAt 4) (++ "...")
  63             . snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
  64             . display
  65     snip p f xs = case p xs of
  66                     (ys, zs) -> (if L.null zs then id else f) ys
  67
  68 -- | Package instance. A package name and an instance.
  69 data PI qpn = PI qpn I
  70   deriving (Eq, Ord, Show, Functor)
  71
  72 -- | String representation of a package instance.
  73 showPI :: PI QPN -> String
  74 showPI (PI qpn i) = showQPN qpn ++ "-" ++ showI i
  75
  76 instI :: I -> Bool
  77 instI (I _ (Inst _)) = True
  78 instI _              = False
  79
  80 -- | Is the package in the primary group of packages.  This is used to
  81 -- determine (1) if we should try to establish stanza preferences
  82 -- for this goal, and (2) whether or not a user specified @--constraint@
  83 -- should apply to this dependency (grep 'primaryPP' to see the
  84 -- use sites).  In particular this does not include packages pulled in
  85 -- as setup deps.
  86 --
  87 primaryPP :: PackagePath -> Bool
  88 primaryPP (PackagePath _ns q) = go q
  89   where
  90     go Unqualified = True
  91     go (Base  _)   = True
  92     go (Setup _)   = False
  93     go (Exe _ _)   = False
  94
  95 -- | Create artificial parents for each of the package names, making
  96 -- them all independent.
  97 makeIndependent :: [PN] -> [QPN]
  98 makeIndependent ps = [ Q pp pn | (pn, i) <- zip ps [0::Int ..]
  99                                , let pp = PackagePath (Independent i) Unqualified
 100                      ]