Cabal/src/Distribution/Simple/Flag.hs

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