1{-# LANGUAGE DeriveGeneric #-} 2{-# LANGUAGE FlexibleContexts #-} 3----------------------------------------------------------------------------- 4-- | 5-- Module : Distribution.Simple.Flag 6-- Copyright : Isaac Jones 2003-2004 7-- Duncan Coutts 2007 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- Defines the 'Flag' type and it's 'Monoid' instance, see 14-- <http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html> 15-- for an explanation. 16-- 17-- Split off from "Distribution.Simple.Setup" to break import cycles. 18module Distribution.Simple.Flag ( 19 Flag(..), 20 allFlags, 21 toFlag, 22 fromFlag, 23 fromFlagOrDefault, 24 flagToMaybe, 25 flagToList, 26 maybeToFlag, 27 BooleanFlag(..) ) where 28 29import Prelude () 30import Distribution.Compat.Prelude hiding (get) 31import Distribution.Compat.Stack 32 33-- ------------------------------------------------------------ 34-- * Flag type 35-- ------------------------------------------------------------ 36 37-- | All flags are monoids, they come in two flavours: 38-- 39-- 1. list flags eg 40-- 41-- > --ghc-option=foo --ghc-option=bar 42-- 43-- gives us all the values ["foo", "bar"] 44-- 45-- 2. singular value flags, eg: 46-- 47-- > --enable-foo --disable-foo 48-- 49-- gives us Just False 50-- So this Flag type is for the latter singular kind of flag. 51-- Its monoid instance gives us the behaviour where it starts out as 52-- 'NoFlag' and later flags override earlier ones. 53-- 54data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read) 55 56instance Binary a => Binary (Flag a) 57 58instance Functor Flag where 59 fmap f (Flag x) = Flag (f x) 60 fmap _ NoFlag = NoFlag 61 62instance Applicative Flag where 63 (Flag x) <*> y = x <$> y 64 NoFlag <*> _ = NoFlag 65 pure = Flag 66 67instance Monoid (Flag a) where 68 mempty = NoFlag 69 mappend = (<>) 70 71instance Semigroup (Flag a) where 72 _ <> f@(Flag _) = f 73 f <> NoFlag = f 74 75instance Bounded a => Bounded (Flag a) where 76 minBound = toFlag minBound 77 maxBound = toFlag maxBound 78 79instance Enum a => Enum (Flag a) where 80 fromEnum = fromEnum . fromFlag 81 toEnum = toFlag . toEnum 82 enumFrom (Flag a) = map toFlag . enumFrom $ a 83 enumFrom _ = [] 84 enumFromThen (Flag a) (Flag b) = toFlag `map` enumFromThen a b 85 enumFromThen _ _ = [] 86 enumFromTo (Flag a) (Flag b) = toFlag `map` enumFromTo a b 87 enumFromTo _ _ = [] 88 enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c 89 enumFromThenTo _ _ _ = [] 90 91toFlag :: a -> Flag a 92toFlag = Flag 93 94fromFlag :: WithCallStack (Flag a -> a) 95fromFlag (Flag x) = x 96fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault" 97 98fromFlagOrDefault :: a -> Flag a -> a 99fromFlagOrDefault _ (Flag x) = x 100fromFlagOrDefault def NoFlag = def 101 102flagToMaybe :: Flag a -> Maybe a 103flagToMaybe (Flag x) = Just x 104flagToMaybe NoFlag = Nothing 105 106flagToList :: Flag a -> [a] 107flagToList (Flag x) = [x] 108flagToList NoFlag = [] 109 110allFlags :: [Flag Bool] -> Flag Bool 111allFlags flags = if all (\f -> fromFlagOrDefault False f) flags 112 then Flag True 113 else NoFlag 114 115maybeToFlag :: Maybe a -> Flag a 116maybeToFlag Nothing = NoFlag 117maybeToFlag (Just x) = Flag x 118 119-- | Types that represent boolean flags. 120class BooleanFlag a where 121 asBool :: a -> Bool 122 123instance BooleanFlag Bool where 124 asBool = id 125