{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Flag
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Defines the 'Flag' type and it's 'Monoid' instance,  see
-- <http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html>
-- for an explanation.
--
-- Split off from "Distribution.Simple.Setup" to break import cycles.
module Distribution.Simple.Flag
  ( Flag
  , pattern Flag
  , pattern NoFlag
  , allFlags
  , toFlag
  , fromFlag
  , fromFlagOrDefault
  , flagElim
  , flagToMaybe
  , flagToList
  , maybeToFlag
  , mergeListFlag
  , BooleanFlag (..)
  ) where

import Data.Monoid (Last (..))
import Distribution.Compat.Prelude hiding (get)
import Distribution.Compat.Stack
import Prelude ()

-- ------------------------------------------------------------

-- * Flag type

-- ------------------------------------------------------------

-- | All flags are monoids, they come in two flavours:
--
-- 1. list flags eg
--
--   > --ghc-option=foo --ghc-option=bar
--
--   gives us all the values ["foo", "bar"]
--
-- 2. singular value flags, eg:
--
--   > --enable-foo --disable-foo
--
--   gives us Just False
--
-- So, this 'Flag' type is for the latter singular kind of flag.
-- Its monoid instance gives us the behaviour where it starts out as
-- 'NoFlag' and later flags override earlier ones.
--
-- Isomorphic to 'Maybe' a.
type Flag = Last

pattern Flag :: a -> Last a
pattern $bFlag :: forall a. a -> Last a
$mFlag :: forall {r} {a}. Last a -> (a -> r) -> ((# #) -> r) -> r
Flag a = Last (Just a)

pattern NoFlag :: Last a
pattern $bNoFlag :: forall a. Last a
$mNoFlag :: forall {r} {a}. Last a -> ((# #) -> r) -> ((# #) -> r) -> r
NoFlag = Last Nothing

{-# COMPLETE Flag, NoFlag #-}

-- | Wraps a value in 'Flag'.
toFlag :: a -> Flag a
toFlag :: forall a. a -> Last a
toFlag = a -> Last a
forall a. a -> Last a
Flag

-- | Extracts a value from a 'Flag', and throws an exception on 'NoFlag'.
fromFlag :: WithCallStack (Flag a -> a)
fromFlag :: forall a. WithCallStack (Flag a -> a)
fromFlag (Flag a
x) = a
x
fromFlag Last a
NoFlag = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromFlag NoFlag. Use fromFlagOrDefault"

-- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'.
fromFlagOrDefault :: a -> Flag a -> a
fromFlagOrDefault :: forall a. a -> Flag a -> a
fromFlagOrDefault a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> (Flag a -> Maybe a) -> Flag a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> Maybe a
forall a. Last a -> Maybe a
getLast

-- | Converts a 'Flag' value to a 'Maybe' value.
flagToMaybe :: Flag a -> Maybe a
flagToMaybe :: forall a. Last a -> Maybe a
flagToMaybe = Last a -> Maybe a
forall a. Last a -> Maybe a
getLast

-- | Pushes a function through a 'Flag' value, and returns a default
-- if the 'Flag' value is 'NoFlag'.
--
-- @since 3.4.0.0
flagElim :: b -> (a -> b) -> Flag a -> b
flagElim :: forall b a. b -> (a -> b) -> Flag a -> b
flagElim b
n a -> b
f = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n a -> b
f (Maybe a -> b) -> (Flag a -> Maybe a) -> Flag a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> Maybe a
forall a. Last a -> Maybe a
getLast

-- | Converts a 'Flag' value to a list.
flagToList :: Flag a -> [a]
flagToList :: forall a. Flag a -> [a]
flagToList = Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Maybe a -> [a]) -> (Flag a -> Maybe a) -> Flag a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag a -> Maybe a
forall a. Last a -> Maybe a
getLast

-- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'.
allFlags :: [Flag Bool] -> Flag Bool
allFlags :: [Flag Bool] -> Flag Bool
allFlags [Flag Bool]
flags =
  if (Flag Bool -> Bool) -> [Flag Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Flag Bool
f -> Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False Flag Bool
f) [Flag Bool]
flags
    then Bool -> Flag Bool
forall a. a -> Last a
Flag Bool
True
    else Flag Bool
forall a. Last a
NoFlag

-- | Converts a 'Maybe' value to a 'Flag' value.
maybeToFlag :: Maybe a -> Flag a
maybeToFlag :: forall a. Maybe a -> Last a
maybeToFlag = Maybe a -> Last a
forall a. Maybe a -> Last a
Last

-- | Merge the elements of a list 'Flag' with another list 'Flag'.
mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]
mergeListFlag :: forall a. Flag [a] -> Flag [a] -> Flag [a]
mergeListFlag Flag [a]
currentFlags Flag [a]
v =
  [a] -> Flag [a]
forall a. a -> Last a
Flag ([a] -> Flag [a]) -> [a] -> Flag [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Flag [a] -> [[a]]
forall a. Flag a -> [a]
flagToList Flag [a]
currentFlags [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Flag [a] -> [[a]]
forall a. Flag a -> [a]
flagToList Flag [a]
v)

-- | Types that represent boolean flags.
class BooleanFlag a where
  asBool :: a -> Bool

instance BooleanFlag Bool where
  asBool :: Bool -> Bool
asBool = Bool -> Bool
forall a. a -> a
id