-- 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 =
  forall a.
a -> a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlags Bool
defaultValue Bool
True Bool
False String
name forall a b. (a -> b) -> a -> b
$
    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 :: forall a.
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 =
  forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue String
name String
helpText Mod FlagFields a
mods
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 :: forall a.
a -> a -> String -> String -> Mod FlagFields a -> Parser a
enableDisableFlagsNoDefault a
enabledValue a
disabledValue String
name String
helpText Mod FlagFields a
mods =
  forall a. [a] -> a
last
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
      ( ( forall a. a -> Mod FlagFields a -> Parser a
flag'
            a
enabledValue
            ( forall (f :: * -> *) a. Mod f a
hidden
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
name
                forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
            )
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
              a
disabledValue
              ( forall (f :: * -> *) a. Mod f a
hidden
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"no-" forall a. [a] -> [a] -> [a]
++ String
name)
                  forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
              )
        )
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
            a
disabledValue
            ( forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"[no-]" forall a. [a] -> [a] -> [a]
++ String
name)
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
helpText
                forall a. Semigroup a => a -> a -> a
<> Mod FlagFields a
mods
            )
      )