{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
#ifdef DEBUG_CONFLICT_SETS
{-# LANGUAGE ImplicitParams #-}
#endif
module Distribution.Solver.Modular.Validate (validateTree) where
import Control.Monad (foldM, mzero, liftM2)
import Control.Monad.Reader (MonadReader, Reader, runReader, local, asks)
import Data.Either (lefts)
import Data.Function (on)
import qualified Data.List as L
import qualified Data.Set as S
import Language.Haskell.Extension (Extension, Language)
import Data.Map.Strict as M
import Distribution.Compiler (CompilerInfo(..))
import Distribution.Solver.Modular.Assignment
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
import Distribution.Solver.Modular.Index
import Distribution.Solver.Modular.Package
import Distribution.Solver.Modular.Tree
import Distribution.Solver.Modular.Version
import qualified Distribution.Solver.Modular.WeightedPSQ as W
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent)
import Distribution.Types.LibraryName
import Distribution.Types.PkgconfigVersionRange
#ifdef DEBUG_CONFLICT_SETS
import GHC.Stack (CallStack)
#endif
data ValidateState = VS {
ValidateState -> Extension -> Bool
supportedExt :: Extension -> Bool,
ValidateState -> Language -> Bool
supportedLang :: Language -> Bool,
ValidateState -> PkgconfigName -> PkgconfigVersionRange -> Bool
presentPkgs :: PkgconfigName -> PkgconfigVersionRange -> Bool,
ValidateState -> Index
index :: Index,
ValidateState -> Map QPN (FlaggedDeps QPN)
saved :: Map QPN (FlaggedDeps QPN),
ValidateState -> PreAssignment
pa :: PreAssignment,
ValidateState -> Map QPN (Map ExposedComponent ComponentInfo)
availableComponents :: Map QPN (Map ExposedComponent ComponentInfo),
ValidateState -> Map QPN ComponentDependencyReasons
requiredComponents :: Map QPN ComponentDependencyReasons,
ValidateState -> QualifyOptions
qualifyOptions :: QualifyOptions
}
newtype Validate a = Validate (Reader ValidateState a)
deriving (forall a b. a -> Validate b -> Validate a
forall a b. (a -> b) -> Validate a -> Validate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Validate b -> Validate a
$c<$ :: forall a b. a -> Validate b -> Validate a
fmap :: forall a b. (a -> b) -> Validate a -> Validate b
$cfmap :: forall a b. (a -> b) -> Validate a -> Validate b
Functor, Functor Validate
forall a. a -> Validate a
forall a b. Validate a -> Validate b -> Validate a
forall a b. Validate a -> Validate b -> Validate b
forall a b. Validate (a -> b) -> Validate a -> Validate b
forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Validate a -> Validate b -> Validate a
$c<* :: forall a b. Validate a -> Validate b -> Validate a
*> :: forall a b. Validate a -> Validate b -> Validate b
$c*> :: forall a b. Validate a -> Validate b -> Validate b
liftA2 :: forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Validate a -> Validate b -> Validate c
<*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
$c<*> :: forall a b. Validate (a -> b) -> Validate a -> Validate b
pure :: forall a. a -> Validate a
$cpure :: forall a. a -> Validate a
Applicative, Applicative Validate
forall a. a -> Validate a
forall a b. Validate a -> Validate b -> Validate b
forall a b. Validate a -> (a -> Validate b) -> Validate b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Validate a
$creturn :: forall a. a -> Validate a
>> :: forall a b. Validate a -> Validate b -> Validate b
$c>> :: forall a b. Validate a -> Validate b -> Validate b
>>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
$c>>= :: forall a b. Validate a -> (a -> Validate b) -> Validate b
Monad, MonadReader ValidateState)
runValidate :: Validate a -> ValidateState -> a
runValidate :: forall a. Validate a -> ValidateState -> a
runValidate (Validate Reader ValidateState a
r) = forall r a. Reader r a -> r -> a
runReader Reader ValidateState a
r
data PreAssignment = PA PPreAssignment FAssignment SAssignment
type PPreAssignment = Map QPN MergedPkgDep
data PkgDep = PkgDep (DependencyReason QPN) (PkgComponent QPN) CI
type ComponentDependencyReasons = Map ExposedComponent (DependencyReason QPN)
data MergedPkgDep =
MergedDepFixed ExposedComponent (DependencyReason QPN) I
| MergedDepConstrained [VROrigin]
type VROrigin = (VR, ExposedComponent, DependencyReason QPN)
type Conflict = (ConflictSet, FailReason)
validate :: Tree d c -> Validate (Tree d c)
validate :: forall d c. Tree d c -> Validate (Tree d c)
validate = forall d c. Tree d c -> Validate (Tree d c)
go
where
go :: Tree d c -> Validate (Tree d c)
go :: forall d c. Tree d c -> Validate (Tree d c)
go (PChoice QPN
qpn RevDepMap
rdm c
gr WeightedPSQ [Weight] POption (Tree d c)
ts) = forall d c.
QPN
-> RevDepMap
-> c
-> WeightedPSQ [Weight] POption (Tree d c)
-> Tree d c
PChoice QPN
qpn RevDepMap
rdm c
gr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) k v v' w.
Applicative f =>
(k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
W.traverseWithKey (\POption
k -> forall d c.
QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
goP QPN
qpn POption
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d c. Tree d c -> Validate (Tree d c)
go) WeightedPSQ [Weight] POption (Tree d c)
ts
go (FChoice FN QPN
qfn RevDepMap
rdm c
gr WeakOrTrivial
b FlagType
m Bool
d WeightedPSQ [Weight] Bool (Tree d c)
ts) =
do
PA PPreAssignment
_ FAssignment
pfa SAssignment
_ <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PreAssignment
pa
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FN QPN
qfn FAssignment
pfa of
Just Bool
rb ->
case forall k w v. Eq k => k -> WeightedPSQ w k v -> Maybe v
W.lookup Bool
rb WeightedPSQ [Weight] Bool (Tree d c)
ts of
Just Tree d c
t -> forall d c.
FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goF FN QPN
qfn Bool
rb (forall d c. Tree d c -> Validate (Tree d c)
go Tree d c
t)
Maybe (Tree d c)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (forall qpn. FN qpn -> Var qpn
F FN QPN
qfn)) (FN QPN -> FailReason
MalformedFlagChoice FN QPN
qfn)
Maybe Bool
Nothing ->
forall d c.
FN QPN
-> RevDepMap
-> c
-> WeakOrTrivial
-> FlagType
-> Bool
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
FChoice FN QPN
qfn RevDepMap
rdm c
gr WeakOrTrivial
b FlagType
m Bool
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) k v v' w.
Applicative f =>
(k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
W.traverseWithKey (\Bool
k -> forall d c.
FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goF FN QPN
qfn Bool
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d c. Tree d c -> Validate (Tree d c)
go) WeightedPSQ [Weight] Bool (Tree d c)
ts
go (SChoice SN QPN
qsn RevDepMap
rdm c
gr WeakOrTrivial
b WeightedPSQ [Weight] Bool (Tree d c)
ts) =
do
PA PPreAssignment
_ FAssignment
_ SAssignment
psa <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PreAssignment
pa
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SN QPN
qsn SAssignment
psa of
Just Bool
rb ->
case forall k w v. Eq k => k -> WeightedPSQ w k v -> Maybe v
W.lookup Bool
rb WeightedPSQ [Weight] Bool (Tree d c)
ts of
Just Tree d c
t -> forall d c.
SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goS SN QPN
qsn Bool
rb (forall d c. Tree d c -> Validate (Tree d c)
go Tree d c
t)
Maybe (Tree d c)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (forall qpn. SN qpn -> Var qpn
S SN QPN
qsn)) (SN QPN -> FailReason
MalformedStanzaChoice SN QPN
qsn)
Maybe Bool
Nothing ->
forall d c.
SN QPN
-> RevDepMap
-> c
-> WeakOrTrivial
-> WeightedPSQ [Weight] Bool (Tree d c)
-> Tree d c
SChoice SN QPN
qsn RevDepMap
rdm c
gr WeakOrTrivial
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) k v v' w.
Applicative f =>
(k -> v -> f v') -> WeightedPSQ w k v -> f (WeightedPSQ w k v')
W.traverseWithKey (\Bool
k -> forall d c.
SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goS SN QPN
qsn Bool
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d c. Tree d c -> Validate (Tree d c)
go) WeightedPSQ [Weight] Bool (Tree d c)
ts
go (GoalChoice RevDepMap
rdm PSQ (Goal QPN) (Tree d c)
ts) = forall d c. RevDepMap -> PSQ (Goal QPN) (Tree d c) -> Tree d c
GoalChoice RevDepMap
rdm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall d c. Tree d c -> Validate (Tree d c)
go PSQ (Goal QPN) (Tree d c)
ts
go (Done RevDepMap
rdm d
s ) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall d c. RevDepMap -> d -> Tree d c
Done RevDepMap
rdm d
s)
go (Fail ConflictSet
c FailReason
fr ) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c FailReason
fr)
goP :: QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
goP :: forall d c.
QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c)
goP qpn :: QPN
qpn@(Q PackagePath
_pp PackageName
pn) (POption I
i Maybe PackagePath
_) Validate (Tree d c)
r = do
PA PPreAssignment
ppa FAssignment
pfa SAssignment
psa <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PreAssignment
pa
Extension -> Bool
extSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Extension -> Bool
supportedExt
Language -> Bool
langSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Language -> Bool
supportedLang
PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PkgconfigName -> PkgconfigVersionRange -> Bool
presentPkgs
Index
idx <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Index
index
Map QPN (FlaggedDeps QPN)
svd <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (FlaggedDeps QPN)
saved
Map QPN (Map ExposedComponent ComponentInfo)
aComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (Map ExposedComponent ComponentInfo)
availableComponents
Map QPN ComponentDependencyReasons
rComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN ComponentDependencyReasons
requiredComponents
QualifyOptions
qo <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> QualifyOptions
qualifyOptions
let (PInfo FlaggedDeps PackageName
deps Map ExposedComponent ComponentInfo
comps FlagInfo
_ Maybe FailReason
mfr) = Index
idx forall k a. Ord k => Map k a -> k -> a
! PackageName
pn forall k a. Ord k => Map k a -> k -> a
! I
i
let qdeps :: FlaggedDeps QPN
qdeps = QualifyOptions -> QPN -> FlaggedDeps PackageName -> FlaggedDeps QPN
qualifyDeps QualifyOptions
qo QPN
qpn FlaggedDeps PackageName
deps
let newactives :: [LDep QPN]
newactives = FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
pfa SAssignment
psa FlaggedDeps QPN
qdeps
let mnppa :: Either Conflict PPreAssignment
mnppa = (Extension -> Bool)
-> (Language -> Bool)
-> (PkgconfigName -> PkgconfigVersionRange -> Bool)
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend Extension -> Bool
extSupported Language -> Bool
langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent [LDep QPN]
newactives
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
extendWithPackageChoice (forall qpn. qpn -> I -> PI qpn
PI QPN
qpn I
i) PPreAssignment
ppa
let nsvd :: Map QPN (FlaggedDeps QPN)
nsvd = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QPN
qpn FlaggedDeps QPN
qdeps Map QPN (FlaggedDeps QPN)
svd
case Maybe FailReason
mfr of
Just FailReason
fr ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall d c. ConflictSet -> FailReason -> Tree d c
Fail (Var QPN -> ConflictSet
varToConflictSet (forall qpn. qpn -> Var qpn
P QPN
qpn)) FailReason
fr)
Maybe FailReason
Nothing ->
let newDeps :: Either Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
newDeps :: Either
Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
newDeps = do
PPreAssignment
nppa <- Either Conflict PPreAssignment
mnppa
Map QPN ComponentDependencyReasons
rComps' <- QPN
-> Map QPN (Map ExposedComponent ComponentInfo)
-> Map QPN ComponentDependencyReasons
-> [LDep QPN]
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendRequiredComponents QPN
qpn Map QPN (Map ExposedComponent ComponentInfo)
aComps Map QPN ComponentDependencyReasons
rComps [LDep QPN]
newactives
ComponentDependencyReasons
-> QPN -> Map ExposedComponent ComponentInfo -> Either Conflict ()
checkComponentsInNewPackage (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall k a. Map k a
M.empty QPN
qpn Map QPN ComponentDependencyReasons
rComps) QPN
qpn Map ExposedComponent ComponentInfo
comps
forall (m :: * -> *) a. Monad m => a -> m a
return (PPreAssignment
nppa, Map QPN ComponentDependencyReasons
rComps')
in case Either
Conflict (PPreAssignment, Map QPN ComponentDependencyReasons)
newDeps of
Left (ConflictSet
c, FailReason
fr) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c FailReason
fr)
Right (PPreAssignment
nppa, Map QPN ComponentDependencyReasons
rComps') ->
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ ValidateState
s -> ValidateState
s { pa :: PreAssignment
pa = PPreAssignment -> FAssignment -> SAssignment -> PreAssignment
PA PPreAssignment
nppa FAssignment
pfa SAssignment
psa
, saved :: Map QPN (FlaggedDeps QPN)
saved = Map QPN (FlaggedDeps QPN)
nsvd
, availableComponents :: Map QPN (Map ExposedComponent ComponentInfo)
availableComponents = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QPN
qpn Map ExposedComponent ComponentInfo
comps Map QPN (Map ExposedComponent ComponentInfo)
aComps
, requiredComponents :: Map QPN ComponentDependencyReasons
requiredComponents = Map QPN ComponentDependencyReasons
rComps'
}) Validate (Tree d c)
r
goF :: QFN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goF :: forall d c.
FN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goF qfn :: FN QPN
qfn@(FN QPN
qpn Flag
_f) Bool
b Validate (Tree d c)
r = do
PA PPreAssignment
ppa FAssignment
pfa SAssignment
psa <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PreAssignment
pa
Extension -> Bool
extSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Extension -> Bool
supportedExt
Language -> Bool
langSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Language -> Bool
supportedLang
PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PkgconfigName -> PkgconfigVersionRange -> Bool
presentPkgs
Map QPN (FlaggedDeps QPN)
svd <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (FlaggedDeps QPN)
saved
Map QPN (Map ExposedComponent ComponentInfo)
aComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (Map ExposedComponent ComponentInfo)
availableComponents
Map QPN ComponentDependencyReasons
rComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN ComponentDependencyReasons
requiredComponents
let qdeps :: FlaggedDeps QPN
qdeps = Map QPN (FlaggedDeps QPN)
svd forall k a. Ord k => Map k a -> k -> a
! QPN
qpn
let npfa :: FAssignment
npfa = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FN QPN
qfn Bool
b FAssignment
pfa
let newactives :: [LDep QPN]
newactives = Var QPN
-> Bool
-> FAssignment
-> SAssignment
-> FlaggedDeps QPN
-> [LDep QPN]
extractNewDeps (forall qpn. FN qpn -> Var qpn
F FN QPN
qfn) Bool
b FAssignment
npfa SAssignment
psa FlaggedDeps QPN
qdeps
mNewRequiredComps :: Either Conflict (Map QPN ComponentDependencyReasons)
mNewRequiredComps = QPN
-> Map QPN (Map ExposedComponent ComponentInfo)
-> Map QPN ComponentDependencyReasons
-> [LDep QPN]
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendRequiredComponents QPN
qpn Map QPN (Map ExposedComponent ComponentInfo)
aComps Map QPN ComponentDependencyReasons
rComps [LDep QPN]
newactives
let mnppa :: Either Conflict PPreAssignment
mnppa = (Extension -> Bool)
-> (Language -> Bool)
-> (PkgconfigName -> PkgconfigVersionRange -> Bool)
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend Extension -> Bool
extSupported Language -> Bool
langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent [LDep QPN]
newactives PPreAssignment
ppa
case forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Either Conflict PPreAssignment
mnppa Either Conflict (Map QPN ComponentDependencyReasons)
mNewRequiredComps of
Left (ConflictSet
c, FailReason
fr) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c FailReason
fr)
Right (PPreAssignment
nppa, Map QPN ComponentDependencyReasons
rComps') ->
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ ValidateState
s -> ValidateState
s { pa :: PreAssignment
pa = PPreAssignment -> FAssignment -> SAssignment -> PreAssignment
PA PPreAssignment
nppa FAssignment
npfa SAssignment
psa, requiredComponents :: Map QPN ComponentDependencyReasons
requiredComponents = Map QPN ComponentDependencyReasons
rComps' }) Validate (Tree d c)
r
goS :: QSN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goS :: forall d c.
SN QPN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
goS qsn :: SN QPN
qsn@(SN QPN
qpn Stanza
_f) Bool
b Validate (Tree d c)
r = do
PA PPreAssignment
ppa FAssignment
pfa SAssignment
psa <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PreAssignment
pa
Extension -> Bool
extSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Extension -> Bool
supportedExt
Language -> Bool
langSupported <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Language -> Bool
supportedLang
PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> PkgconfigName -> PkgconfigVersionRange -> Bool
presentPkgs
Map QPN (FlaggedDeps QPN)
svd <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (FlaggedDeps QPN)
saved
Map QPN (Map ExposedComponent ComponentInfo)
aComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN (Map ExposedComponent ComponentInfo)
availableComponents
Map QPN ComponentDependencyReasons
rComps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidateState -> Map QPN ComponentDependencyReasons
requiredComponents
let qdeps :: FlaggedDeps QPN
qdeps = Map QPN (FlaggedDeps QPN)
svd forall k a. Ord k => Map k a -> k -> a
! QPN
qpn
let npsa :: SAssignment
npsa = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SN QPN
qsn Bool
b SAssignment
psa
let newactives :: [LDep QPN]
newactives = Var QPN
-> Bool
-> FAssignment
-> SAssignment
-> FlaggedDeps QPN
-> [LDep QPN]
extractNewDeps (forall qpn. SN qpn -> Var qpn
S SN QPN
qsn) Bool
b FAssignment
pfa SAssignment
npsa FlaggedDeps QPN
qdeps
mNewRequiredComps :: Either Conflict (Map QPN ComponentDependencyReasons)
mNewRequiredComps = QPN
-> Map QPN (Map ExposedComponent ComponentInfo)
-> Map QPN ComponentDependencyReasons
-> [LDep QPN]
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendRequiredComponents QPN
qpn Map QPN (Map ExposedComponent ComponentInfo)
aComps Map QPN ComponentDependencyReasons
rComps [LDep QPN]
newactives
let mnppa :: Either Conflict PPreAssignment
mnppa = (Extension -> Bool)
-> (Language -> Bool)
-> (PkgconfigName -> PkgconfigVersionRange -> Bool)
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend Extension -> Bool
extSupported Language -> Bool
langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent [LDep QPN]
newactives PPreAssignment
ppa
case forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Either Conflict PPreAssignment
mnppa Either Conflict (Map QPN ComponentDependencyReasons)
mNewRequiredComps of
Left (ConflictSet
c, FailReason
fr) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall d c. ConflictSet -> FailReason -> Tree d c
Fail ConflictSet
c FailReason
fr)
Right (PPreAssignment
nppa, Map QPN ComponentDependencyReasons
rComps') ->
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ ValidateState
s -> ValidateState
s { pa :: PreAssignment
pa = PPreAssignment -> FAssignment -> SAssignment -> PreAssignment
PA PPreAssignment
nppa FAssignment
pfa SAssignment
npsa, requiredComponents :: Map QPN ComponentDependencyReasons
requiredComponents = Map QPN ComponentDependencyReasons
rComps' }) Validate (Tree d c)
r
checkComponentsInNewPackage :: ComponentDependencyReasons
-> QPN
-> Map ExposedComponent ComponentInfo
-> Either Conflict ()
checkComponentsInNewPackage :: ComponentDependencyReasons
-> QPN -> Map ExposedComponent ComponentInfo -> Either Conflict ()
checkComponentsInNewPackage ComponentDependencyReasons
required QPN
qpn Map ExposedComponent ComponentInfo
providedComps =
case forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [k] -> Map k v -> Map k v
deleteKeys (forall k a. Map k a -> [k]
M.keys Map ExposedComponent ComponentInfo
providedComps) ComponentDependencyReasons
required of
(ExposedComponent
missingComp, DependencyReason QPN
dr) : [(ExposedComponent, DependencyReason QPN)]
_ ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ExposedComponent
-> DependencyReason QPN
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
-> Conflict
mkConflict ExposedComponent
missingComp DependencyReason QPN
dr ExposedComponent -> DependencyReason QPN -> FailReason
NewPackageIsMissingRequiredComponent
[] ->
let failures :: [Conflict]
failures = forall a b. [Either a b] -> [a]
lefts
[ case () of
()
_ | ComponentInfo -> IsVisible
compIsVisible ComponentInfo
compInfo forall a. Eq a => a -> a -> Bool
== Bool -> IsVisible
IsVisible Bool
False ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ExposedComponent
-> DependencyReason QPN
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
-> Conflict
mkConflict ExposedComponent
comp DependencyReason QPN
dr ExposedComponent -> DependencyReason QPN -> FailReason
NewPackageHasPrivateRequiredComponent
| ComponentInfo -> IsBuildable
compIsBuildable ComponentInfo
compInfo forall a. Eq a => a -> a -> Bool
== Bool -> IsBuildable
IsBuildable Bool
False ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ExposedComponent
-> DependencyReason QPN
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
-> Conflict
mkConflict ExposedComponent
comp DependencyReason QPN
dr ExposedComponent -> DependencyReason QPN -> FailReason
NewPackageHasUnbuildableRequiredComponent
| Bool
otherwise -> forall a b. b -> Either a b
Right ()
| let merged :: Map ExposedComponent (DependencyReason QPN, ComponentInfo)
merged = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith (,) ComponentDependencyReasons
required Map ExposedComponent ComponentInfo
providedComps
, (ExposedComponent
comp, (DependencyReason QPN
dr, ComponentInfo
compInfo)) <- forall k a. Map k a -> [(k, a)]
M.toList Map ExposedComponent (DependencyReason QPN, ComponentInfo)
merged ]
in case [Conflict]
failures of
Conflict
failure : [Conflict]
_ -> forall a b. a -> Either a b
Left Conflict
failure
[] -> forall a b. b -> Either a b
Right ()
where
mkConflict :: ExposedComponent
-> DependencyReason QPN
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
-> Conflict
mkConflict :: ExposedComponent
-> DependencyReason QPN
-> (ExposedComponent -> DependencyReason QPN -> FailReason)
-> Conflict
mkConflict ExposedComponent
comp DependencyReason QPN
dr ExposedComponent -> DependencyReason QPN -> FailReason
mkFailure =
(Var QPN -> ConflictSet -> ConflictSet
CS.insert (forall qpn. qpn -> Var qpn
P QPN
qpn) (DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
dr), ExposedComponent -> DependencyReason QPN -> FailReason
mkFailure ExposedComponent
comp DependencyReason QPN
dr)
deleteKeys :: Ord k => [k] -> Map k v -> Map k v
deleteKeys :: forall k v. Ord k => [k] -> Map k v -> Map k v
deleteKeys [k]
ks Map k v
m = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr forall k a. Ord k => k -> Map k a -> Map k a
M.delete Map k v
m [k]
ks
extractAllDeps :: FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
FAssignment
fa SAssignment
sa FlaggedDeps QPN
deps = do
FlaggedDep QPN
d <- FlaggedDeps QPN
deps
case FlaggedDep QPN
d of
Simple LDep QPN
sd Component
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return LDep QPN
sd
Flagged FN QPN
qfn FInfo
_ FlaggedDeps QPN
td FlaggedDeps QPN
fd -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FN QPN
qfn FAssignment
fa of
Maybe Bool
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Bool
True -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
td
Just Bool
False -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
fd
Stanza SN QPN
qsn FlaggedDeps QPN
td -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SN QPN
qsn SAssignment
sa of
Maybe Bool
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Bool
True -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
td
Just Bool
False -> []
extractNewDeps :: Var QPN -> Bool -> FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
Var QPN
v Bool
b FAssignment
fa SAssignment
sa = FlaggedDeps QPN -> [LDep QPN]
go
where
go :: FlaggedDeps QPN -> [LDep QPN]
go :: FlaggedDeps QPN -> [LDep QPN]
go FlaggedDeps QPN
deps = do
FlaggedDep QPN
d <- FlaggedDeps QPN
deps
case FlaggedDep QPN
d of
Simple LDep QPN
_ Component
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Flagged FN QPN
qfn' FInfo
_ FlaggedDeps QPN
td FlaggedDeps QPN
fd
| Var QPN
v forall a. Eq a => a -> a -> Bool
== forall qpn. FN qpn -> Var qpn
F FN QPN
qfn' -> if Bool
b then FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
td else FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
fd
| Bool
otherwise -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FN QPN
qfn' FAssignment
fa of
Maybe Bool
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Bool
True -> FlaggedDeps QPN -> [LDep QPN]
go FlaggedDeps QPN
td
Just Bool
False -> FlaggedDeps QPN -> [LDep QPN]
go FlaggedDeps QPN
fd
Stanza SN QPN
qsn' FlaggedDeps QPN
td
| Var QPN
v forall a. Eq a => a -> a -> Bool
== forall qpn. SN qpn -> Var qpn
S SN QPN
qsn' -> if Bool
b then FAssignment -> SAssignment -> FlaggedDeps QPN -> [LDep QPN]
extractAllDeps FAssignment
fa SAssignment
sa FlaggedDeps QPN
td else []
| Bool
otherwise -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SN QPN
qsn' SAssignment
sa of
Maybe Bool
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Bool
True -> FlaggedDeps QPN -> [LDep QPN]
go FlaggedDeps QPN
td
Just Bool
False -> []
extend :: (Extension -> Bool)
-> (Language -> Bool)
-> (PkgconfigName -> PkgconfigVersionRange -> Bool)
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend :: (Extension -> Bool)
-> (Language -> Bool)
-> (PkgconfigName -> PkgconfigVersionRange -> Bool)
-> [LDep QPN]
-> PPreAssignment
-> Either Conflict PPreAssignment
extend Extension -> Bool
extSupported Language -> Bool
langSupported PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent [LDep QPN]
newactives PPreAssignment
ppa = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
extendSingle PPreAssignment
ppa [LDep QPN]
newactives
where
extendSingle :: PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
extendSingle :: PPreAssignment -> LDep QPN -> Either Conflict PPreAssignment
extendSingle PPreAssignment
a (LDep DependencyReason QPN
dr (Ext Extension
ext )) =
if Extension -> Bool
extSupported Extension
ext then forall a b. b -> Either a b
Right PPreAssignment
a
else forall a b. a -> Either a b
Left (DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
dr, Extension -> FailReason
UnsupportedExtension Extension
ext)
extendSingle PPreAssignment
a (LDep DependencyReason QPN
dr (Lang Language
lang)) =
if Language -> Bool
langSupported Language
lang then forall a b. b -> Either a b
Right PPreAssignment
a
else forall a b. a -> Either a b
Left (DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
dr, Language -> FailReason
UnsupportedLanguage Language
lang)
extendSingle PPreAssignment
a (LDep DependencyReason QPN
dr (Pkg PkgconfigName
pn PkgconfigVersionRange
vr)) =
if PkgconfigName -> PkgconfigVersionRange -> Bool
pkgPresent PkgconfigName
pn PkgconfigVersionRange
vr then forall a b. b -> Either a b
Right PPreAssignment
a
else forall a b. a -> Either a b
Left (DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
dr, PkgconfigName -> PkgconfigVersionRange -> FailReason
MissingPkgconfigPackage PkgconfigName
pn PkgconfigVersionRange
vr)
extendSingle PPreAssignment
a (LDep DependencyReason QPN
dr (Dep dep :: PkgComponent QPN
dep@(PkgComponent QPN
qpn ExposedComponent
_) CI
ci)) =
let mergedDep :: MergedPkgDep
mergedDep = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([VROrigin] -> MergedPkgDep
MergedDepConstrained []) QPN
qpn PPreAssignment
a
in case (\ MergedPkgDep
x -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QPN
qpn MergedPkgDep
x PPreAssignment
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MergedPkgDep
-> PkgDep
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
merge MergedPkgDep
mergedDep (DependencyReason QPN -> PkgComponent QPN -> CI -> PkgDep
PkgDep DependencyReason QPN
dr PkgComponent QPN
dep CI
ci) of
Left (ConflictSet
c, (ConflictingDep
d, ConflictingDep
d')) -> forall a b. a -> Either a b
Left (ConflictSet
c, ConflictingDep -> ConflictingDep -> FailReason
ConflictingConstraints ConflictingDep
d ConflictingDep
d')
Right PPreAssignment
x -> forall a b. b -> Either a b
Right PPreAssignment
x
extendWithPackageChoice :: PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
extendWithPackageChoice :: PI QPN -> PPreAssignment -> Either Conflict PPreAssignment
extendWithPackageChoice (PI QPN
qpn I
i) PPreAssignment
ppa =
let mergedDep :: MergedPkgDep
mergedDep = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([VROrigin] -> MergedPkgDep
MergedDepConstrained []) QPN
qpn PPreAssignment
ppa
newChoice :: PkgDep
newChoice = DependencyReason QPN -> PkgComponent QPN -> CI -> PkgDep
PkgDep (forall qpn.
qpn -> Map Flag FlagValue -> Set Stanza -> DependencyReason qpn
DependencyReason QPN
qpn forall k a. Map k a
M.empty forall a. Set a
S.empty)
(forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
qpn (LibraryName -> ExposedComponent
ExposedLib LibraryName
LMainLibName))
(I -> CI
Fixed I
i)
in case (\ MergedPkgDep
x -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QPN
qpn MergedPkgDep
x PPreAssignment
ppa) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MergedPkgDep
-> PkgDep
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
merge MergedPkgDep
mergedDep PkgDep
newChoice of
Left (ConflictSet
c, (ConflictingDep
d, ConflictingDep
_d')) ->
forall a b. a -> Either a b
Left (ConflictSet
c, ConflictingDep -> FailReason
NewPackageDoesNotMatchExistingConstraint ConflictingDep
d)
Right PPreAssignment
x -> forall a b. b -> Either a b
Right PPreAssignment
x
merge ::
#ifdef DEBUG_CONFLICT_SETS
(?loc :: CallStack) =>
#endif
MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
merge :: MergedPkgDep
-> PkgDep
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
merge (MergedDepFixed ExposedComponent
comp1 DependencyReason QPN
vs1 I
i1) (PkgDep DependencyReason QPN
vs2 (PkgComponent QPN
p ExposedComponent
comp2) ci :: CI
ci@(Fixed I
i2))
| I
i1 forall a. Eq a => a -> a -> Bool
== I
i2 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
MergedDepFixed ExposedComponent
comp1 DependencyReason QPN
vs1 I
i1
| Bool
otherwise =
forall a b. a -> Either a b
Left ( (ConflictSet -> ConflictSet -> ConflictSet
CS.union forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet) DependencyReason QPN
vs1 DependencyReason QPN
vs2
, ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs1 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp1) (I -> CI
Fixed I
i1)
, DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs2 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp2) CI
ci ) )
merge (MergedDepFixed ExposedComponent
comp1 DependencyReason QPN
vs1 i :: I
i@(I Ver
v Loc
_)) (PkgDep DependencyReason QPN
vs2 (PkgComponent QPN
p ExposedComponent
comp2) ci :: CI
ci@(Constrained VR
vr))
| VR -> Ver -> Bool
checkVR VR
vr Ver
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
MergedDepFixed ExposedComponent
comp1 DependencyReason QPN
vs1 I
i
| Bool
otherwise =
forall a b. a -> Either a b
Left ( QPN
-> Ver
-> DependencyReason QPN
-> VR
-> DependencyReason QPN
-> ConflictSet
createConflictSetForVersionConflict QPN
p Ver
v DependencyReason QPN
vs1 VR
vr DependencyReason QPN
vs2
, ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs1 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp1) (I -> CI
Fixed I
i)
, DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs2 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp2) CI
ci ) )
merge (MergedDepConstrained [VROrigin]
vrOrigins) (PkgDep DependencyReason QPN
vs2 (PkgComponent QPN
p ExposedComponent
comp2) ci :: CI
ci@(Fixed i :: I
i@(I Ver
v Loc
_))) =
[VROrigin]
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
go [VROrigin]
vrOrigins
where
go :: [VROrigin] -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
go :: [VROrigin]
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
go [] = forall a b. b -> Either a b
Right (ExposedComponent -> DependencyReason QPN -> I -> MergedPkgDep
MergedDepFixed ExposedComponent
comp2 DependencyReason QPN
vs2 I
i)
go ((VR
vr, ExposedComponent
comp1, DependencyReason QPN
vs1) : [VROrigin]
vros)
| VR -> Ver -> Bool
checkVR VR
vr Ver
v = [VROrigin]
-> Either
(ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep
go [VROrigin]
vros
| Bool
otherwise =
forall a b. a -> Either a b
Left ( QPN
-> Ver
-> DependencyReason QPN
-> VR
-> DependencyReason QPN
-> ConflictSet
createConflictSetForVersionConflict QPN
p Ver
v DependencyReason QPN
vs2 VR
vr DependencyReason QPN
vs1
, ( DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs1 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp1) (VR -> CI
Constrained VR
vr)
, DependencyReason QPN -> PkgComponent QPN -> CI -> ConflictingDep
ConflictingDep DependencyReason QPN
vs2 (forall qpn. qpn -> ExposedComponent -> PkgComponent qpn
PkgComponent QPN
p ExposedComponent
comp2) CI
ci ) )
merge (MergedDepConstrained [VROrigin]
vrOrigins) (PkgDep DependencyReason QPN
vs2 (PkgComponent QPN
_ ExposedComponent
comp2) (Constrained VR
vr)) =
forall a b. b -> Either a b
Right ([VROrigin] -> MergedPkgDep
MergedDepConstrained forall a b. (a -> b) -> a -> b
$
[VROrigin]
vrOrigins forall a. [a] -> [a] -> [a]
++ [(VR
vr, ExposedComponent
comp2, DependencyReason QPN
vs2)])
createConflictSetForVersionConflict :: QPN
-> Ver
-> DependencyReason QPN
-> VR
-> DependencyReason QPN
-> ConflictSet
createConflictSetForVersionConflict :: QPN
-> Ver
-> DependencyReason QPN
-> VR
-> DependencyReason QPN
-> ConflictSet
createConflictSetForVersionConflict QPN
pkg
Ver
conflictingVersion
versionDR :: DependencyReason QPN
versionDR@(DependencyReason QPN
p1 Map Flag FlagValue
_ Set Stanza
_)
VR
conflictingVersionRange
versionRangeDR :: DependencyReason QPN
versionRangeDR@(DependencyReason QPN
p2 Map Flag FlagValue
_ Set Stanza
_) =
let hasFlagsOrStanzas :: DependencyReason qpn -> Bool
hasFlagsOrStanzas (DependencyReason qpn
_ Map Flag FlagValue
fs Set Stanza
ss) = Bool -> Bool
not (forall k a. Map k a -> Bool
M.null Map Flag FlagValue
fs) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Set a -> Bool
S.null Set Stanza
ss)
in
if QPN
p1 forall a. Eq a => a -> a -> Bool
== QPN
pkg Bool -> Bool -> Bool
&& Bool -> Bool
not (forall {qpn}. DependencyReason qpn -> Bool
hasFlagsOrStanzas DependencyReason QPN
versionDR) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall {qpn}. DependencyReason qpn -> Bool
hasFlagsOrStanzas DependencyReason QPN
versionRangeDR)
then let cs1 :: ConflictSet
cs1 = QPN -> OrderedVersionRange -> DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSetWithVersionConflict
QPN
p2
(VR -> OrderedVersionRange
CS.OrderedVersionRange VR
conflictingVersionRange)
DependencyReason QPN
versionDR
cs2 :: ConflictSet
cs2 = QPN -> Ver -> DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSetWithVersionConstraintConflict
QPN
pkg Ver
conflictingVersion DependencyReason QPN
versionRangeDR
in ConflictSet
cs1 ConflictSet -> ConflictSet -> ConflictSet
`CS.union` ConflictSet
cs2
else DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
versionRangeDR ConflictSet -> ConflictSet -> ConflictSet
`CS.union` DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
versionDR
extendRequiredComponents :: QPN
-> Map QPN (Map ExposedComponent ComponentInfo)
-> Map QPN ComponentDependencyReasons
-> [LDep QPN]
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendRequiredComponents :: QPN
-> Map QPN (Map ExposedComponent ComponentInfo)
-> Map QPN ComponentDependencyReasons
-> [LDep QPN]
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendRequiredComponents QPN
eqpn Map QPN (Map ExposedComponent ComponentInfo)
available = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map QPN ComponentDependencyReasons
-> LDep QPN -> Either Conflict (Map QPN ComponentDependencyReasons)
extendSingle
where
extendSingle :: Map QPN ComponentDependencyReasons
-> LDep QPN
-> Either Conflict (Map QPN ComponentDependencyReasons)
extendSingle :: Map QPN ComponentDependencyReasons
-> LDep QPN -> Either Conflict (Map QPN ComponentDependencyReasons)
extendSingle Map QPN ComponentDependencyReasons
required (LDep DependencyReason QPN
dr (Dep (PkgComponent QPN
qpn ExposedComponent
comp) CI
_)) =
let compDeps :: ComponentDependencyReasons
compDeps = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall k a. Map k a
M.empty QPN
qpn Map QPN ComponentDependencyReasons
required
success :: Either a (Map QPN ComponentDependencyReasons)
success = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union QPN
qpn (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ExposedComponent
comp DependencyReason QPN
dr ComponentDependencyReasons
compDeps) Map QPN ComponentDependencyReasons
required
in
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup QPN
qpn Map QPN (Map ExposedComponent ComponentInfo)
available of
Just Map ExposedComponent ComponentInfo
comps ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExposedComponent
comp Map ExposedComponent ComponentInfo
comps of
Maybe ComponentInfo
Nothing ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ QPN
-> ExposedComponent
-> DependencyReason QPN
-> (QPN -> ExposedComponent -> FailReason)
-> Conflict
mkConflict QPN
qpn ExposedComponent
comp DependencyReason QPN
dr QPN -> ExposedComponent -> FailReason
PackageRequiresMissingComponent
Just ComponentInfo
compInfo
| ComponentInfo -> IsVisible
compIsVisible ComponentInfo
compInfo forall a. Eq a => a -> a -> Bool
== Bool -> IsVisible
IsVisible Bool
False
, QPN
eqpn forall a. Eq a => a -> a -> Bool
/= QPN
qpn
->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ QPN
-> ExposedComponent
-> DependencyReason QPN
-> (QPN -> ExposedComponent -> FailReason)
-> Conflict
mkConflict QPN
qpn ExposedComponent
comp DependencyReason QPN
dr QPN -> ExposedComponent -> FailReason
PackageRequiresPrivateComponent
| ComponentInfo -> IsBuildable
compIsBuildable ComponentInfo
compInfo forall a. Eq a => a -> a -> Bool
== Bool -> IsBuildable
IsBuildable Bool
False ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ QPN
-> ExposedComponent
-> DependencyReason QPN
-> (QPN -> ExposedComponent -> FailReason)
-> Conflict
mkConflict QPN
qpn ExposedComponent
comp DependencyReason QPN
dr QPN -> ExposedComponent -> FailReason
PackageRequiresUnbuildableComponent
| Bool
otherwise -> forall {a}. Either a (Map QPN ComponentDependencyReasons)
success
Maybe (Map ExposedComponent ComponentInfo)
Nothing -> forall {a}. Either a (Map QPN ComponentDependencyReasons)
success
extendSingle Map QPN ComponentDependencyReasons
required LDep QPN
_ = forall a b. b -> Either a b
Right Map QPN ComponentDependencyReasons
required
mkConflict :: QPN
-> ExposedComponent
-> DependencyReason QPN
-> (QPN -> ExposedComponent -> FailReason)
-> Conflict
mkConflict :: QPN
-> ExposedComponent
-> DependencyReason QPN
-> (QPN -> ExposedComponent -> FailReason)
-> Conflict
mkConflict QPN
qpn ExposedComponent
comp DependencyReason QPN
dr QPN -> ExposedComponent -> FailReason
mkFailure =
(Var QPN -> ConflictSet -> ConflictSet
CS.insert (forall qpn. qpn -> Var qpn
P QPN
qpn) (DependencyReason QPN -> ConflictSet
dependencyReasonToConflictSet DependencyReason QPN
dr), QPN -> ExposedComponent -> FailReason
mkFailure QPN
qpn ExposedComponent
comp)
validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
validateTree :: forall d c.
CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c
validateTree CompilerInfo
cinfo Index
idx PkgConfigDb
pkgConfigDb Tree d c
t = forall a. Validate a -> ValidateState -> a
runValidate (forall d c. Tree d c -> Validate (Tree d c)
validate Tree d c
t) VS {
supportedExt :: Extension -> Bool
supportedExt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True)
(\ [Extension]
es -> let s :: Set Extension
s = forall a. Ord a => [a] -> Set a
S.fromList [Extension]
es in \ Extension
x -> forall a. Ord a => a -> Set a -> Bool
S.member Extension
x Set Extension
s)
(CompilerInfo -> Maybe [Extension]
compilerInfoExtensions CompilerInfo
cinfo)
, supportedLang :: Language -> Bool
supportedLang = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True)
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.elem)
(CompilerInfo -> Maybe [Language]
compilerInfoLanguages CompilerInfo
cinfo)
, presentPkgs :: PkgconfigName -> PkgconfigVersionRange -> Bool
presentPkgs = PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
pkgConfigPkgIsPresent PkgConfigDb
pkgConfigDb
, index :: Index
index = Index
idx
, saved :: Map QPN (FlaggedDeps QPN)
saved = forall k a. Map k a
M.empty
, pa :: PreAssignment
pa = PPreAssignment -> FAssignment -> SAssignment -> PreAssignment
PA forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty
, availableComponents :: Map QPN (Map ExposedComponent ComponentInfo)
availableComponents = forall k a. Map k a
M.empty
, requiredComponents :: Map QPN ComponentDependencyReasons
requiredComponents = forall k a. Map k a
M.empty
, qualifyOptions :: QualifyOptions
qualifyOptions = Index -> QualifyOptions
defaultQualifyOptions Index
idx
}