-- Adapted (stolen) from https://github.com/commercialhaskell/stack/blob/d8fc7a1344fdd2dd9227f419b0b06ae1e5d4ede6/src/Options/Applicative/Builder/Extra.hs

module Calligraphy.Util.Optparse (boolFlags) where

import Options.Applicative

-- | Enable/disable flags for a 'Bool'.
boolFlags ::
  -- | Default value
  Bool ->
  -- | Flag name
  String ->
  -- | Help suffix
  String ->
  Mod FlagFields Bool ->
  Parser Bool
boolFlags :: Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
defaultValue String
name String
helpText =
  Bool
-> Bool
-> Bool
-> String
-> String
-> Mod FlagFields Bool
-> Parser Bool
forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags Bool
defaultValue Bool
True Bool
False String
name (String -> Mod FlagFields Bool -> Parser Bool)
-> String -> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
helpText,
        String
" (default: ",
        if Bool
defaultValue then String
"enabled" else String
"disabled",
        String
")"
      ]

-- | Enable/disable flags for any type.
enableDisableFlags ::
  -- | Default value
  a ->
  -- | Enabled value
  a ->
  -- | Disabled value
  a ->
  -- | Name
  String ->
  -- | Help suffix
  String ->
  Mod FlagFields a ->
  Parser a
enableDisableFlags :: a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags a
defaultValue a
enabledValue a
disabledValue String
name String
helpText Mod FlagFields a
mods =
  a -> a -> String -> String -> Mod FlagFields a -> Parser a
forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue String
name String
helpText Mod FlagFields a
mods
    Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defaultValue

-- | Enable/disable flags for any type, without a default (to allow chaining with '<|>')
enableDisableFlagsNoDefault ::
  -- | Enabled value
  a ->
  -- | Disabled value
  a ->
  -- | Name
  String ->
  -- | Help suffix
  String ->
  Mod FlagFields a ->
  Parser a
enableDisableFlagsNoDefault :: a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue String
name String
helpText Mod FlagFields a
mods =
  [a] -> a
forall a. [a] -> a
last
    ([a] -> a) -> Parser [a] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
      ( ( a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
            a
enabledValue
            ( Mod FlagFields a
forall (f :: * -> *) a. Mod f a
hidden
                Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
forall (f :: * -> *) a. Mod f a
internal
                Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
name
                Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
            )
            Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
              a
disabledValue
              ( Mod FlagFields a
forall (f :: * -> *) a. Mod f a
hidden
                  Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
forall (f :: * -> *) a. Mod f a
internal
                  Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"no-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
                  Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
              )
        )
          Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Mod FlagFields a -> Parser a
forall a. a -> Mod FlagFields a -> Parser a
flag'
            a
disabledValue
            ( String -> Mod FlagFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"[no-]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
                Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields a
forall (f :: * -> *) a. String -> Mod f a
help String
helpText
                Mod FlagFields a -> Mod FlagFields a -> Mod FlagFields a
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
            )
      )