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