    {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable,
                 ExistentialQuantification, GADTs,
                 FlexibleInstances, UndecidableInstances,
                 TypeOperators #-}
    -- | Extensible options. They are used for provider-specific settings,
    -- ingredient-specific settings and core settings (such as the test name pattern).
    --
    -- @since 0.1
    module Test.Tasty.Options
      (
        -- * IsOption class
        IsOption(..)
        -- * Option sets and operations
      , OptionSet
      , setOption
      , changeOption
      , lookupOption
      , singleOption
      , OptionDescription(..)
      , uniqueOptionDescriptions
        -- * Utilities
      , flagCLParser
      , mkFlagCLParser
      , mkOptionCLParser
      , safeRead
      , safeReadBool
      ) where

    import qualified Data.Map as Map
    import Data.Map (Map)
    import Data.Maybe
    import Data.Char (toLower)
    import Data.Tagged
    import Data.Proxy
    import Data.Typeable
    import Data.Monoid
    import Data.Foldable
    import qualified Data.Semigroup as Sem
    import qualified Data.Set as S
    import Prelude hiding (mod) -- Silence FTP import warnings
    import Options.Applicative

    -- | An option is a data type that inhabits the `IsOption` type class.
    --
    -- @since 0.1
    class Typeable v => IsOption v where
      -- | The value to use if the option was not supplied explicitly
      defaultValue :: v
      -- | Try to parse an option value from a string. Consider using
      -- 'safeReadBool' for boolean options and 'safeRead' for numeric options.
      parseValue :: String -> Maybe v
      -- | The option name. It is used to form the command line option name, for
      -- instance. Therefore, it had better not contain spaces or other fancy
      -- characters. It is recommended to use dashes instead of spaces.
      optionName :: Tagged v String
      -- | The option description or help string. This can be an arbitrary
      -- string.
      optionHelp :: Tagged v String
      -- | How a 'defaultValue' should be displayed in the help string. 'Nothing'
      -- (the default implementation) will result in nothing being displayed, while
      -- @'Just' def@ will result in @def@ being advertised as the default in the
      -- help string.
      --
      -- @since 1.3
      showDefaultValue :: v -> Maybe String
      showDefaultValue v
    _ = Maybe String
    forall a. Maybe a
    Nothing
      -- | A command-line option parser.
      --
      -- It has a default implementation in terms of the other methods.
      -- You may want to override it in some cases (e.g. add a short flag) and
      -- 'flagCLParser', 'mkFlagCLParser' and 'mkOptionCLParser' might come in
      -- handy.
      --
      -- Even if you override this, you still should implement all the methods
      -- above, to allow alternative interfaces.
      --
      -- Do not supply a default value (e.g., with the 'value' function) here
      -- for this parser! This is because if no value was provided on the command
      -- line we may lookup the option e.g. in the environment. But if the parser
      -- always succeeds, we have no way to tell whether the user really provided
      -- the option on the command line.
      --
      -- Similarly, do not use 'showDefaultWith' here, as it will be ignored. Use
      -- the 'showDefaultValue' method of 'IsOption' instead.

      -- (If we don't specify a default, the option becomes mandatory.
      -- So, when we build the complete parser for OptionSet, we turn a
      -- failing parser into an always-succeeding one that may return an empty
      -- OptionSet.)
      optionCLParser :: Parser v
      optionCLParser = Mod OptionFields v -> Parser v
    forall v. IsOption v => Mod OptionFields v -> Parser v
    mkOptionCLParser Mod OptionFields v
    forall a. Monoid a => a
    mempty

    data OptionValue = forall v . IsOption v => OptionValue v

    -- | A set of options. Only one option of each type can be kept.
    --
    -- If some option has not been explicitly set, the default value is used.
    --
    -- @since 0.1
    newtype OptionSet = OptionSet (Map TypeRep OptionValue)

    -- | Later options override earlier ones.
    --
    -- @since 0.12.0.1
    instance Sem.Semigroup OptionSet where
      OptionSet Map TypeRep OptionValue
    a <> :: OptionSet -> OptionSet -> OptionSet
    <> OptionSet Map TypeRep OptionValue
    b =
        Map TypeRep OptionValue -> OptionSet
    OptionSet (Map TypeRep OptionValue -> OptionSet)
    -> Map TypeRep OptionValue -> OptionSet
    forall a b. (a -> b) -> a -> b
    $ (OptionValue -> OptionValue -> OptionValue)
    -> Map TypeRep OptionValue
    -> Map TypeRep OptionValue
    -> Map TypeRep OptionValue
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith ((OptionValue -> OptionValue -> OptionValue)
    -> OptionValue -> OptionValue -> OptionValue
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip OptionValue -> OptionValue -> OptionValue
    forall a b. a -> b -> a
    const) Map TypeRep OptionValue
    a Map TypeRep OptionValue
    b
    instance Monoid OptionSet where
      mempty :: OptionSet
    mempty = Map TypeRep OptionValue -> OptionSet
    OptionSet Map TypeRep OptionValue
    forall a. Monoid a => a
    mempty
    #if !MIN_VERSION_base(4,11,0)
      mappend = (Sem.<>)
    #endif

    -- | Set the option value.
    --
    -- @since 0.1
    setOption :: IsOption v => v -> OptionSet -> OptionSet
    setOption :: forall v. IsOption v => v -> OptionSet -> OptionSet
    setOption v
    v (OptionSet Map TypeRep OptionValue
    s) =
      Map TypeRep OptionValue -> OptionSet
    OptionSet (Map TypeRep OptionValue -> OptionSet)
    -> Map TypeRep OptionValue -> OptionSet
    forall a b. (a -> b) -> a -> b
    $ TypeRep
    -> OptionValue
    -> Map TypeRep OptionValue
    -> Map TypeRep OptionValue
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (v -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf v
    v) (v -> OptionValue
    forall v. IsOption v => v -> OptionValue
    OptionValue v
    v) Map TypeRep OptionValue
    s

    -- | Query the option value.
    --
    -- @since 0.1
    lookupOption :: forall v . IsOption v => OptionSet -> v
    lookupOption :: forall v. IsOption v => OptionSet -> v
    lookupOption (OptionSet Map TypeRep OptionValue
    s) =
      case TypeRep -> Map TypeRep OptionValue -> Maybe OptionValue
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (v -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf (v
    forall a. HasCallStack => a
    undefined :: v)) Map TypeRep OptionValue
    s of
        Just (OptionValue v
    x) | Just v
    v <- v -> Maybe v
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast v
    x -> v
    v
        Just {} -> String -> v
    forall a. HasCallStack => String -> a
    error String
    "OptionSet: broken invariant (shouldn't happen)"
        Maybe OptionValue
    Nothing -> v
    forall v. IsOption v => v
    defaultValue

    -- | Change the option value.
    --
    -- @since 0.1
    changeOption :: forall v . IsOption v => (v -> v) -> OptionSet -> OptionSet
    changeOption :: forall v. IsOption v => (v -> v) -> OptionSet -> OptionSet
    changeOption v -> v
    f OptionSet
    s = v -> OptionSet -> OptionSet
    forall v. IsOption v => v -> OptionSet -> OptionSet
    setOption (v -> v
    f (v -> v) -> v -> v
    forall a b. (a -> b) -> a -> b
    $ OptionSet -> v
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    s) OptionSet
    s

    -- | Create a singleton 'OptionSet'.
    --
    -- @since 0.8
    singleOption :: IsOption v => v -> OptionSet
    singleOption :: forall v. IsOption v => v -> OptionSet
    singleOption v
    v = v -> OptionSet -> OptionSet
    forall v. IsOption v => v -> OptionSet -> OptionSet
    setOption v
    v OptionSet
    forall a. Monoid a => a
    mempty

    -- | The purpose of this data type is to capture the dictionary
    -- corresponding to a particular option.
    --
    -- @since 0.1
    data OptionDescription where
      Option :: IsOption v => Proxy v -> OptionDescription

    -- | Remove duplicated 'OptionDescription', preserving existing order otherwise.
    --
    -- @since 1.4.1
    uniqueOptionDescriptions :: [OptionDescription] -> [OptionDescription]
    uniqueOptionDescriptions :: [OptionDescription] -> [OptionDescription]
    uniqueOptionDescriptions = Set TypeRep -> [OptionDescription] -> [OptionDescription]
    go Set TypeRep
    forall a. Set a
    S.empty
      where
        go :: Set TypeRep -> [OptionDescription] -> [OptionDescription]
    go Set TypeRep
    _ [] = []
        go Set TypeRep
    acc (Option Proxy v
    o : [OptionDescription]
    os)
          | Proxy v -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf Proxy v
    o TypeRep -> Set TypeRep -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set TypeRep
    acc = Set TypeRep -> [OptionDescription] -> [OptionDescription]
    go Set TypeRep
    acc [OptionDescription]
    os
          | Bool
    otherwise = Proxy v -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Option Proxy v
    o OptionDescription -> [OptionDescription] -> [OptionDescription]
    forall a. a -> [a] -> [a]
    : Set TypeRep -> [OptionDescription] -> [OptionDescription]
    go (TypeRep -> Set TypeRep -> Set TypeRep
    forall a. Ord a => a -> Set a -> Set a
    S.insert (Proxy v -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf Proxy v
    o) Set TypeRep
    acc) [OptionDescription]
    os

    -- | Command-line parser to use with flags.
    --
    -- @since 0.8
    flagCLParser
      :: forall v . IsOption v
      => Maybe Char -- ^ optional short flag
      -> v          -- ^ non-default value (when the flag is supplied)
      -> Parser v
    flagCLParser :: forall v. IsOption v => Maybe Char -> v -> Parser v
    flagCLParser Maybe Char
    mbShort = Mod FlagFields v -> v -> Parser v
    forall v. IsOption v => Mod FlagFields v -> v -> Parser v
    mkFlagCLParser ((Char -> Mod FlagFields v) -> Maybe Char -> Mod FlagFields v
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Char -> Mod FlagFields v
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Maybe Char
    mbShort)

    -- | Command-line flag parser that takes additional option modifiers.
    --
    -- @since 0.11.1
    mkFlagCLParser
      :: forall v . IsOption v
      => Mod FlagFields v -- ^ option modifier
      -> v                -- ^ non-default value (when the flag is supplied)
      -> Parser v
    mkFlagCLParser :: forall v. IsOption v => Mod FlagFields v -> v -> Parser v
    mkFlagCLParser Mod FlagFields v
    mod v
    v = v -> Mod FlagFields v -> Parser v
    forall a. a -> Mod FlagFields a -> Parser a
    flag' v
    v
      (  String -> Mod FlagFields v
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long (Tagged v String -> String
    forall {k} (s :: k) b. Tagged s b -> b
    untag (Tagged v String
    forall v. IsOption v => Tagged v String
    optionName :: Tagged v String))
      Mod FlagFields v -> Mod FlagFields v -> Mod FlagFields v
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod FlagFields v
    forall (f :: * -> *) a. String -> Mod f a
    help (Tagged v String -> String
    forall {k} (s :: k) b. Tagged s b -> b
    untag (Tagged v String
    forall v. IsOption v => Tagged v String
    optionHelp :: Tagged v String))
      Mod FlagFields v -> Mod FlagFields v -> Mod FlagFields v
    forall a. Semigroup a => a -> a -> a
    <> Mod FlagFields v
    mod
      )

    -- | Command-line option parser that takes additional option modifiers.
    --
    -- @since 0.11.1
    mkOptionCLParser :: forall v . IsOption v => Mod OptionFields v -> Parser v
    mkOptionCLParser :: forall v. IsOption v => Mod OptionFields v -> Parser v
    mkOptionCLParser Mod OptionFields v
    mod =
      ReadM v -> Mod OptionFields v -> Parser v
    forall a. ReadM a -> Mod OptionFields a -> Parser a
    option ReadM v
    parse
        (  String -> Mod OptionFields v
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    name
        Mod OptionFields v -> Mod OptionFields v -> Mod OptionFields v
    forall a. Semigroup a => a -> a -> a
    <> String -> Mod OptionFields v
    forall (f :: * -> *) a. String -> Mod f a
    help (Tagged v String -> String
    forall {k} (s :: k) b. Tagged s b -> b
    untag (Tagged v String
    forall v. IsOption v => Tagged v String
    optionHelp :: Tagged v String))
        Mod OptionFields v -> Mod OptionFields v -> Mod OptionFields v
    forall a. Semigroup a => a -> a -> a
    <> Mod OptionFields v
    mod
        )
      where
        name :: String
        name :: String
    name = Tagged v String -> String
    forall {k} (s :: k) b. Tagged s b -> b
    untag (Tagged v String
    forall v. IsOption v => Tagged v String
    optionName :: Tagged v String)

        parse :: ReadM v
        parse :: ReadM v
    parse = do
          s <- ReadM String
    forall s. IsString s => ReadM s
    str
          let err = String
    "Could not parse: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is not a valid " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name
          maybe (readerError err) pure (parseValue s)

    -- | Safe read function. Defined here for convenience to use for
    -- 'parseValue'.
    --
    -- @since 0.1
    safeRead :: Read a => String -> Maybe a
    safeRead :: forall a. Read a => String -> Maybe a
    safeRead String
    s
      | [(a
    x, String
    "")] <- ReadS a
    forall a. Read a => ReadS a
    reads String
    s = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
      | Bool
    otherwise = Maybe a
    forall a. Maybe a
    Nothing

    -- | Parse a 'Bool' case-insensitively.
    --
    -- @since 1.0.1
    safeReadBool :: String -> Maybe Bool
    safeReadBool :: String -> Maybe Bool
    safeReadBool String
    s =
      case ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s) of
        String
    "true" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
        String
    "false" -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
        String
    _ -> Maybe Bool
    forall a. Maybe a
    Nothing