Commit c373c77e authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang
Browse files

Split Condition/CondTree out of GenericPackageDescription.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 89e7c506
......@@ -227,6 +227,8 @@ library
Distribution.Types.TestType
Distribution.Types.ComponentName
Distribution.Types.GenericPackageDescription
Distribution.Types.Condition
Distribution.Types.CondTree
Distribution.Types.HookedBuildInfo
Distribution.Types.PackageDescription
Distribution.Types.SourceRepo
......
......@@ -124,6 +124,8 @@ import Distribution.Types.BuildInfo
import Distribution.Types.SetupBuildInfo
import Distribution.Types.BuildType
import Distribution.Types.GenericPackageDescription
import Distribution.Types.CondTree
import Distribution.Types.Condition
import Distribution.Types.PackageDescription
import Distribution.Types.ComponentName
import Distribution.Types.HookedBuildInfo
......
......@@ -9,8 +9,9 @@ import Distribution.Parsec.Types.Common
import Distribution.Parsec.Types.Field (SectionArg (..))
import Distribution.Parsec.Types.ParseResult
import Distribution.Simple.Utils (fromUTF8BS)
import Distribution.Types.Condition
import Distribution.Types.GenericPackageDescription
(Condition (..), ConfVar (..))
(ConfVar (..))
import Distribution.Version
(anyVersion, earlierVersion, intersectVersionRanges,
laterVersion, majorBoundVersion, mkVersion, noVersion,
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
module Distribution.Types.CondTree (
CondTree(..),
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.Condition
data CondTree v c a = CondNode
{ condTreeData :: a
, condTreeConstraints :: c
, condTreeComponents :: [( Condition v
, CondTree v c a
, Maybe (CondTree v c a))]
}
deriving (Show, Eq, Typeable, Data, Generic, Functor, Foldable, Traversable)
instance (Binary v, Binary c, Binary a) => Binary (CondTree v c a)
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.Condition (
Condition(..),
cNot,
cAnd,
cOr,
) where
import Prelude ()
import Distribution.Compat.Prelude
-- | A boolean expression parameterized over the variable type used.
data Condition c = Var c
| Lit Bool
| CNot (Condition c)
| COr (Condition c) (Condition c)
| CAnd (Condition c) (Condition c)
deriving (Show, Eq, Typeable, Data, Generic)
-- | Boolean negation of a 'Condition' value.
cNot :: Condition a -> Condition a
cNot (Lit b) = Lit (not b)
cNot (CNot c) = c
cNot c = CNot c
-- | Boolean AND of two 'Condtion' values.
cAnd :: Condition a -> Condition a -> Condition a
cAnd (Lit False) _ = Lit False
cAnd _ (Lit False) = Lit False
cAnd (Lit True) x = x
cAnd x (Lit True) = x
cAnd x y = CAnd x y
-- | Boolean OR of two 'Condition' values.
cOr :: Eq v => Condition v -> Condition v -> Condition v
cOr (Lit True) _ = Lit True
cOr _ (Lit True) = Lit True
cOr (Lit False) x = x
cOr x (Lit False) = x
cOr c (CNot d)
| c == d = Lit True
cOr (CNot c) d
| c == d = Lit True
cOr x y = COr x y
instance Functor Condition where
f `fmap` Var c = Var (f c)
_ `fmap` Lit c = Lit c
f `fmap` CNot c = CNot (fmap f c)
f `fmap` COr c d = COr (fmap f c) (fmap f d)
f `fmap` CAnd c d = CAnd (fmap f c) (fmap f d)
instance Foldable Condition where
f `foldMap` Var c = f c
_ `foldMap` Lit _ = mempty
f `foldMap` CNot c = foldMap f c
f `foldMap` COr c d = foldMap f c `mappend` foldMap f d
f `foldMap` CAnd c d = foldMap f c `mappend` foldMap f d
instance Traversable Condition where
f `traverse` Var c = Var `fmap` f c
_ `traverse` Lit c = pure $ Lit c
f `traverse` CNot c = CNot `fmap` traverse f c
f `traverse` COr c d = COr `fmap` traverse f c <*> traverse f d
f `traverse` CAnd c d = CAnd `fmap` traverse f c <*> traverse f d
instance Applicative Condition where
pure = Var
(<*>) = ap
instance Monad Condition where
return = pure
-- Terminating cases
(>>=) (Lit x) _ = Lit x
(>>=) (Var x) f = f x
-- Recursing cases
(>>=) (CNot x ) f = CNot (x >>= f)
(>>=) (COr x y) f = COr (x >>= f) (y >>= f)
(>>=) (CAnd x y) f = CAnd (x >>= f) (y >>= f)
instance Monoid (Condition a) where
mempty = Lit False
mappend = (<>)
instance Semigroup (Condition a) where
(<>) = COr
instance Alternative Condition where
empty = mempty
(<|>) = mappend
instance MonadPlus Condition where
mzero = mempty
mplus = mappend
instance Binary c => Binary (Condition c)
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
module Distribution.Types.GenericPackageDescription (
GenericPackageDescription(..),
......@@ -13,11 +10,6 @@ module Distribution.Types.GenericPackageDescription (
unFlagName,
FlagAssignment,
ConfVar(..),
Condition(..),
CondTree(..),
cOr,
cAnd,
cNot,
) where
import Prelude ()
......@@ -33,6 +25,7 @@ import Distribution.Types.Executable
import Distribution.Types.TestSuite
import Distribution.Types.Benchmark
import Distribution.Types.UnqualComponentName
import Distribution.Types.CondTree
import Distribution.Package
import Distribution.Version
......@@ -125,100 +118,3 @@ data ConfVar = OS OS
deriving (Eq, Show, Typeable, Data, Generic)
instance Binary ConfVar
-- | A boolean expression parameterized over the variable type used.
data Condition c = Var c
| Lit Bool
| CNot (Condition c)
| COr (Condition c) (Condition c)
| CAnd (Condition c) (Condition c)
deriving (Show, Eq, Typeable, Data, Generic)
-- | Boolean negation of a 'Condition' value.
cNot :: Condition a -> Condition a
cNot (Lit b) = Lit (not b)
cNot (CNot c) = c
cNot c = CNot c
-- | Boolean AND of two 'Condtion' values.
cAnd :: Condition a -> Condition a -> Condition a
cAnd (Lit False) _ = Lit False
cAnd _ (Lit False) = Lit False
cAnd (Lit True) x = x
cAnd x (Lit True) = x
cAnd x y = CAnd x y
-- | Boolean OR of two 'Condition' values.
cOr :: Eq v => Condition v -> Condition v -> Condition v
cOr (Lit True) _ = Lit True
cOr _ (Lit True) = Lit True
cOr (Lit False) x = x
cOr x (Lit False) = x
cOr c (CNot d)
| c == d = Lit True
cOr (CNot c) d
| c == d = Lit True
cOr x y = COr x y
instance Functor Condition where
f `fmap` Var c = Var (f c)
_ `fmap` Lit c = Lit c
f `fmap` CNot c = CNot (fmap f c)
f `fmap` COr c d = COr (fmap f c) (fmap f d)
f `fmap` CAnd c d = CAnd (fmap f c) (fmap f d)
instance Foldable Condition where
f `foldMap` Var c = f c
_ `foldMap` Lit _ = mempty
f `foldMap` CNot c = foldMap f c
f `foldMap` COr c d = foldMap f c `mappend` foldMap f d
f `foldMap` CAnd c d = foldMap f c `mappend` foldMap f d
instance Traversable Condition where
f `traverse` Var c = Var `fmap` f c
_ `traverse` Lit c = pure $ Lit c
f `traverse` CNot c = CNot `fmap` traverse f c
f `traverse` COr c d = COr `fmap` traverse f c <*> traverse f d
f `traverse` CAnd c d = CAnd `fmap` traverse f c <*> traverse f d
instance Applicative Condition where
pure = Var
(<*>) = ap
instance Monad Condition where
return = pure
-- Terminating cases
(>>=) (Lit x) _ = Lit x
(>>=) (Var x) f = f x
-- Recursing cases
(>>=) (CNot x ) f = CNot (x >>= f)
(>>=) (COr x y) f = COr (x >>= f) (y >>= f)
(>>=) (CAnd x y) f = CAnd (x >>= f) (y >>= f)
instance Monoid (Condition a) where
mempty = Lit False
mappend = (<>)
instance Semigroup (Condition a) where
(<>) = COr
instance Alternative Condition where
empty = mempty
(<|>) = mappend
instance MonadPlus Condition where
mzero = mempty
mplus = mappend
instance Binary c => Binary (Condition c)
data CondTree v c a = CondNode
{ condTreeData :: a
, condTreeConstraints :: c
, condTreeComponents :: [( Condition v
, CondTree v c a
, Maybe (CondTree v c a))]
}
deriving (Show, Eq, Typeable, Data, Generic, Functor, Foldable, Traversable)
instance (Binary v, Binary c, Binary a) => Binary (CondTree v c a)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment