cabal-install-solver/src/Distribution/Solver/Modular/Index.hs

   1 module Distribution.Solver.Modular.Index
   2     ( Index
   3     , PInfo(..)
   4     , ComponentInfo(..)
   5     , IsVisible(..)
   6     , IsBuildable(..)
   7     , defaultQualifyOptions
   8     , mkIndex
   9     ) where
  10
  11 import Prelude hiding (pi)
  12
  13 import Data.Map (Map)
  14 import qualified Data.List as L
  15 import qualified Data.Map as M
  16
  17 import Distribution.Solver.Modular.Dependency
  18 import Distribution.Solver.Modular.Flag
  19 import Distribution.Solver.Modular.Package
  20 import Distribution.Solver.Modular.Tree
  21
  22 -- | An index contains information about package instances. This is a nested
  23 -- dictionary. Package names are mapped to instances, which in turn is mapped
  24 -- to info.
  25 type Index = Map PN (Map I PInfo)
  26
  27 -- | Info associated with a package instance.
  28 -- Currently, dependencies, component names, flags and failure reasons.
  29 -- The component map records whether any components are unbuildable in the
  30 -- current environment (compiler, os, arch, and global flag constraints).
  31 -- Packages that have a failure reason recorded for them are disabled
  32 -- globally, for reasons external to the solver. We currently use this
  33 -- for shadowing which essentially is a GHC limitation, and for
  34 -- installed packages that are broken.
  35 data PInfo = PInfo (FlaggedDeps PN)
  36                    (Map ExposedComponent ComponentInfo)
  37                    FlagInfo
  38                    (Maybe FailReason)
  39
  40 -- | Info associated with each library and executable in a package instance.
  41 data ComponentInfo = ComponentInfo {
  42     compIsVisible   :: IsVisible
  43   , compIsBuildable :: IsBuildable
  44   }
  45   deriving Show
  46
  47 -- | Whether a component is visible in the current environment.
  48 newtype IsVisible = IsVisible Bool
  49   deriving (Eq, Show)
  50
  51 -- | Whether a component is made unbuildable by a "buildable: False" field.
  52 newtype IsBuildable = IsBuildable Bool
  53   deriving (Eq, Show)
  54
  55 mkIndex :: [(PN, I, PInfo)] -> Index
  56 mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi))) xs))
  57
  58 groupMap :: Ord a => [(a, b)] -> Map a [b]
  59 groupMap xs = M.fromListWith (flip (++)) (L.map (\ (x, y) -> (x, [y])) xs)
  60
  61 defaultQualifyOptions :: Index -> QualifyOptions
  62 defaultQualifyOptions idx = QO {
  63       qoBaseShim         = or [ dep == base
  64                               | -- Find all versions of base ..
  65                                 Just is <- [M.lookup base idx]
  66                                 -- .. which are installed ..
  67                               , (I _ver (Inst _), PInfo deps _comps _flagNfo _fr) <- M.toList is
  68                                 -- .. and flatten all their dependencies ..
  69                               , (LDep _ (Dep (PkgComponent dep _) _ci), _comp) <- flattenFlaggedDeps deps
  70                               ]
  71     , qoSetupIndependent = True
  72     }
  73   where
  74     base = mkPackageName "base"