{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Distribution.PackageDescription.Configuration (
finalizePD,
flattenPackageDescription,
parseCondition,
freeVars,
extractCondition,
extractConditions,
addBuildableCondition,
mapCondTree,
mapTreeData,
mapTreeConds,
mapTreeConstrs,
transformAllBuildInfos,
transformAllBuildDepends,
transformAllBuildDependsN,
) where
import Distribution.Compat.Prelude
import Prelude ()
import qualified Distribution.Types.BuildInfo.Lens as L
import qualified Distribution.Types.GenericPackageDescription.Lens as L
import qualified Distribution.Types.PackageDescription.Lens as L
import qualified Distribution.Types.SetupBuildInfo.Lens as L
import Distribution.Compat.CharParsing hiding (char)
import qualified Distribution.Compat.CharParsing as P
import Distribution.Compat.Lens
import Distribution.Compiler
import Distribution.PackageDescription
import Distribution.PackageDescription.Utils
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.Component
import Distribution.Utils.Path
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.DependencyMap
import Distribution.Types.PackageVersionConstraint
import Distribution.Version
import qualified Data.Map.Lazy as Map
import Data.Tree (Tree (Node))
simplifyWithSysParams :: OS -> Arch -> CompilerInfo -> Condition ConfVar
-> (Condition FlagName, [FlagName])
simplifyWithSysParams :: OS
-> Arch
-> CompilerInfo
-> Condition ConfVar
-> (Condition FlagName, [FlagName])
simplifyWithSysParams OS
os Arch
arch CompilerInfo
cinfo Condition ConfVar
cond = (Condition FlagName
cond', [FlagName]
flags)
where
(Condition FlagName
cond', [FlagName]
flags) = forall c d.
Condition c -> (c -> Either d Bool) -> (Condition d, [d])
simplifyCondition Condition ConfVar
cond ConfVar -> Either FlagName Bool
interp
interp :: ConfVar -> Either FlagName Bool
interp (OS OS
os') = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ OS
os' forall a. Eq a => a -> a -> Bool
== OS
os
interp (Arch Arch
arch') = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Arch
arch' forall a. Eq a => a -> a -> Bool
== Arch
arch
interp (Impl CompilerFlavor
comp VersionRange
vr)
| CompilerId -> Bool
matchImpl (CompilerInfo -> CompilerId
compilerInfoId CompilerInfo
cinfo) = forall a b. b -> Either a b
Right Bool
True
| Bool
otherwise = case CompilerInfo -> Maybe [CompilerId]
compilerInfoCompat CompilerInfo
cinfo of
Maybe [CompilerId]
Nothing -> forall a b. b -> Either a b
Right Bool
False
Just [CompilerId]
compat -> forall a b. b -> Either a b
Right (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CompilerId -> Bool
matchImpl [CompilerId]
compat)
where
matchImpl :: CompilerId -> Bool
matchImpl (CompilerId CompilerFlavor
c Version
v) = CompilerFlavor
comp forall a. Eq a => a -> a -> Bool
== CompilerFlavor
c Bool -> Bool -> Bool
&& Version
v Version -> VersionRange -> Bool
`withinRange` VersionRange
vr
interp (PackageFlag FlagName
f) = forall a b. a -> Either a b
Left FlagName
f
parseCondition :: CabalParsing m => m (Condition ConfVar)
parseCondition :: forall (m :: * -> *). CabalParsing m => m (Condition ConfVar)
parseCondition = m (Condition ConfVar)
condOr
where
condOr :: m (Condition ConfVar)
condOr = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty m (Condition ConfVar)
condAnd (String -> m ()
oper String
"||") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 forall c. Condition c -> Condition c -> Condition c
COr
condAnd :: m (Condition ConfVar)
condAnd = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepByNonEmpty m (Condition ConfVar)
cond (String -> m ()
oper String
"&&")forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 forall c. Condition c -> Condition c -> Condition c
CAnd
cond :: m (Condition ConfVar)
cond = m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall {c}. m (Condition c)
boolLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. m a -> m a
inparens m (Condition ConfVar)
condOr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Condition ConfVar)
notCond forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Condition ConfVar)
osCond
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Condition ConfVar)
archCond forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Condition ConfVar)
flagCond forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Condition ConfVar)
implCond )
inparens :: m a -> m a
inparens = forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp) (m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp)
notCond :: m (Condition ConfVar)
notCond = forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Condition ConfVar)
cond forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Condition c -> Condition c
CNot
osCond :: m (Condition ConfVar)
osCond = forall (m :: * -> *). CharParsing m => String -> m String
string String
"os" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. m a -> m a
inparens m ConfVar
osIdent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. c -> Condition c
Var
archCond :: m (Condition ConfVar)
archCond = forall (m :: * -> *). CharParsing m => String -> m String
string String
"arch" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. m a -> m a
inparens m ConfVar
archIdent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. c -> Condition c
Var
flagCond :: m (Condition ConfVar)
flagCond = forall (m :: * -> *). CharParsing m => String -> m String
string String
"flag" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. m a -> m a
inparens m ConfVar
flagIdent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. c -> Condition c
Var
implCond :: m (Condition ConfVar)
implCond = forall (m :: * -> *). CharParsing m => String -> m String
string String
"impl" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. m a -> m a
inparens m ConfVar
implIdent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. c -> Condition c
Var
boolLiteral :: m (Condition c)
boolLiteral = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. Bool -> Condition c
Lit forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
archIdent :: m ConfVar
archIdent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arch -> ConfVar
Arch forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
osIdent :: m ConfVar
osIdent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OS -> ConfVar
OS forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
flagIdent :: m ConfVar
flagIdent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FlagName -> ConfVar
PackageFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FlagName
mkFlagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
lowercase) (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
munch1 Char -> Bool
isIdentChar)
isIdentChar :: Char -> Bool
isIdentChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
oper :: String -> m ()
oper String
s = m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). CharParsing m => String -> m String
string String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
sp
sp :: m ()
sp = forall (m :: * -> *). CharParsing m => m ()
spaces
implIdent :: m ConfVar
implIdent = do CompilerFlavor
i <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
VersionRange
vr <- m ()
sp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option VersionRange
anyVersion forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> VersionRange -> ConfVar
Impl CompilerFlavor
i VersionRange
vr
data DepTestRslt d = DepOk | MissingDeps d
instance Semigroup d => Monoid (DepTestRslt d) where
mempty :: DepTestRslt d
mempty = forall d. DepTestRslt d
DepOk
mappend :: DepTestRslt d -> DepTestRslt d -> DepTestRslt d
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup d => Semigroup (DepTestRslt d) where
DepTestRslt d
DepOk <> :: DepTestRslt d -> DepTestRslt d -> DepTestRslt d
<> DepTestRslt d
x = DepTestRslt d
x
DepTestRslt d
x <> DepTestRslt d
DepOk = DepTestRslt d
x
(MissingDeps d
d) <> (MissingDeps d
d') = forall d. d -> DepTestRslt d
MissingDeps (d
d forall a. Semigroup a => a -> a -> a
<> d
d')
resolveWithFlags ::
[(FlagName,[Bool])]
-> ComponentRequestedSpec
-> OS
-> Arch
-> CompilerInfo
-> [PackageVersionConstraint]
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency])
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
resolveWithFlags :: [(FlagName, [Bool])]
-> ComponentRequestedSpec
-> OS
-> Arch
-> CompilerInfo
-> [PackageVersionConstraint]
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency])
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
resolveWithFlags [(FlagName, [Bool])]
dom ComponentRequestedSpec
enabled OS
os Arch
arch CompilerInfo
impl [PackageVersionConstraint]
constrs [CondTree ConfVar [Dependency] PDTagged]
trees [Dependency] -> DepTestRslt [Dependency]
checkDeps =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepMapUnion -> [Dependency]
fromDepMapUnion) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Tree FlagAssignment
-> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
explore (FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
build forall a. Monoid a => a
mempty [(FlagName, [Bool])]
dom)
where
simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
simplifiedTrees = forall a b. (a -> b) -> [a] -> [b]
map ( forall c d v a. (c -> d) -> CondTree v c a -> CondTree v d a
mapTreeConstrs [Dependency] -> DependencyMap
toDepMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c.
(Eq v, Monoid c) =>
CondTree v c PDTagged -> CondTree v c PDTagged
addBuildableConditionPDTagged
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v w c a.
(Condition v -> Condition w) -> CondTree v c a -> CondTree w c a
mapTreeConds (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. OS
-> Arch
-> CompilerInfo
-> Condition ConfVar
-> (Condition FlagName, [FlagName])
simplifyWithSysParams OS
os Arch
arch CompilerInfo
impl))
[CondTree ConfVar [Dependency] PDTagged]
trees
explore :: Tree FlagAssignment
-> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
explore :: Tree FlagAssignment
-> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
explore (Node FlagAssignment
flags [Tree FlagAssignment]
ts) =
let targetSet :: TargetSet PDTagged
targetSet = forall a. [(DependencyMap, a)] -> TargetSet a
TargetSet forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [CondTree FlagName DependencyMap PDTagged]
simplifiedTrees forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (DependencyMap -> [PackageVersionConstraint] -> DependencyMap
`constrainBy` [PackageVersionConstraint]
constrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a d v.
(Semigroup a, Semigroup d) =>
(v -> Either v Bool) -> CondTree v d a -> (d, a)
simplifyCondTree (FlagAssignment -> FlagName -> Either FlagName Bool
env FlagAssignment
flags)
deps :: DependencyMap
deps = ComponentRequestedSpec -> TargetSet PDTagged -> DependencyMap
overallDependencies ComponentRequestedSpec
enabled TargetSet PDTagged
targetSet
in case [Dependency] -> DepTestRslt [Dependency]
checkDeps (DependencyMap -> [Dependency]
fromDepMap DependencyMap
deps) of
DepTestRslt [Dependency]
DepOk | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree FlagAssignment]
ts -> forall a b. b -> Either a b
Right (TargetSet PDTagged
targetSet, FlagAssignment
flags)
| Bool
otherwise -> forall a. [Either DepMapUnion a] -> Either DepMapUnion a
tryAll forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Tree FlagAssignment
-> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
explore [Tree FlagAssignment]
ts
MissingDeps [Dependency]
mds -> forall a b. a -> Either a b
Left ([Dependency] -> DepMapUnion
toDepMapUnion [Dependency]
mds)
build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
build FlagAssignment
assigned [] = forall a. a -> [Tree a] -> Tree a
Node FlagAssignment
assigned []
build FlagAssignment
assigned ((FlagName
fn, [Bool]
vals) : [(FlagName, [Bool])]
unassigned) =
forall a. a -> [Tree a] -> Tree a
Node FlagAssignment
assigned forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Bool
v -> FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
build (FlagName -> Bool -> FlagAssignment -> FlagAssignment
insertFlagAssignment FlagName
fn Bool
v FlagAssignment
assigned) [(FlagName, [Bool])]
unassigned) [Bool]
vals
tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a
tryAll :: forall a. [Either DepMapUnion a] -> Either DepMapUnion a
tryAll = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a.
Either DepMapUnion a
-> Either DepMapUnion a -> Either DepMapUnion a
mp forall a. Either DepMapUnion a
mz
mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a
mp :: forall a.
Either DepMapUnion a
-> Either DepMapUnion a -> Either DepMapUnion a
mp m :: Either DepMapUnion a
m@(Right a
_) Either DepMapUnion a
_ = Either DepMapUnion a
m
mp Either DepMapUnion a
_ m :: Either DepMapUnion a
m@(Right a
_) = Either DepMapUnion a
m
mp (Left DepMapUnion
xs) (Left DepMapUnion
ys) = forall a b. a -> Either a b
Left (DepMapUnion
xs forall a. Semigroup a => a -> a -> a
<> DepMapUnion
ys)
mz :: Either DepMapUnion a
mz :: forall a. Either DepMapUnion a
mz = forall a b. a -> Either a b
Left (Map PackageName (VersionRange, NonEmptySet LibraryName)
-> DepMapUnion
DepMapUnion forall k a. Map k a
Map.empty)
env :: FlagAssignment -> FlagName -> Either FlagName Bool
env :: FlagAssignment -> FlagName -> Either FlagName Bool
env FlagAssignment
flags FlagName
flag = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FlagName
flag) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> FlagAssignment -> Maybe Bool
lookupFlagAssignment FlagName
flag) FlagAssignment
flags
addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo)
-> CondTree v c a
-> CondTree v c a
addBuildableCondition :: forall v a c.
(Eq v, Monoid a, Monoid c) =>
(a -> BuildInfo) -> CondTree v c a -> CondTree v c a
addBuildableCondition a -> BuildInfo
getInfo CondTree v c a
t =
case forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuildInfo
getInfo) CondTree v c a
t of
Lit Bool
True -> CondTree v c a
t
Lit Bool
False -> forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty []
Condition v
c -> forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty [forall v c a. Condition v -> CondTree v c a -> CondBranch v c a
condIfThen Condition v
c CondTree v c a
t]
addBuildableConditionPDTagged :: (Eq v, Monoid c) =>
CondTree v c PDTagged
-> CondTree v c PDTagged
addBuildableConditionPDTagged :: forall v c.
(Eq v, Monoid c) =>
CondTree v c PDTagged -> CondTree v c PDTagged
addBuildableConditionPDTagged CondTree v c PDTagged
t =
case forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. PDTagged -> BuildInfo
getInfo) CondTree v c PDTagged
t of
Lit Bool
True -> CondTree v c PDTagged
t
Lit Bool
False -> forall {v} {c} {a}. CondTree v c a -> CondTree v c a
deleteConstraints CondTree v c PDTagged
t
Condition v
c -> forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty [forall v c a.
Condition v -> CondTree v c a -> CondTree v c a -> CondBranch v c a
condIfThenElse Condition v
c CondTree v c PDTagged
t (forall {v} {c} {a}. CondTree v c a -> CondTree v c a
deleteConstraints CondTree v c PDTagged
t)]
where
deleteConstraints :: CondTree v c a -> CondTree v c a
deleteConstraints = forall c d v a. (c -> d) -> CondTree v c a -> CondTree v d a
mapTreeConstrs (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
getInfo :: PDTagged -> BuildInfo
getInfo :: PDTagged -> BuildInfo
getInfo (Lib Library
l) = Library -> BuildInfo
libBuildInfo Library
l
getInfo (SubComp UnqualComponentName
_ Component
c) = Component -> BuildInfo
componentBuildInfo Component
c
getInfo PDTagged
PDNull = forall a. Monoid a => a
mempty
extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription
-> [Condition ConfVar]
BuildInfo -> Bool
f GenericPackageDescription
gpkg =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
gpkg)
, forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
gpkg
, forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
gpkg
, forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
gpkg
, forall v a c. Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition (BuildInfo -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
gpkg
]
newtype DepMapUnion = DepMapUnion { DepMapUnion
-> Map PackageName (VersionRange, NonEmptySet LibraryName)
unDepMapUnion :: Map PackageName (VersionRange, NonEmptySet LibraryName) }
instance Semigroup DepMapUnion where
DepMapUnion Map PackageName (VersionRange, NonEmptySet LibraryName)
x <> :: DepMapUnion -> DepMapUnion -> DepMapUnion
<> DepMapUnion Map PackageName (VersionRange, NonEmptySet LibraryName)
y = Map PackageName (VersionRange, NonEmptySet LibraryName)
-> DepMapUnion
DepMapUnion forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
unionVersionRanges' Map PackageName (VersionRange, NonEmptySet LibraryName)
x Map PackageName (VersionRange, NonEmptySet LibraryName)
y
unionVersionRanges'
:: (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
unionVersionRanges' :: (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
unionVersionRanges' (VersionRange
vr, NonEmptySet LibraryName
cs) (VersionRange
vr', NonEmptySet LibraryName
cs') = (VersionRange -> VersionRange -> VersionRange
unionVersionRanges VersionRange
vr VersionRange
vr', NonEmptySet LibraryName
cs forall a. Semigroup a => a -> a -> a
<> NonEmptySet LibraryName
cs')
toDepMapUnion :: [Dependency] -> DepMapUnion
toDepMapUnion :: [Dependency] -> DepMapUnion
toDepMapUnion [Dependency]
ds =
Map PackageName (VersionRange, NonEmptySet LibraryName)
-> DepMapUnion
DepMapUnion forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
-> (VersionRange, NonEmptySet LibraryName)
unionVersionRanges' [ (PackageName
p,(VersionRange
vr,NonEmptySet LibraryName
cs)) | Dependency PackageName
p VersionRange
vr NonEmptySet LibraryName
cs <- [Dependency]
ds ]
fromDepMapUnion :: DepMapUnion -> [Dependency]
fromDepMapUnion :: DepMapUnion -> [Dependency]
fromDepMapUnion DepMapUnion
m = [ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
p VersionRange
vr NonEmptySet LibraryName
cs | (PackageName
p,(VersionRange
vr,NonEmptySet LibraryName
cs)) <- forall k a. Map k a -> [(k, a)]
Map.toList (DepMapUnion
-> Map PackageName (VersionRange, NonEmptySet LibraryName)
unDepMapUnion DepMapUnion
m) ]
freeVars :: CondTree ConfVar c a -> [FlagName]
freeVars :: forall c a. CondTree ConfVar c a -> [FlagName]
freeVars CondTree ConfVar c a
t = [ FlagName
f | PackageFlag FlagName
f <- forall {b} {c} {a}. CondTree b c a -> [b]
freeVars' CondTree ConfVar c a
t ]
where
freeVars' :: CondTree b c a -> [b]
freeVars' (CondNode a
_ c
_ [CondBranch b c a]
ifs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondBranch b c a -> [b]
compfv [CondBranch b c a]
ifs
compfv :: CondBranch b c a -> [b]
compfv (CondBranch Condition b
c CondTree b c a
ct Maybe (CondTree b c a)
mct) = forall {a}. Condition a -> [a]
condfv Condition b
c forall a. [a] -> [a] -> [a]
++ CondTree b c a -> [b]
freeVars' CondTree b c a
ct forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CondTree b c a -> [b]
freeVars' Maybe (CondTree b c a)
mct
condfv :: Condition a -> [a]
condfv Condition a
c = case Condition a
c of
Var a
v -> [a
v]
Lit Bool
_ -> []
CNot Condition a
c' -> Condition a -> [a]
condfv Condition a
c'
COr Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2
CAnd Condition a
c1 Condition a
c2 -> Condition a -> [a]
condfv Condition a
c1 forall a. [a] -> [a] -> [a]
++ Condition a -> [a]
condfv Condition a
c2
newtype TargetSet a = TargetSet [(DependencyMap, a)]
overallDependencies :: ComponentRequestedSpec -> TargetSet PDTagged -> DependencyMap
overallDependencies :: ComponentRequestedSpec -> TargetSet PDTagged -> DependencyMap
overallDependencies ComponentRequestedSpec
enabled (TargetSet [(DependencyMap, PDTagged)]
targets) = forall a. Monoid a => [a] -> a
mconcat [DependencyMap]
depss
where
([DependencyMap]
depss, [PDTagged]
_) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (PDTagged -> Bool
removeDisabledSections forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(DependencyMap, PDTagged)]
targets
removeDisabledSections :: PDTagged -> Bool
removeDisabledSections :: PDTagged -> Bool
removeDisabledSections (Lib Library
_) = ComponentRequestedSpec -> ComponentName -> Bool
componentNameRequested
ComponentRequestedSpec
enabled
(LibraryName -> ComponentName
CLibName LibraryName
LMainLibName)
removeDisabledSections (SubComp UnqualComponentName
t Component
c)
= ComponentRequestedSpec -> ComponentName -> Bool
componentNameRequested ComponentRequestedSpec
enabled
forall a b. (a -> b) -> a -> b
$ case Component
c of
CLib Library
_ -> LibraryName -> ComponentName
CLibName (UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
t)
CFLib ForeignLib
_ -> UnqualComponentName -> ComponentName
CFLibName UnqualComponentName
t
CExe Executable
_ -> UnqualComponentName -> ComponentName
CExeName UnqualComponentName
t
CTest TestSuite
_ -> UnqualComponentName -> ComponentName
CTestName UnqualComponentName
t
CBench Benchmark
_ -> UnqualComponentName -> ComponentName
CBenchName UnqualComponentName
t
removeDisabledSections PDTagged
PDNull = Bool
True
flattenTaggedTargets :: TargetSet PDTagged -> (Maybe Library, [(UnqualComponentName, Component)])
flattenTaggedTargets :: TargetSet PDTagged
-> (Maybe Library, [(UnqualComponentName, Component)])
flattenTaggedTargets (TargetSet [(DependencyMap, PDTagged)]
targets) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DependencyMap, PDTagged)
-> (Maybe Library, [(UnqualComponentName, Component)])
-> (Maybe Library, [(UnqualComponentName, Component)])
untag (forall a. Maybe a
Nothing, []) [(DependencyMap, PDTagged)]
targets where
untag :: (DependencyMap, PDTagged)
-> (Maybe Library, [(UnqualComponentName, Component)])
-> (Maybe Library, [(UnqualComponentName, Component)])
untag (DependencyMap
depMap, PDTagged
pdTagged) (Maybe Library, [(UnqualComponentName, Component)])
accum = case (PDTagged
pdTagged, (Maybe Library, [(UnqualComponentName, Component)])
accum) of
(Lib Library
_, (Just Library
_, [(UnqualComponentName, Component)]
_)) -> forall a. String -> a
userBug String
"Only one library expected"
(Lib Library
l, (Maybe Library
Nothing, [(UnqualComponentName, Component)]
comps)) -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. HasBuildInfo a => a -> a
redoBD Library
l, [(UnqualComponentName, Component)]
comps)
(SubComp UnqualComponentName
n Component
c, (Maybe Library
mb_lib, [(UnqualComponentName, Component)]
comps))
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== UnqualComponentName
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(UnqualComponentName, Component)]
comps ->
forall a. String -> a
userBug forall a b. (a -> b) -> a -> b
$ String
"There exist several components with the same name: '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
n forall a. [a] -> [a] -> [a]
++ String
"'"
| Bool
otherwise -> (Maybe Library
mb_lib, (UnqualComponentName
n, forall a. HasBuildInfo a => a -> a
redoBD Component
c) forall a. a -> [a] -> [a]
: [(UnqualComponentName, Component)]
comps)
(PDTagged
PDNull, (Maybe Library, [(UnqualComponentName, Component)])
x) -> (Maybe Library, [(UnqualComponentName, Component)])
x
where
redoBD :: L.HasBuildInfo a => a -> a
redoBD :: forall a. HasBuildInfo a => a -> a
redoBD = forall s t a b. ASetter s t a b -> b -> s -> t
set forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends forall a b. (a -> b) -> a -> b
$ DependencyMap -> [Dependency]
fromDepMap DependencyMap
depMap
data PDTagged = Lib Library
| SubComp UnqualComponentName Component
| PDNull
deriving Int -> PDTagged -> String -> String
[PDTagged] -> String -> String
PDTagged -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PDTagged] -> String -> String
$cshowList :: [PDTagged] -> String -> String
show :: PDTagged -> String
$cshow :: PDTagged -> String
showsPrec :: Int -> PDTagged -> String -> String
$cshowsPrec :: Int -> PDTagged -> String -> String
Show
instance Monoid PDTagged where
mempty :: PDTagged
mempty = PDTagged
PDNull
mappend :: PDTagged -> PDTagged -> PDTagged
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup PDTagged where
PDTagged
PDNull <> :: PDTagged -> PDTagged -> PDTagged
<> PDTagged
x = PDTagged
x
PDTagged
x <> PDTagged
PDNull = PDTagged
x
Lib Library
l <> Lib Library
l' = Library -> PDTagged
Lib (Library
l forall a. Semigroup a => a -> a -> a
<> Library
l')
SubComp UnqualComponentName
n Component
x <> SubComp UnqualComponentName
n' Component
x' | UnqualComponentName
n forall a. Eq a => a -> a -> Bool
== UnqualComponentName
n' = UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
n (Component
x forall a. Semigroup a => a -> a -> a
<> Component
x')
PDTagged
_ <> PDTagged
_ = forall a. String -> a
cabalBug String
"Cannot combine incompatible tags"
finalizePD ::
FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, FlagAssignment)
finalizePD :: FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
userflags ComponentRequestedSpec
enabled Dependency -> Bool
satisfyDep
(Platform Arch
arch OS
os) CompilerInfo
impl [PackageVersionConstraint]
constraints
(GenericPackageDescription PackageDescription
pkg Maybe Version
_ver [PackageFlag]
flags Maybe (CondTree ConfVar [Dependency] Library)
mb_lib0 [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sub_libs0 [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs0 [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes0 [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests0 [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
bms0) = do
(TargetSet PDTagged
targetSet, FlagAssignment
flagVals) <-
[(FlagName, [Bool])]
-> ComponentRequestedSpec
-> OS
-> Arch
-> CompilerInfo
-> [PackageVersionConstraint]
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency])
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
resolveWithFlags [(FlagName, [Bool])]
flagChoices ComponentRequestedSpec
enabled OS
os Arch
arch CompilerInfo
impl [PackageVersionConstraint]
constraints [CondTree ConfVar [Dependency] PDTagged]
condTrees [Dependency] -> DepTestRslt [Dependency]
check
let
(Maybe Library
mb_lib, [(UnqualComponentName, Component)]
comps) = TargetSet PDTagged
-> (Maybe Library, [(UnqualComponentName, Component)])
flattenTaggedTargets TargetSet PDTagged
targetSet
mb_lib' :: Maybe Library
mb_lib' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
libFillInDefaults Maybe Library
mb_lib
comps' :: [Component]
comps' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(UnqualComponentName, Component)]
comps forall a b. (a -> b) -> a -> b
$ \(UnqualComponentName
n,Component
c) -> forall a.
(Library -> a)
-> (ForeignLib -> a)
-> (Executable -> a)
-> (TestSuite -> a)
-> (Benchmark -> a)
-> Component
-> a
foldComponent
(\Library
l -> Library -> Component
CLib (Library -> Library
libFillInDefaults Library
l) { libName :: LibraryName
libName = UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n
, libExposed :: Bool
libExposed = Bool
False })
(\ForeignLib
l -> ForeignLib -> Component
CFLib (ForeignLib -> ForeignLib
flibFillInDefaults ForeignLib
l) { foreignLibName :: UnqualComponentName
foreignLibName = UnqualComponentName
n })
(\Executable
e -> Executable -> Component
CExe (Executable -> Executable
exeFillInDefaults Executable
e) { exeName :: UnqualComponentName
exeName = UnqualComponentName
n })
(\TestSuite
t -> TestSuite -> Component
CTest (TestSuite -> TestSuite
testFillInDefaults TestSuite
t) { testName :: UnqualComponentName
testName = UnqualComponentName
n })
(\Benchmark
b -> Benchmark -> Component
CBench (Benchmark -> Benchmark
benchFillInDefaults Benchmark
b) { benchmarkName :: UnqualComponentName
benchmarkName = UnqualComponentName
n })
Component
c
([Library]
sub_libs', [ForeignLib]
flibs', [Executable]
exes', [TestSuite]
tests', [Benchmark]
bms') = [Component]
-> ([Library], [ForeignLib], [Executable], [TestSuite],
[Benchmark])
partitionComponents [Component]
comps'
forall (m :: * -> *) a. Monad m => a -> m a
return ( PackageDescription
pkg { library :: Maybe Library
library = Maybe Library
mb_lib'
, subLibraries :: [Library]
subLibraries = [Library]
sub_libs'
, foreignLibs :: [ForeignLib]
foreignLibs = [ForeignLib]
flibs'
, executables :: [Executable]
executables = [Executable]
exes'
, testSuites :: [TestSuite]
testSuites = [TestSuite]
tests'
, benchmarks :: [Benchmark]
benchmarks = [Benchmark]
bms'
}
, FlagAssignment
flagVals )
where
condTrees :: [CondTree ConfVar [Dependency] PDTagged]
condTrees = forall a. Maybe a -> [a]
maybeToList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData Library -> PDTagged
Lib) Maybe (CondTree ConfVar [Dependency] Library)
mb_lib0)
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
name,CondTree ConfVar [Dependency] Library
tree) -> forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> Component
CLib) CondTree ConfVar [Dependency] Library
tree) [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sub_libs0
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
name,CondTree ConfVar [Dependency] ForeignLib
tree) -> forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> Component
CFLib) CondTree ConfVar [Dependency] ForeignLib
tree) [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs0
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
name,CondTree ConfVar [Dependency] Executable
tree) -> forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> Component
CExe) CondTree ConfVar [Dependency] Executable
tree) [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes0
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
name,CondTree ConfVar [Dependency] TestSuite
tree) -> forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> Component
CTest) CondTree ConfVar [Dependency] TestSuite
tree) [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests0
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
name,CondTree ConfVar [Dependency] Benchmark
tree) -> forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData (UnqualComponentName -> Component -> PDTagged
SubComp UnqualComponentName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> Component
CBench) CondTree ConfVar [Dependency] Benchmark
tree) [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
bms0
flagChoices :: [(FlagName, [Bool])]
flagChoices = forall a b. (a -> b) -> [a] -> [b]
map (\(MkPackageFlag FlagName
n String
_ Bool
d Bool
manual) -> (FlagName
n, Bool -> FlagName -> Bool -> [Bool]
d2c Bool
manual FlagName
n Bool
d)) [PackageFlag]
flags
d2c :: Bool -> FlagName -> Bool -> [Bool]
d2c Bool
manual FlagName
n Bool
b = case FlagName -> FlagAssignment -> Maybe Bool
lookupFlagAssignment FlagName
n FlagAssignment
userflags of
Just Bool
val -> [Bool
val]
Maybe Bool
Nothing
| Bool
manual -> [Bool
b]
| Bool
otherwise -> [Bool
b, Bool -> Bool
not Bool
b]
check :: [Dependency] -> DepTestRslt [Dependency]
check [Dependency]
ds = let missingDeps :: [Dependency]
missingDeps = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Bool
satisfyDep) [Dependency]
ds
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
missingDeps
then forall d. DepTestRslt d
DepOk
else forall d. d -> DepTestRslt d
MissingDeps [Dependency]
missingDeps
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription
(GenericPackageDescription PackageDescription
pkg Maybe Version
_ [PackageFlag]
_ Maybe (CondTree ConfVar [Dependency] Library)
mlib0 [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sub_libs0 [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs0 [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes0 [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests0 [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
bms0) =
PackageDescription
pkg { library :: Maybe Library
library = Maybe Library
mlib
, subLibraries :: [Library]
subLibraries = forall a. [a] -> [a]
reverse [Library]
sub_libs
, foreignLibs :: [ForeignLib]
foreignLibs = forall a. [a] -> [a]
reverse [ForeignLib]
flibs
, executables :: [Executable]
executables = forall a. [a] -> [a]
reverse [Executable]
exes
, testSuites :: [TestSuite]
testSuites = forall a. [a] -> [a]
reverse [TestSuite]
tests
, benchmarks :: [Benchmark]
benchmarks = forall a. [a] -> [a]
reverse [Benchmark]
bms
}
where
mlib :: Maybe Library
mlib = forall {b} {v}. Semigroup b => CondTree v b Library -> Library
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree ConfVar [Dependency] Library)
mlib0
where f :: CondTree v b Library -> Library
f CondTree v b Library
lib = (Library -> Library
libFillInDefaults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions forall a b. (a -> b) -> a -> b
$ CondTree v b Library
lib) { libName :: LibraryName
libName = LibraryName
LMainLibName }
sub_libs :: [Library]
sub_libs = forall {b} {v}.
Semigroup b =>
(UnqualComponentName, CondTree v b Library) -> Library
flattenLib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sub_libs0
flibs :: [ForeignLib]
flibs = forall {b} {v}.
Semigroup b =>
(UnqualComponentName, CondTree v b ForeignLib) -> ForeignLib
flattenFLib forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibs0
exes :: [Executable]
exes = forall {b} {v}.
Semigroup b =>
(UnqualComponentName, CondTree v b Executable) -> Executable
flattenExe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes0
tests :: [TestSuite]
tests = forall {b} {v}.
Semigroup b =>
(UnqualComponentName, CondTree v b TestSuite) -> TestSuite
flattenTst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests0
bms :: [Benchmark]
bms = forall {b} {v}.
Semigroup b =>
(UnqualComponentName, CondTree v b Benchmark) -> Benchmark
flattenBm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
bms0
flattenLib :: (UnqualComponentName, CondTree v b Library) -> Library
flattenLib (UnqualComponentName
n, CondTree v b Library
t) = Library -> Library
libFillInDefaults forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree v b Library
t)
{ libName :: LibraryName
libName = UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n, libExposed :: Bool
libExposed = Bool
False }
flattenFLib :: (UnqualComponentName, CondTree v b ForeignLib) -> ForeignLib
flattenFLib (UnqualComponentName
n, CondTree v b ForeignLib
t) = ForeignLib -> ForeignLib
flibFillInDefaults forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree v b ForeignLib
t)
{ foreignLibName :: UnqualComponentName
foreignLibName = UnqualComponentName
n }
flattenExe :: (UnqualComponentName, CondTree v b Executable) -> Executable
flattenExe (UnqualComponentName
n, CondTree v b Executable
t) = Executable -> Executable
exeFillInDefaults forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree v b Executable
t)
{ exeName :: UnqualComponentName
exeName = UnqualComponentName
n }
flattenTst :: (UnqualComponentName, CondTree v b TestSuite) -> TestSuite
flattenTst (UnqualComponentName
n, CondTree v b TestSuite
t) = TestSuite -> TestSuite
testFillInDefaults forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree v b TestSuite
t)
{ testName :: UnqualComponentName
testName = UnqualComponentName
n }
flattenBm :: (UnqualComponentName, CondTree v b Benchmark) -> Benchmark
flattenBm (UnqualComponentName
n, CondTree v b Benchmark
t) = Benchmark -> Benchmark
benchFillInDefaults forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a c v.
(Semigroup a, Semigroup c) =>
CondTree v c a -> (a, c)
ignoreConditions CondTree v b Benchmark
t)
{ benchmarkName :: UnqualComponentName
benchmarkName = UnqualComponentName
n }
libFillInDefaults :: Library -> Library
libFillInDefaults :: Library -> Library
libFillInDefaults lib :: Library
lib@(Library { libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
bi }) =
Library
lib { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi }
flibFillInDefaults :: ForeignLib -> ForeignLib
flibFillInDefaults :: ForeignLib -> ForeignLib
flibFillInDefaults flib :: ForeignLib
flib@(ForeignLib { foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi }) =
ForeignLib
flib { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi }
exeFillInDefaults :: Executable -> Executable
exeFillInDefaults :: Executable -> Executable
exeFillInDefaults exe :: Executable
exe@(Executable { buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi }) =
Executable
exe { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi }
testFillInDefaults :: TestSuite -> TestSuite
testFillInDefaults :: TestSuite -> TestSuite
testFillInDefaults tst :: TestSuite
tst@(TestSuite { testBuildInfo :: TestSuite -> BuildInfo
testBuildInfo = BuildInfo
bi }) =
TestSuite
tst { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi }
benchFillInDefaults :: Benchmark -> Benchmark
benchFillInDefaults :: Benchmark -> Benchmark
benchFillInDefaults bm :: Benchmark
bm@(Benchmark { benchmarkBuildInfo :: Benchmark -> BuildInfo
benchmarkBuildInfo = BuildInfo
bi }) =
Benchmark
bm { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi }
biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults BuildInfo
bi =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
then BuildInfo
bi { hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
hsSourceDirs = [forall from to. (IsDir from, IsDir to) => SymbolicPath from to
sameDirectory] }
else BuildInfo
bi
transformAllBuildInfos :: (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos :: (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos BuildInfo -> BuildInfo
onBuildInfo SetupBuildInfo -> SetupBuildInfo
onSetupBuildInfo =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos BuildInfo -> BuildInfo
onBuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription (Maybe SetupBuildInfo)
L.setupBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) SetupBuildInfo -> SetupBuildInfo
onSetupBuildInfo
transformAllBuildDepends :: (Dependency -> Dependency)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildDepends :: (Dependency -> Dependency)
-> GenericPackageDescription -> GenericPackageDescription
transformAllBuildDepends Dependency -> Dependency
f =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Dependency -> Dependency
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription (Maybe SetupBuildInfo)
L.setupBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SetupBuildInfo [Dependency]
L.setupDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) Dependency -> Dependency
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (\[Dependency] -> Identity [Dependency]
f' -> forall (f :: * -> *).
Applicative f =>
(forall a.
CondTree ConfVar [Dependency] a
-> f (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees forall a b. (a -> b) -> a -> b
$ forall v c a d. Traversal (CondTree v c a) (CondTree v d a) c d
traverseCondTreeC [Dependency] -> Identity [Dependency]
f') (forall a b. (a -> b) -> [a] -> [b]
map Dependency -> Dependency
f)
transformAllBuildDependsN :: ([Dependency] -> [Dependency])
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildDependsN :: ([Dependency] -> [Dependency])
-> GenericPackageDescription -> GenericPackageDescription
transformAllBuildDependsN [Dependency] -> [Dependency]
f =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a. HasBuildInfos a => Traversal' a BuildInfo
L.traverseBuildInfos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasBuildInfo a => Lens' a [Dependency]
L.targetBuildDepends) [Dependency] -> [Dependency]
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' GenericPackageDescription PackageDescription
L.packageDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageDescription (Maybe SetupBuildInfo)
L.setupBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' SetupBuildInfo [Dependency]
L.setupDepends) [Dependency] -> [Dependency]
f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (\[Dependency] -> Identity [Dependency]
f' -> forall (f :: * -> *).
Applicative f =>
(forall a.
CondTree ConfVar [Dependency] a
-> f (CondTree ConfVar [Dependency] a))
-> GenericPackageDescription -> f GenericPackageDescription
L.allCondTrees forall a b. (a -> b) -> a -> b
$ forall v c a d. Traversal (CondTree v c a) (CondTree v d a) c d
traverseCondTreeC [Dependency] -> Identity [Dependency]
f') [Dependency] -> [Dependency]
f