module Distribution.PackageDescription.Configuration (
finalizePackageDescription,
flattenPackageDescription,
parseCondition,
freeVars,
mapCondTree,
mapTreeData,
mapTreeConds,
mapTreeConstrs,
) where
import Distribution.Package
( PackageName, Dependency(..) )
import Distribution.PackageDescription
( GenericPackageDescription(..), PackageDescription(..)
, Library(..), Executable(..), BuildInfo(..)
, Flag(..), FlagName(..), FlagAssignment
, CondTree(..), ConfVar(..), Condition(..), TestSuite(..) )
import Distribution.Version
( VersionRange, anyVersion, intersectVersionRanges, withinRange )
import Distribution.Compiler
( CompilerId(CompilerId) )
import Distribution.System
( Platform(..), OS, Arch )
import Distribution.Simple.Utils
( currentDir, lowercase )
import Distribution.Text
( Text(parse) )
import Distribution.Compat.ReadP as ReadP hiding ( char )
import Control.Arrow (first)
import qualified Distribution.Compat.ReadP as ReadP ( char )
import Data.Char ( isAlphaNum )
import Data.Maybe ( catMaybes, maybeToList )
import Data.Map ( Map, fromListWith, toList )
import qualified Data.Map as Map
import Data.Monoid
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
import qualified Text.Read as R
import qualified Text.Read.Lex as L
#endif
simplifyCondition :: Condition c
-> (c -> Either d Bool)
-> (Condition d, [d])
simplifyCondition cond i = fv :: Condition t -> (Condition t, [t])fv (.) :: (b -> c) -> (a -> b) -> a -> c. walk :: Condition c -> Condition dwalk ($) :: (a -> b) -> a -> b$ cond :: Condition ConfVarcond
where
walk cnd = case cnd :: Condition vcnd of
Var v -> either :: (a -> c) -> (b -> c) -> Either a b -> ceither Var :: c -> Condition cVar Lit :: Bool -> Condition cLit (i :: c -> Either d Booli v :: Boolv)
Lit b -> Lit :: Bool -> Condition cLit b :: Map PackageName VersionRangeb
CNot c -> case walk :: Condition c -> Condition dwalk c :: Condition cc of
Lit True -> Lit :: Bool -> Condition cLit False :: BoolFalse
Lit False -> Lit :: Bool -> Condition cLit True :: BoolTrue
c' -> CNot :: Condition c -> Condition cCNot c' :: Condition dc'
COr c d -> case (walk :: Condition c -> Condition dwalk c :: Condition cc, walk :: Condition c -> Condition dwalk d :: dd) of
(Lit False, d') -> d' :: dd'
(Lit True, _) -> Lit :: Bool -> Condition cLit True :: BoolTrue
(c', Lit False) -> c' :: Condition dc'
(_, Lit True) -> Lit :: Bool -> Condition cLit True :: BoolTrue
(c',d') -> COr :: Condition c -> Condition c -> Condition cCOr c' :: Condition dc' d' :: dd'
CAnd c d -> case (walk :: Condition c -> Condition dwalk c :: Condition cc, walk :: Condition c -> Condition dwalk d :: dd) of
(Lit False, _) -> Lit :: Bool -> Condition cLit False :: BoolFalse
(Lit True, d') -> d' :: dd'
(_, Lit False) -> Lit :: Bool -> Condition cLit False :: BoolFalse
(c', Lit True) -> c' :: Condition dc'
(c',d') -> CAnd :: Condition c -> Condition c -> Condition cCAnd c' :: Condition dc' d' :: dd'
fv c = (c :: Condition cc, fv' :: Condition t -> [t]fv' c :: Condition cc)
fv' c = case c :: Condition cc of
Var v -> [v :: Boolv]
Lit _ -> [] :: [a][]
CNot c' -> fv' :: Condition t -> [t]fv' c' :: Condition dc'
COr c1 c2 -> fv' :: Condition t -> [t]fv' c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ fv' :: Condition t -> [t]fv' c2 :: Condition tc2
CAnd c1 c2 -> fv' :: Condition t -> [t]fv' c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ fv' :: Condition t -> [t]fv' c2 :: Condition tc2
simplifyWithSysParams :: OS -> Arch -> CompilerId -> Condition ConfVar
-> (Condition FlagName, [FlagName])
simplifyWithSysParams os arch (CompilerId comp compVer) cond = (cond' :: Condition FlagNamecond', flags :: [Flag]flags)
where
(cond', flags) = simplifyCondition ::
Condition c -> (c -> Either d Bool) -> (Condition d, [d])simplifyCondition cond :: Condition ConfVarcond interp :: ConfVar -> Either FlagName Boolinterp
interp (OS os') = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ os' :: OSos' (==) :: Eq a => a -> a -> Bool== os :: OSos
interp (Arch arch') = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ arch' :: Archarch' (==) :: Eq a => a -> a -> Bool== arch :: Archarch
interp (Impl comp' vr) = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ comp' :: CompilerFlavorcomp' (==) :: Eq a => a -> a -> Bool== comp :: CompilerFlavorcomp
(&&) :: Bool -> Bool -> Bool&& compVer :: VersioncompVer withinRange :: Version -> VersionRange -> Bool`withinRange` vr :: VersionRangevr
interp (Flag f) = Left :: a -> Either a bLeft f :: FlagNamef
parseCondition :: ReadP r (Condition ConfVar)
parseCondition = condOr :: Parser r Char (Condition ConfVar)condOr
where
condOr = sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy1 condAnd :: ReadP r (Condition ConfVar)condAnd (oper :: String -> Parser r Char ()oper "||") (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. foldl1 :: (a -> a -> a) -> [a] -> afoldl1 COr :: Condition c -> Condition c -> Condition cCOr
condAnd = sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy1 cond :: Condition ConfVarcond (oper :: String -> Parser r Char ()oper "&&")(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. foldl1 :: (a -> a -> a) -> [a] -> afoldl1 CAnd :: Condition c -> Condition c -> Condition cCAnd
cond = sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> (boolLiteral :: Parser r Char (Condition c)boolLiteral (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ inparens :: ReadP r a -> ReadP r ainparens condOr :: Parser r Char (Condition ConfVar)condOr (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ notCond :: ReadP r (Condition ConfVar)notCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ osCond :: Parser r Char (Condition ConfVar)osCond
(+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ archCond :: Parser r Char (Condition ConfVar)archCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ flagCond :: Parser r Char (Condition ConfVar)flagCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ implCond :: Parser r Char (Condition ConfVar)implCond )
inparens = between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r abetween (char :: Char -> ReadP r CharReadP.char '(' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp) (sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> char :: Char -> ReadP r CharReadP.char ')' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp)
notCond = char :: Char -> ReadP r CharReadP.char '!' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> cond :: Condition ConfVarcond (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. CNot :: Condition c -> Condition cCNot
osCond = string :: String -> ReadP r Stringstring "os" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens osIdent :: Parser r Char ConfVarosIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
archCond = string :: String -> ReadP r Stringstring "arch" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens archIdent :: Parser r Char ConfVararchIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
flagCond = string :: String -> ReadP r Stringstring "flag" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens flagIdent :: Parser r Char ConfVarflagIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
implCond = string :: String -> ReadP r Stringstring "impl" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens implIdent :: Parser r Char ConfVarimplIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
boolLiteral = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Lit :: Bool -> Condition cLit parse :: Text a => forall r. ReadP r aparse
archIdent = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Arch :: Arch -> ConfVarArch parse :: Text a => forall r. ReadP r aparse
osIdent = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap OS :: OS -> ConfVarOS parse :: Text a => forall r. ReadP r aparse
flagIdent = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (Flag :: FlagName -> ConfVarFlag (.) :: (b -> c) -> (a -> b) -> a -> c. FlagName :: String -> FlagNameFlagName (.) :: (b -> c) -> (a -> b) -> a -> c. lowercase :: String -> Stringlowercase) (munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 isIdentChar :: Char -> BoolisIdentChar)
isIdentChar c = isAlphaNum :: Char -> BoolisAlphaNum c :: Condition cc (||) :: Bool -> Bool -> Bool|| c :: Condition cc (==) :: Eq a => a -> a -> Bool== '_' (||) :: Bool -> Bool -> Bool|| c :: Condition cc (==) :: Eq a => a -> a -> Bool== '-'
oper s = sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> string :: String -> ReadP r Stringstring s :: Strings (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp
sp = skipSpaces :: ReadP r ()skipSpaces
implIdent = do i <- parse :: Text a => forall r. ReadP r aparse
vr <- sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> option :: a -> ReadP r a -> ReadP r aoption anyVersion :: VersionRangeanyVersion parse :: Text a => forall r. ReadP r aparse
return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Impl :: CompilerFlavor -> VersionRange -> ConfVarImpl i :: c -> Either d Booli vr :: VersionRangevr
mapCondTree :: (a -> b) -> (c -> d) -> (Condition v -> Condition w)
-> CondTree v c a -> CondTree w d b
mapCondTree fa fc fcnd (CondNode a c ifs) =
CondNode ::
a
-> c
-> [(Condition v, CondTree v c a, Maybe (CondTree v c a))]
-> CondTree v c aCondNode (fa :: a -> bfa a :: Map PackageName VersionRangea) (fc :: c -> dfc c :: Condition cc) (map :: (a -> b) -> [a] -> [b]map g ::
(Condition v, CondTree v c a, f (CondTree v c a))
-> (Condition w, CondTree w d b, f (CondTree w d b))g ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs)
where
g (cnd, t, me) = (fcnd :: Condition v -> Condition wfcnd cnd :: Condition vcnd, mapCondTree ::
(a -> b)
-> (c -> d)
-> (Condition v -> Condition w)
-> CondTree v c a
-> CondTree w d bmapCondTree fa :: a -> bfa fc :: c -> dfc fcnd :: Condition v -> Condition wfcnd t :: TestSuitet,
fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (mapCondTree ::
(a -> b)
-> (c -> d)
-> (Condition v -> Condition w)
-> CondTree v c a
-> CondTree w d bmapCondTree fa :: a -> bfa fc :: c -> dfc fcnd :: Condition v -> Condition wfcnd) me :: Maybe (CondTree v d a)me)
mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d a
mapTreeConstrs f = mapCondTree ::
(a -> b)
-> (c -> d)
-> (Condition v -> Condition w)
-> CondTree v c a
-> CondTree w d bmapCondTree id :: a -> aid f :: FlagNamef id :: a -> aid
mapTreeConds :: (Condition v -> Condition w) -> CondTree v c a -> CondTree w c a
mapTreeConds f = mapCondTree ::
(a -> b)
-> (c -> d)
-> (Condition v -> Condition w)
-> CondTree v c a
-> CondTree w d bmapCondTree id :: a -> aid id :: a -> aid f :: FlagNamef
mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData f = mapCondTree ::
(a -> b)
-> (c -> d)
-> (Condition v -> Condition w)
-> CondTree v c a
-> CondTree w d bmapCondTree f :: FlagNamef id :: a -> aid id :: a -> aid
data DepTestRslt d = DepOk | MissingDeps d
instance ($cmappend) ::
Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid d => Monoid (DepTestRslt d) where
mempty = DepOk :: DepTestRslt dDepOk
mappend DepOk x = x :: DepTestRslt dx
mappend x DepOk = x :: DepTestRslt dx
mappend (MissingDeps d) (MissingDeps d') = MissingDeps :: d -> DepTestRslt dMissingDeps (d :: dd mappend :: Monoid a => a -> a -> a`mappend` d' :: dd')
data BT a = BTN a | BTB (BT a) (BT a)
resolveWithFlags ::
[(FlagName,[Bool])]
-> OS
-> Arch
-> CompilerId
-> [Dependency]
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency])
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
resolveWithFlags dom os arch impl constrs trees checkDeps =
case try ::
[(FlagName, [Bool])]
-> [(FlagName, Bool)]
-> Either
(BT [Dependency]) (TargetSet PDTagged, [(FlagName, Bool)])try dom :: [(FlagName, [Bool])]dom [] :: [a][] of
Right r -> Right :: b -> Either a bRight r :: [t]r
Left dbt -> Left :: a -> Either a bLeft ($) :: (a -> b) -> a -> b$ findShortest :: BT [t] -> [t]findShortest dbt :: BT [Dependency]dbt
where
extraConstrs = toDepMap :: [Dependency] -> DependencyMaptoDepMap constrs :: [Dependency]constrs
simplifiedTrees = map :: (a -> b) -> [a] -> [b]map ( mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d amapTreeConstrs toDepMap :: [Dependency] -> DependencyMaptoDepMap
(.) :: (b -> c) -> (a -> b) -> a -> c. mapTreeConds ::
(Condition v -> Condition w) -> CondTree v c a -> CondTree w c amapTreeConds (fst :: (a, b) -> afst (.) :: (b -> c) -> (a -> b) -> a -> c. simplifyWithSysParams ::
OS
-> Arch
-> CompilerId
-> Condition ConfVar
-> (Condition FlagName, [FlagName])simplifyWithSysParams os :: OSos arch :: Archarch impl :: CompilerIdimpl))
trees :: [CondTree ConfVar [Dependency] PDTagged]trees
try [] flags =
let targetSet = TargetSet :: [(DependencyMap, a)] -> TargetSet aTargetSet ($) :: (a -> b) -> a -> b$ flip :: (a -> b -> c) -> b -> a -> cflip map :: (a -> b) -> [a] -> [b]map simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]simplifiedTrees ($) :: (a -> b) -> a -> b$
first :: Arrow a => forall b c d. a b c -> a (b, d) (c, d)first (constrainBy :: DependencyMap -> DependencyMap -> DependencyMap`constrainBy` extraConstrs :: DependencyMapextraConstrs) (.) :: (b -> c) -> (a -> b) -> a -> c.
simplifyCondTree ::
(Monoid a, Monoid d) =>
(v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree (env :: Eq a => [(a, b)] -> a -> Either a benv flags :: [Flag]flags)
deps = overallDependencies :: TargetSet PDTagged -> DependencyMapoverallDependencies targetSet :: TargetSet PDTaggedtargetSet
in case checkDeps :: [Dependency] -> DepTestRslt [Dependency]checkDeps (fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps) of
DepOk -> Right :: b -> Either a bRight (targetSet :: TargetSet PDTaggedtargetSet, flags :: [Flag]flags)
MissingDeps mds -> Left :: a -> Either a bLeft (BTN :: a -> BT aBTN mds :: [Dependency]mds)
try ((n, vals):rest) flags =
tryAll :: [Either (BT [a]) b] -> Either (BT [a]) btryAll ($) :: (a -> b) -> a -> b$ map :: (a -> b) -> [a] -> [b]map (\v -> try ::
[(FlagName, [Bool])]
-> [(FlagName, Bool)]
-> Either
(BT [Dependency]) (TargetSet PDTagged, [(FlagName, Bool)])try rest :: [(FlagName, [Bool])]rest ((n :: Stringn, v :: Boolv)(:) :: a -> [a] -> [a]:flags :: [Flag]flags)) vals :: [Bool]vals
tryAll = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr mp :: Either (BT a) b -> Either (BT a) b -> Either (BT a) bmp mz :: Either (BT [a]) bmz
mp (Left xs) (Left ys) = (Left :: a -> Either a bLeft (BTB :: BT a -> BT a -> BT aBTB xs :: BT axs ys :: BT ays))
mp (Left _) m@(Right _) = m :: Either (BT a) bm
mp m@(Right _) _ = m :: Either (BT a) bm
mz = Left :: a -> Either a bLeft (BTN :: a -> BT aBTN [] :: [a][])
env flags flag = (maybe :: b -> (a -> b) -> Maybe a -> bmaybe (Left :: a -> Either a bLeft flag :: aflag) Right :: b -> Either a bRight (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Eq a => a -> [(a, b)] -> Maybe blookup flag :: aflag) flags :: [Flag]flags
findShortest (BTN x) = x :: DepTestRslt dx
findShortest (BTB lt rt) =
let l = findShortest :: BT [t] -> [t]findShortest lt :: BT [t]lt
r = findShortest :: BT [t] -> [t]findShortest rt :: BT [t]rt
in case (l :: Libraryl,r :: [t]r) of
([], xs) -> xs :: BT axs
(xs, []) -> xs :: BT axs
([x], _) -> [x :: DepTestRslt dx]
(_, [x]) -> [x :: DepTestRslt dx]
(xs, ys) -> if lazyLengthCmp :: [t] -> [t1] -> BoollazyLengthCmp xs :: BT axs ys :: BT ays
then xs :: BT axs else ys :: BT ays
lazyLengthCmp [] _ = True :: BoolTrue
lazyLengthCmp _ [] = False :: BoolFalse
lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp :: [t] -> [t1] -> BoollazyLengthCmp xs :: BT axs ys :: BT ays
newtype unDependencyMap :: Map PackageName VersionRangeDependencyMap = DependencyMap { unDependencyMap :: Map PackageName VersionRange }
#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 606)
deriving (D:Show ::
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Read ::
(Int -> ReadS a)
-> ReadS [a]
-> ReadPrec a
-> ReadPrec [a]
-> T:Read aRead)
#else
instance Show DependencyMap where
showsPrec d (DependencyMap m) =
showParen (d > 10) (showString "DependencyMap" . shows (M.toList m))
instance Read DependencyMap where
readPrec = parens $ R.prec 10 $ do
R.Ident "DependencyMap" <- R.lexP
xs <- R.readPrec
return (DependencyMap (M.fromList xs))
where parens :: R.ReadPrec a -> R.ReadPrec a
parens p = optional
where
optional = p R.+++ mandatory
mandatory = paren optional
paren :: R.ReadPrec a -> R.ReadPrec a
paren p = do L.Punc "(" <- R.lexP
x <- R.reset p
L.Punc ")" <- R.lexP
return x
readListPrec = R.readListPrecDefault
#endif
instance ($cmappend) ::
Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid DependencyMap where
mempty = DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap empty :: Map k aMap.empty
(DependencyMap a) `mappend` (DependencyMap b) =
DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap (unionWith ::
Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k aMap.unionWith intersectVersionRanges ::
VersionRange -> VersionRange -> VersionRangeintersectVersionRanges a :: Map PackageName VersionRangea b :: Map PackageName VersionRangeb)
toDepMap :: [Dependency] -> DependencyMap
toDepMap ds =
DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap ($) :: (a -> b) -> a -> b$ fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k afromListWith intersectVersionRanges ::
VersionRange -> VersionRange -> VersionRangeintersectVersionRanges [ (p :: PackageNamep,vr :: VersionRangevr) | Dependency p vr <- ds :: [Dependency]ds ]
fromDepMap :: DependencyMap -> [Dependency]
fromDepMap m = [ Dependency :: PackageName -> VersionRange -> DependencyDependency p :: PackageNamep vr :: VersionRangevr | (p,vr) <- toList :: Map k a -> [(k, a)]toList (unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap m :: Either (BT a) bm) ]
simplifyCondTree :: (Monoid a, Monoid d) =>
(v -> Either v Bool)
-> CondTree v d a
-> (d, a)
simplifyCondTree env (CondNode a d ifs) =
foldr :: (a -> b -> b) -> b -> [a] -> bfoldr mappend :: Monoid a => a -> a -> amappend (d :: dd, a :: Map PackageName VersionRangea) ($) :: (a -> b) -> a -> b$ catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ map :: (a -> b) -> [a] -> [b]map simplifyIf ::
(Condition v, CondTree v d a, Maybe (CondTree v d a))
-> Maybe (d, a)simplifyIf ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs
where
simplifyIf (cnd, t, me) =
case simplifyCondition ::
Condition c -> (c -> Either d Bool) -> (Condition d, [d])simplifyCondition cnd :: Condition vcnd env :: Eq a => [(a, b)] -> a -> Either a benv of
(Lit True, _) -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ simplifyCondTree ::
(Monoid a, Monoid d) =>
(v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree env :: Eq a => [(a, b)] -> a -> Either a benv t :: TestSuitet
(Lit False, _) -> fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (simplifyCondTree ::
(Monoid a, Monoid d) =>
(v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree env :: Eq a => [(a, b)] -> a -> Either a benv) me :: Maybe (CondTree v d a)me
_ -> error :: [Char] -> aerror ($) :: (a -> b) -> a -> b$ "Environment not defined for all free vars"
ignoreConditions :: (Monoid a, Monoid c) => CondTree v c a -> (a, c)
ignoreConditions (CondNode a c ifs) = (a :: Map PackageName VersionRangea, c :: Condition cc) mappend :: Monoid a => a -> a -> a`mappend` mconcat :: Monoid a => [a] -> amconcat (concatMap :: (a -> [b]) -> [a] -> [b]concatMap f :: FlagNamef ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs)
where f (_, t, me) = ignoreConditions ::
(Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet
(:) :: a -> [a] -> [a]: maybeToList :: Maybe a -> [a]maybeToList (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap ignoreConditions ::
(Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions me :: Maybe (CondTree v d a)me)
freeVars :: CondTree ConfVar c a -> [FlagName]
freeVars t = [ f :: FlagNamef | Flag f <- freeVars' :: CondTree b t t -> [b]freeVars' t :: TestSuitet ]
where
freeVars' (CondNode _ _ ifs) = concatMap :: (a -> [b]) -> [a] -> [b]concatMap compfv ::
(Condition b, CondTree b t t, Maybe (CondTree b t t)) -> [b]compfv ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs
compfv (c, ct, mct) = condfv :: Condition t -> [t]condfv c :: Condition cc (++) :: [a] -> [a] -> [a]++ freeVars' :: CondTree b t t -> [b]freeVars' ct :: CondTree b t tct (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] freeVars' :: CondTree b t t -> [b]freeVars' mct :: Maybe (CondTree b t t)mct
condfv c = case c :: Condition cc of
Var v -> [v :: Boolv]
Lit _ -> [] :: [a][]
CNot c' -> condfv :: Condition t -> [t]condfv c' :: Condition dc'
COr c1 c2 -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2
CAnd c1 c2 -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2
newtype TargetSet a = TargetSet [(DependencyMap, a)]
overallDependencies :: TargetSet PDTagged -> DependencyMap
overallDependencies (TargetSet targets) = mconcat :: Monoid a => [a] -> amconcat depss :: [DependencyMap]depss
where
(depss, _) = unzip :: [(a, b)] -> ([a], [b])unzip ($) :: (a -> b) -> a -> b$ filter :: (a -> Bool) -> [a] -> [a]filter (removeDisabledTests :: PDTagged -> BoolremoveDisabledTests (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) targets :: [(DependencyMap, PDTagged)]targets
removeDisabledTests :: PDTagged -> Bool
removeDisabledTests (Lib _) = True :: BoolTrue
removeDisabledTests (Exe _ _) = True :: BoolTrue
removeDisabledTests (Test _ t) = testEnabled :: TestSuite -> BooltestEnabled t :: TestSuitet
removeDisabledTests PDNull = True :: BoolTrue
constrainBy :: DependencyMap
-> DependencyMap
-> DependencyMap
constrainBy left extra =
DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap ($) :: (a -> b) -> a -> b$
foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> bMap.foldWithKey tightenConstraint ::
k -> VersionRange -> Map k VersionRange -> Map k VersionRangetightenConstraint (unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap left :: DependencyMapleft)
(unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap extra :: DependencyMapextra)
where tightenConstraint n c l =
case lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup n :: Stringn l :: Libraryl of
Nothing -> l :: Libraryl
Just vr -> insert :: Ord k => k -> a -> Map k a -> Map k aMap.insert n :: Stringn (intersectVersionRanges ::
VersionRange -> VersionRange -> VersionRangeintersectVersionRanges vr :: VersionRangevr c :: Condition cc) l :: Libraryl
flattenTaggedTargets :: TargetSet PDTagged ->
(Maybe Library, [(String, Executable)], [(String, TestSuite)])
flattenTaggedTargets (TargetSet targets) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr untag ::
(DependencyMap, PDTagged)
-> (Maybe Library, [(String, Executable)], [(String, TestSuite)])
-> (Maybe Library, [(String, Executable)], [(String, TestSuite)])untag (Nothing :: Maybe aNothing, [] :: [a][], [] :: [a][]) targets :: [(DependencyMap, PDTagged)]targets
where
untag (_, Lib _) (Just _, _, _) = bug :: String -> abug "Only one library expected"
untag (deps, Lib l) (Nothing, exes, tests) = (Just :: a -> Maybe aJust l' :: Libraryl', exes :: [(String, Executable)]exes, tests :: [(String, TestSuite)]tests)
where
l' = l :: Libraryl {
libBuildInfo = (libBuildInfo :: Library -> BuildInfolibBuildInfo l :: Libraryl) { targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
}
untag (deps, Exe n e) (mlib, exes, tests)
| any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) exes :: [(String, Executable)]exes = bug :: String -> abug "Exe with same name found"
| any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) tests :: [(String, TestSuite)]tests = bug :: String -> abug "Test sharing name of exe found"
| otherwise :: Boolotherwise = (mlib :: Maybe Librarymlib, exes :: [(String, Executable)]exes (++) :: [a] -> [a] -> [a]++ [(n :: Stringn, e' :: Executablee')], tests :: [(String, TestSuite)]tests)
where
e' = e :: Executablee {
buildInfo = (buildInfo :: Executable -> BuildInfobuildInfo e :: Executablee) { targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
}
untag (deps, Test n t) (mlib, exes, tests)
| any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) tests :: [(String, TestSuite)]tests = bug :: String -> abug "Test with same name found"
| any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) exes :: [(String, Executable)]exes = bug :: String -> abug "Test sharing name of exe found"
| otherwise :: Boolotherwise = (mlib :: Maybe Librarymlib, exes :: [(String, Executable)]exes, tests :: [(String, TestSuite)]tests (++) :: [a] -> [a] -> [a]++ [(n :: Stringn, t' :: TestSuitet')])
where
t' = t :: TestSuitet {
testBuildInfo = (testBuildInfo :: TestSuite -> BuildInfotestBuildInfo t :: TestSuitet)
{ targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
}
untag (_, PDNull) x = x :: DepTestRslt dx
data PDTagged = Lib Library | Exe String Executable | Test String TestSuite | PDNull deriving D:Show ::
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow
instance ($cmappend) ::
Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid PDTagged where
mempty = PDNull :: PDTaggedPDNull
PDNull `mappend` x = x :: DepTestRslt dx
x `mappend` PDNull = x :: DepTestRslt dx
Lib l `mappend` Lib l' = Lib :: Library -> PDTaggedLib (l :: Libraryl mappend :: Monoid a => a -> a -> a`mappend` l' :: Libraryl')
Exe n e `mappend` Exe n' e' | n :: Stringn (==) :: Eq a => a -> a -> Bool== n' :: Stringn' = Exe :: String -> Executable -> PDTaggedExe n :: Stringn (e :: Executablee mappend :: Monoid a => a -> a -> a`mappend` e' :: Executablee')
Test n t `mappend` Test n' t' | n :: Stringn (==) :: Eq a => a -> a -> Bool== n' :: Stringn' = Test :: String -> TestSuite -> PDTaggedTest n :: Stringn (t :: TestSuitet mappend :: Monoid a => a -> a -> a`mappend` t' :: TestSuitet')
_ `mappend` _ = bug :: String -> abug "Cannot combine incompatible tags"
finalizePackageDescription ::
FlagAssignment
-> (Dependency -> Bool)
-> Platform
-> CompilerId
-> [Dependency]
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, FlagAssignment)
finalizePackageDescription userflags satisfyDep (Platform arch os) impl constraints
(GenericPackageDescription pkg flags mlib0 exes0 tests0) =
case resolveFlags ::
Either
[Dependency]
((Maybe Library, [Executable], [TestSuite]),
TargetSet PDTagged,
FlagAssignment)resolveFlags of
Right ((mlib, exes', tests'), targetSet, flagVals) ->
Right :: b -> Either a bRight ( pkg :: PackageDescriptionpkg { library = mlib :: Maybe Librarymlib
, executables = exes' :: [Executable]exes'
, testSuites = tests' :: [TestSuite]tests'
, buildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap (overallDependencies :: TargetSet PDTagged -> DependencyMapoverallDependencies targetSet :: TargetSet PDTaggedtargetSet)
}
, flagVals :: FlagAssignmentflagVals )
Left missing -> Left :: a -> Either a bLeft missing :: [Dependency]missing
where
condTrees = maybeToList :: Maybe a -> [a]maybeToList (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData Lib :: Library -> PDTaggedLib) mlib0 :: Maybe (CondTree ConfVar [Dependency] Library)mlib0 )
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (\(name,tree) -> mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData (Exe :: String -> Executable -> PDTaggedExe name :: Stringname) tree :: CondTree ConfVar [Dependency] TestSuitetree) exes0 :: [(String, CondTree ConfVar [Dependency] Executable)]exes0
(++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (\(name,tree) -> mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData (Test :: String -> TestSuite -> PDTaggedTest name :: Stringname) tree :: CondTree ConfVar [Dependency] TestSuitetree) tests0 :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests0
resolveFlags =
case resolveWithFlags ::
[(FlagName, [Bool])]
-> OS
-> Arch
-> CompilerId
-> [Dependency]
-> [CondTree ConfVar [Dependency] PDTagged]
-> ([Dependency] -> DepTestRslt [Dependency])
-> Either [Dependency] (TargetSet PDTagged, FlagAssignment)resolveWithFlags flagChoices :: [(FlagName, [Bool])]flagChoices os :: OSos arch :: Archarch impl :: CompilerIdimpl constraints :: [Dependency]constraints condTrees :: [CondTree ConfVar [Dependency] PDTagged]condTrees check :: [Dependency] -> DepTestRslt [Dependency]check of
Right (targetSet, fs) ->
let (mlib, exes, tests) = flattenTaggedTargets ::
TargetSet PDTagged
-> (Maybe Library, [(String, Executable)], [(String, TestSuite)])flattenTaggedTargets targetSet :: TargetSet PDTaggedtargetSet in
Right :: b -> Either a bRight ( (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap libFillInDefaults :: Library -> LibrarylibFillInDefaults mlib :: Maybe Librarymlib,
map :: (a -> b) -> [a] -> [b]map (\(n,e) -> (exeFillInDefaults :: Executable -> ExecutableexeFillInDefaults e :: Executablee) { exeName = n :: Stringn }) exes :: [(String, Executable)]exes,
map :: (a -> b) -> [a] -> [b]map (\(n,t) -> (testFillInDefaults :: TestSuite -> TestSuitetestFillInDefaults t :: TestSuitet) { testName = n :: Stringn }) tests :: [(String, TestSuite)]tests),
targetSet :: TargetSet PDTaggedtargetSet, fs :: FlagAssignmentfs)
Left missing -> Left :: a -> Either a bLeft missing :: [Dependency]missing
flagChoices = map :: (a -> b) -> [a] -> [b]map (\(MkFlag n _ d manual) -> (n :: Stringn, d2c :: Bool -> FlagName -> Bool -> [Bool]d2c manual :: Boolmanual n :: Stringn d :: dd)) flags :: [Flag]flags
d2c manual n b = case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup n :: Stringn userflags :: FlagAssignmentuserflags of
Just val -> [val :: Boolval]
Nothing
| manual :: Boolmanual -> [b :: Map PackageName VersionRangeb]
| otherwise :: Boolotherwise -> [b :: Map PackageName VersionRangeb, not :: Bool -> Boolnot b :: Map PackageName VersionRangeb]
check ds = if all :: (a -> Bool) -> [a] -> Boolall satisfyDep :: Dependency -> BoolsatisfyDep ds :: [Dependency]ds
then DepOk :: DepTestRslt dDepOk
else MissingDeps :: d -> DepTestRslt dMissingDeps ($) :: (a -> b) -> a -> b$ filter :: (a -> Bool) -> [a] -> [a]filter (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. satisfyDep :: Dependency -> BoolsatisfyDep) ds :: [Dependency]ds
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0 tests0) =
pkg :: PackageDescriptionpkg { library = mlib :: Maybe Librarymlib
, executables = reverse :: [a] -> [a]reverse exes :: [(String, Executable)]exes
, testSuites = reverse :: [a] -> [a]reverse tests :: [(String, TestSuite)]tests
, buildDepends = ldeps :: [Dependency]ldeps (++) :: [a] -> [a] -> [a]++ reverse :: [a] -> [a]reverse edeps :: [Dependency]edeps (++) :: [a] -> [a] -> [a]++ reverse :: [a] -> [a]reverse tdeps :: [Dependency]tdeps
}
where
(mlib, ldeps) = case mlib0 :: Maybe (CondTree ConfVar [Dependency] Library)mlib0 of
Just lib -> let (l,ds) = ignoreConditions ::
(Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions lib :: CondTree ConfVar [Dependency] Librarylib in
(Just :: a -> Maybe aJust (libFillInDefaults :: Library -> LibrarylibFillInDefaults l :: Libraryl), ds :: [Dependency]ds)
Nothing -> (Nothing :: Maybe aNothing, [] :: [a][])
(exes, edeps) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr flattenExe ::
(String, CondTree v [a] Executable)
-> ([Executable], [a])
-> ([Executable], [a])flattenExe ([] :: [a][],[] :: [a][]) exes0 :: [(String, CondTree ConfVar [Dependency] Executable)]exes0
(tests, tdeps) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr flattenTst ::
(String, CondTree v [a] TestSuite)
-> ([TestSuite], [a])
-> ([TestSuite], [a])flattenTst ([] :: [a][],[] :: [a][]) tests0 :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests0
flattenExe (n, t) (es, ds) =
let (e, ds') = ignoreConditions ::
(Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet in
( (exeFillInDefaults :: Executable -> ExecutableexeFillInDefaults ($) :: (a -> b) -> a -> b$ e :: Executablee { exeName = n :: Stringn }) (:) :: a -> [a] -> [a]: es :: [Executable]es, ds' :: [a]ds' (++) :: [a] -> [a] -> [a]++ ds :: [Dependency]ds )
flattenTst (n, t) (es, ds) =
let (e, ds') = ignoreConditions ::
(Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet in
( (testFillInDefaults :: TestSuite -> TestSuitetestFillInDefaults ($) :: (a -> b) -> a -> b$ e :: Executablee { testName = n :: Stringn }) (:) :: a -> [a] -> [a]: es :: [Executable]es, ds' :: [a]ds' (++) :: [a] -> [a] -> [a]++ ds :: [Dependency]ds )
libFillInDefaults :: Library -> Library
libFillInDefaults lib@(Library { libBuildInfo = bi }) =
lib :: CondTree ConfVar [Dependency] Librarylib { libBuildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }
exeFillInDefaults :: Executable -> Executable
exeFillInDefaults exe@(Executable { buildInfo = bi }) =
exe :: Executableexe { buildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }
testFillInDefaults :: TestSuite -> TestSuite
testFillInDefaults tst@(TestSuite { testBuildInfo = bi }) =
tst :: TestSuitetst { testBuildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }
biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults bi =
if null :: [a] -> Boolnull (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)
then bi :: BuildInfobi { hsSourceDirs = [currentDir :: FilePathcurrentDir] }
else bi :: BuildInfobi
bug :: String -> a
bug msg = error :: [Char] -> aerror ($) :: (a -> b) -> a -> b$ msg :: Stringmsg (++) :: [a] -> [a] -> [a]++ ". Consider this a bug."