diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 712f9861051dfd703e2c51f7df0f7db59f8cd6ca..c0ec14337b2ed572393b3028c00767b33e08f7b8 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -98,6 +98,7 @@ module Distribution.PackageDescription ( GenericPackageDescription(..), Flag(..), FlagName(..), FlagAssignment, CondTree(..), ConfVar(..), Condition(..), + cNot, -- * Source repositories SourceRepo(..), @@ -1176,6 +1177,11 @@ data Condition c = Var c | CAnd (Condition c) (Condition c) deriving (Show, Eq, Typeable, Data) +cNot :: Condition a -> Condition a +cNot (Lit b) = Lit (not b) +cNot (CNot c) = c +cNot c = CNot c + instance Functor Condition where f `fmap` Var c = Var (f c) _ `fmap` Lit c = Lit c diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index c56eea63049d2d02460039391017a7488537b0fc..bca9cc3fc18114cf1fbee8a8e69d410ffdd5d520 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -25,7 +25,7 @@ import Distribution.PackageDescription ( Benchmark(..), BenchmarkInterface(..), benchmarkType , TestSuite(..), TestSuiteInterface(..), testType , SourceRepo(..), - customFieldsBI, CondTree(..), Condition(..), + customFieldsBI, CondTree(..), Condition(..), cNot, FlagName(..), ConfVar(..), Executable(..), Library(..), Flag(..), PackageDescription(..), GenericPackageDescription(..)) @@ -38,7 +38,7 @@ import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDesc sourceRepoFieldDescrs,flagFieldDescrs) import Distribution.Package (Dependency(..)) import Distribution.Text (Text(..)) -import Data.Maybe (isJust, fromJust, isNothing) +import Data.Maybe (isJust) -- | Recompile with false for regression testing simplifiedPrinting :: Bool @@ -226,18 +226,37 @@ ppCondTree ct@(CondNode it _ ifs) mbIt ppIt = else res where -- TODO: this ends up printing trailing spaces when combined with nest. - ppIf (c,thenTree,mElseTree) = - ((emptyLine $ text "if" <+> ppCondition c) $$ - nest indentWith (ppCondTree thenTree - (if simplifiedPrinting then (Just it) else Nothing) ppIt)) - $+$ (if isNothing mElseTree - then empty - else text "else" - $$ nest indentWith (ppCondTree (fromJust mElseTree) - (if simplifiedPrinting then (Just it) else Nothing) ppIt)) + ppIf (c, thenTree, Just elseTree) = ppIfElse it ppIt c thenTree elseTree + ppIf (c, thenTree, Nothing) = ppIf' it ppIt c thenTree + +ppIfCondition :: (Condition ConfVar) -> Doc +ppIfCondition c = (emptyLine $ text "if" <+> ppCondition c) + +ppIf' :: a -> (a -> Maybe a -> Doc) + -> Condition ConfVar + -> CondTree ConfVar [Dependency] a + -> Doc +ppIf' it ppIt c thenTree = + if isEmpty thenDoc + then mempty + else ppIfCondition c $$ nest indentWith thenDoc + where thenDoc = ppCondTree thenTree (if simplifiedPrinting then (Just it) else Nothing) ppIt + +ppIfElse :: a -> (a -> Maybe a -> Doc) + -> Condition ConfVar + -> CondTree ConfVar [Dependency] a + -> CondTree ConfVar [Dependency] a + -> Doc +ppIfElse it ppIt c thenTree elseTree = + case (isEmpty thenDoc, isEmpty elseDoc) of + (True, True) -> mempty + (False, True) -> ppIfCondition c $$ nest indentWith thenDoc + (True, False) -> ppIfCondition (cNot c) $$ nest indentWith elseDoc + (False, False) -> (ppIfCondition c $$ nest indentWith thenDoc) + $+$ (text "else" $$ nest indentWith elseDoc) + where thenDoc = ppCondTree thenTree (if simplifiedPrinting then (Just it) else Nothing) ppIt + elseDoc = ppCondTree elseTree (if simplifiedPrinting then (Just it) else Nothing) ppIt emptyLine :: Doc -> Doc emptyLine d = text "" $+$ d - -