module Distribution.Solver.Modular.Index
    ( Index
    , PInfo(..)
    , ComponentInfo(..)
    , IsVisible(..)
    , IsBuildable(..)
    , defaultQualifyOptions
    , mkIndex
    ) where

import Prelude hiding (pi)

import Data.Map (Map)
import qualified Data.List as L
import qualified Data.Map as M

import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Package
import Distribution.Solver.Modular.Tree

-- | An index contains information about package instances. This is a nested
-- dictionary. Package names are mapped to instances, which in turn is mapped
-- to info.
type Index = Map PN (Map I PInfo)

-- | Info associated with a package instance.
-- Currently, dependencies, component names, flags and failure reasons.
-- The component map records whether any components are unbuildable in the
-- current environment (compiler, os, arch, and global flag constraints).
-- Packages that have a failure reason recorded for them are disabled
-- globally, for reasons external to the solver. We currently use this
-- for shadowing which essentially is a GHC limitation, and for
-- installed packages that are broken.
data PInfo = PInfo (FlaggedDeps PN)
                   (Map ExposedComponent ComponentInfo)
                   FlagInfo
                   (Maybe FailReason)

-- | Info associated with each library and executable in a package instance.
data ComponentInfo = ComponentInfo {
    ComponentInfo -> IsVisible
compIsVisible   :: IsVisible
  , ComponentInfo -> IsBuildable
compIsBuildable :: IsBuildable
  }
  deriving Int -> ComponentInfo -> ShowS
[ComponentInfo] -> ShowS
ComponentInfo -> String
(Int -> ComponentInfo -> ShowS)
-> (ComponentInfo -> String)
-> ([ComponentInfo] -> ShowS)
-> Show ComponentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentInfo] -> ShowS
$cshowList :: [ComponentInfo] -> ShowS
show :: ComponentInfo -> String
$cshow :: ComponentInfo -> String
showsPrec :: Int -> ComponentInfo -> ShowS
$cshowsPrec :: Int -> ComponentInfo -> ShowS
Show

-- | Whether a component is visible in the current environment.
newtype IsVisible = IsVisible Bool
  deriving (IsVisible -> IsVisible -> Bool
(IsVisible -> IsVisible -> Bool)
-> (IsVisible -> IsVisible -> Bool) -> Eq IsVisible
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsVisible -> IsVisible -> Bool
$c/= :: IsVisible -> IsVisible -> Bool
== :: IsVisible -> IsVisible -> Bool
$c== :: IsVisible -> IsVisible -> Bool
Eq, Int -> IsVisible -> ShowS
[IsVisible] -> ShowS
IsVisible -> String
(Int -> IsVisible -> ShowS)
-> (IsVisible -> String)
-> ([IsVisible] -> ShowS)
-> Show IsVisible
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsVisible] -> ShowS
$cshowList :: [IsVisible] -> ShowS
show :: IsVisible -> String
$cshow :: IsVisible -> String
showsPrec :: Int -> IsVisible -> ShowS
$cshowsPrec :: Int -> IsVisible -> ShowS
Show)

-- | Whether a component is made unbuildable by a "buildable: False" field.
newtype IsBuildable = IsBuildable Bool
  deriving (IsBuildable -> IsBuildable -> Bool
(IsBuildable -> IsBuildable -> Bool)
-> (IsBuildable -> IsBuildable -> Bool) -> Eq IsBuildable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsBuildable -> IsBuildable -> Bool
$c/= :: IsBuildable -> IsBuildable -> Bool
== :: IsBuildable -> IsBuildable -> Bool
$c== :: IsBuildable -> IsBuildable -> Bool
Eq, Int -> IsBuildable -> ShowS
[IsBuildable] -> ShowS
IsBuildable -> String
(Int -> IsBuildable -> ShowS)
-> (IsBuildable -> String)
-> ([IsBuildable] -> ShowS)
-> Show IsBuildable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsBuildable] -> ShowS
$cshowList :: [IsBuildable] -> ShowS
show :: IsBuildable -> String
$cshow :: IsBuildable -> String
showsPrec :: Int -> IsBuildable -> ShowS
$cshowsPrec :: Int -> IsBuildable -> ShowS
Show)

mkIndex :: [(PN, I, PInfo)] -> Index
mkIndex :: [(PN, I, PInfo)] -> Index
mkIndex [(PN, I, PInfo)]
xs = ([(I, PInfo)] -> Map I PInfo) -> Map PN [(I, PInfo)] -> Index
forall a b k. (a -> b) -> Map k a -> Map k b
M.map [(I, PInfo)] -> Map I PInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PN, (I, PInfo))] -> Map PN [(I, PInfo)]
forall a b. Ord a => [(a, b)] -> Map a [b]
groupMap (((PN, I, PInfo) -> (PN, (I, PInfo)))
-> [(PN, I, PInfo)] -> [(PN, (I, PInfo))]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (PN
pn, I
i, PInfo
pi) -> (PN
pn, (I
i, PInfo
pi))) [(PN, I, PInfo)]
xs))

groupMap :: Ord a => [(a, b)] -> Map a [b]
groupMap :: [(a, b)] -> Map a [b]
groupMap [(a, b)]
xs = ([b] -> [b] -> [b]) -> [(a, [b])] -> Map a [b]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (([b] -> [b] -> [b]) -> [b] -> [b] -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++)) (((a, b) -> (a, [b])) -> [(a, b)] -> [(a, [b])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\ (a
x, b
y) -> (a
x, [b
y])) [(a, b)]
xs)

defaultQualifyOptions :: Index -> QualifyOptions
defaultQualifyOptions :: Index -> QualifyOptions
defaultQualifyOptions Index
idx = QO :: Bool -> Bool -> QualifyOptions
QO {
      qoBaseShim :: Bool
qoBaseShim         = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ PN
dep PN -> PN -> Bool
forall a. Eq a => a -> a -> Bool
== PN
base
                              | -- Find all versions of base ..
                                Just Map I PInfo
is <- [PN -> Index -> Maybe (Map I PInfo)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PN
base Index
idx]
                                -- .. which are installed ..
                              , (I Ver
_ver (Inst PId
_), PInfo FlaggedDeps PN
deps Map ExposedComponent ComponentInfo
_comps FlagInfo
_flagNfo Maybe FailReason
_fr) <- Map I PInfo -> [(I, PInfo)]
forall k a. Map k a -> [(k, a)]
M.toList Map I PInfo
is
                                -- .. and flatten all their dependencies ..
                              , (LDep DependencyReason PN
_ (Dep (PkgComponent PN
dep ExposedComponent
_) CI
_ci), Component
_comp) <- FlaggedDeps PN -> [(LDep PN, Component)]
forall qpn. FlaggedDeps qpn -> [(LDep qpn, Component)]
flattenFlaggedDeps FlaggedDeps PN
deps
                              ]
    , qoSetupIndependent :: Bool
qoSetupIndependent = Bool
True
    }
  where
    base :: PN
base = String -> PN
mkPackageName String
"base"