module Distribution.Simple.Flag (
Flag(..),
allFlags,
toFlag,
fromFlag,
fromFlagOrDefault,
flagElim,
flagToMaybe,
flagToList,
maybeToFlag,
BooleanFlag(..) ) where
import Prelude ()
import Distribution.Compat.Prelude hiding (get)
import Distribution.Compat.Stack
data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Typeable)
instance Binary a => Binary (Flag a)
instance Structured a => Structured (Flag a)
instance Functor Flag where
fmap f (Flag x) = Flag (f x)
fmap _ NoFlag = NoFlag
instance Applicative Flag where
(Flag x) <*> y = x <$> y
NoFlag <*> _ = NoFlag
pure = Flag
instance Monoid (Flag a) where
mempty = NoFlag
mappend = (<>)
instance Semigroup (Flag a) where
_ <> f@(Flag _) = f
f <> NoFlag = f
instance Bounded a => Bounded (Flag a) where
minBound = toFlag minBound
maxBound = toFlag maxBound
instance Enum a => Enum (Flag a) where
fromEnum = fromEnum . fromFlag
toEnum = toFlag . toEnum
enumFrom (Flag a) = map toFlag . enumFrom $ a
enumFrom _ = []
enumFromThen (Flag a) (Flag b) = toFlag `map` enumFromThen a b
enumFromThen _ _ = []
enumFromTo (Flag a) (Flag b) = toFlag `map` enumFromTo a b
enumFromTo _ _ = []
enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c
enumFromThenTo _ _ _ = []
toFlag :: a -> Flag a
toFlag = Flag
fromFlag :: WithCallStack (Flag a -> a)
fromFlag (Flag x) = x
fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault"
fromFlagOrDefault :: a -> Flag a -> a
fromFlagOrDefault _ (Flag x) = x
fromFlagOrDefault def NoFlag = def
flagToMaybe :: Flag a -> Maybe a
flagToMaybe (Flag x) = Just x
flagToMaybe NoFlag = Nothing
flagElim :: b -> (a -> b) -> Flag a -> b
flagElim n _ NoFlag = n
flagElim _ f (Flag x) = f x
flagToList :: Flag a -> [a]
flagToList (Flag x) = [x]
flagToList NoFlag = []
allFlags :: [Flag Bool] -> Flag Bool
allFlags flags = if all (\f -> fromFlagOrDefault False f) flags
then Flag True
else NoFlag
maybeToFlag :: Maybe a -> Flag a
maybeToFlag Nothing = NoFlag
maybeToFlag (Just x) = Flag x
class BooleanFlag a where
asBool :: a -> Bool
instance BooleanFlag Bool where
asBool = id