    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}

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

    -- |
    -- Module      :  Distribution.Simple.Command
    -- Copyright   :  Duncan Coutts 2007
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  non-portable (ExistentialQuantification)
    --
    -- This is to do with command line handling. The Cabal command line is
    -- organised into a number of named sub-commands (much like darcs). The
    -- 'CommandUI' abstraction represents one of these sub-commands, with a name,
    -- description, a set of flags. Commands can be associated with actions and
    -- run. It handles some common stuff automatically, like the @--help@ and
    -- command line completion flags. It is designed to allow other tools make
    -- derived commands. This feature is used heavily in @cabal-install@.
    module Distribution.Simple.Command
      ( -- * Command interface
        CommandUI (..)
      , commandShowOptions
      , CommandParse (..)
      , commandParseArgs
      , getNormalCommandDescriptions
      , helpCommandUI

        -- ** Constructing commands
      , ShowOrParseArgs (..)
      , usageDefault
      , usageAlternatives
      , mkCommandUI
      , hiddenCommand

        -- ** Associating actions with commands
      , Command
      , commandAddAction
      , noExtraFlags

        -- ** Building lists of commands
      , CommandType (..)
      , CommandSpec (..)
      , commandFromSpec

        -- ** Running commands
      , commandsRun
      , commandsRunWithFallback
      , defaultCommandFallback

        -- * Option Fields
      , OptionField (..)
      , Name

        -- ** Constructing Option Fields
      , option
      , multiOption

        -- ** Liftings & Projections
      , liftOption
      , liftOptionL

        -- * Option Descriptions
      , OptDescr (..)
      , fmapOptDescr
      , Description
      , SFlags
      , LFlags
      , OptFlags
      , ArgPlaceHolder

        -- ** OptDescr 'smart' constructors
      , MkOptDescr
      , reqArg
      , reqArg'
      , optArg
      , optArg'
      , optArgDef'
      , noArg
      , boolOpt
      , boolOpt'
      , choiceOpt
      , choiceOptFromEnum
      ) where

    import Distribution.Compat.Prelude hiding (get)
    import Prelude ()

    import qualified Data.Array as Array
    import qualified Data.List as List
    import Distribution.Compat.Lens (ALens', (#~), (^#))
    import qualified Distribution.GetOpt as GetOpt
    import Distribution.ReadE
    import Distribution.Simple.Utils

    data CommandUI flags = CommandUI
      { forall flags. CommandUI flags -> String
    commandName :: String
      -- ^ The name of the command as it would be entered on the command line.
      -- For example @\"build\"@.
      , forall flags. CommandUI flags -> String
    commandSynopsis :: String
      -- ^ A short, one line description of the command to use in help texts.
      , forall flags. CommandUI flags -> String -> String
    commandUsage :: String -> String
      -- ^ A function that maps a program name to a usage summary for this
      -- command.
      , forall flags. CommandUI flags -> Maybe (String -> String)
    commandDescription :: Maybe (String -> String)
      -- ^ Additional explanation of the command to use in help texts.
      , forall flags. CommandUI flags -> Maybe (String -> String)
    commandNotes :: Maybe (String -> String)
      -- ^ Post-Usage notes and examples in help texts
      , forall flags. CommandUI flags -> flags
    commandDefaultFlags :: flags
      -- ^ Initial \/ empty flags
      , forall flags.
    CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
    commandOptions :: ShowOrParseArgs -> [OptionField flags]
      -- ^ All the Option fields for this command
      }

    data ShowOrParseArgs = ShowArgs | ParseArgs
    type Name = String
    type Description = String

    -- | We usually have a data type for storing configuration values, where
    --   every field stores a configuration option, and the user sets
    --   the value either via command line flags or a configuration file.
    --   An individual OptionField models such a field, and we usually
    --   build a list of options associated to a configuration data type.
    data OptionField a = OptionField
      { forall a. OptionField a -> String
    optionName :: Name
      , forall a. OptionField a -> [OptDescr a]
    optionDescr :: [OptDescr a]
      }

    -- | An OptionField takes one or more OptDescrs, describing the command line
    -- interface for the field.
    data OptDescr a
      = ReqArg
          Description
          OptFlags
          ArgPlaceHolder
          (ReadE (a -> a))
          (a -> [String])
      | OptArg
          Description
          OptFlags
          ArgPlaceHolder
          (ReadE (a -> a))
          (String, a -> a)
          (a -> [Maybe String])
      | ChoiceOpt [(Description, OptFlags, a -> a, a -> Bool)]
      | BoolOpt
          Description
          OptFlags {-True-}
          OptFlags {-False-}
          (Bool -> a -> a)
          (a -> Maybe Bool)

    fmapOptDescr :: forall a b. (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b
    fmapOptDescr :: forall a b. (b -> a) -> (a -> b -> b) -> OptDescr a -> OptDescr b
    fmapOptDescr b -> a
    x a -> b -> b
    u = \case
      ReqArg String
    d OptFlags
    o String
    p ReadE (a -> a)
    upd a -> [String]
    get -> String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (b -> [String])
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> [String])
    -> OptDescr a
    ReqArg String
    d OptFlags
    o String
    p (((a -> a) -> b -> b) -> ReadE (a -> a) -> ReadE (b -> b)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> a) -> b -> b
    m ReadE (a -> a)
    upd) (a -> [String]
    get (a -> [String]) -> (b -> a) -> b -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    x)
      OptArg String
    d OptFlags
    o String
    p ReadE (a -> a)
    upd (String
    str, a -> a
    g) a -> [Maybe String]
    get -> String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (String, b -> b)
    -> (b -> [Maybe String])
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (String, a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    OptArg String
    d OptFlags
    o String
    p (((a -> a) -> b -> b) -> ReadE (a -> a) -> ReadE (b -> b)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> a) -> b -> b
    m ReadE (a -> a)
    upd) (String
    str, (a -> a) -> b -> b
    m a -> a
    g) (a -> [Maybe String]
    get (a -> [Maybe String]) -> (b -> a) -> b -> [Maybe String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    x)
      ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    opts -> [(String, OptFlags, b -> b, b -> Bool)] -> OptDescr b
    forall a. [(String, OptFlags, a -> a, a -> Bool)] -> OptDescr a
    ChoiceOpt ([(String, OptFlags, b -> b, b -> Bool)] -> OptDescr b)
    -> [(String, OptFlags, b -> b, b -> Bool)] -> OptDescr b
    forall a b. (a -> b) -> a -> b
    $ ((String, OptFlags, a -> a, a -> Bool)
     -> (String, OptFlags, b -> b, b -> Bool))
    -> [(String, OptFlags, a -> a, a -> Bool)]
    -> [(String, OptFlags, b -> b, b -> Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(String
    d, OptFlags
    o, a -> a
    upd, a -> Bool
    get) -> (String
    d, OptFlags
    o, (a -> a) -> b -> b
    m a -> a
    upd, a -> Bool
    get (a -> Bool) -> (b -> a) -> b -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    x)) [(String, OptFlags, a -> a, a -> Bool)]
    opts
      BoolOpt String
    d OptFlags
    true OptFlags
    false Bool -> a -> a
    upd a -> Maybe Bool
    get -> String
    -> OptFlags
    -> OptFlags
    -> (Bool -> b -> b)
    -> (b -> Maybe Bool)
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    BoolOpt String
    d OptFlags
    true OptFlags
    false (\Bool
    b -> (a -> a) -> b -> b
    m ((a -> a) -> b -> b) -> (a -> a) -> b -> b
    forall a b. (a -> b) -> a -> b
    $ Bool -> a -> a
    upd Bool
    b) (a -> Maybe Bool
    get (a -> Maybe Bool) -> (b -> a) -> b -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    x)
      where
        m :: (a -> a) -> (b -> b)
        m :: (a -> a) -> b -> b
    m a -> a
    upd_a b
    b = a -> b -> b
    u (a -> a
    upd_a (a -> a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ b -> a
    x b
    b) b
    b

    -- | Short command line option strings
    type SFlags = [Char]

    -- | Long command line option strings
    type LFlags = [String]

    type OptFlags = (SFlags, LFlags)
    type ArgPlaceHolder = String

    -- | Create an option taking a single OptDescr.
    --   No explicit Name is given for the Option, the name is the first LFlag given.
    --
    -- Example: @'option' sf lf d get set@
    -- * @sf@: Short option name, for example: @[\'d\']@. No hyphen permitted.
    -- * @lf@: Long option name, for example: @["debug"]@. No hyphens permitted.
    -- * @d@: Description of the option, shown to the user in help messages.
    -- * @get@: Get the current value of the flag.
    -- * @set@: Set the value of the flag. Gets the current value of the flag as a
    --          parameter.
    option
      :: SFlags
      -> LFlags
      -> Description
      -> get
      -> set
      -> MkOptDescr get set a
      -> OptionField a
    option :: forall get set a.
    String
    -> [String]
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option String
    sf lf :: [String]
    lf@(String
    n : [String]
    _) String
    d get
    get set
    set MkOptDescr get set a
    arg = String -> [OptDescr a] -> OptionField a
    forall a. String -> [OptDescr a] -> OptionField a
    OptionField String
    n [MkOptDescr get set a
    arg String
    sf [String]
    lf String
    d get
    get set
    set]
    option String
    _ [String]
    _ String
    _ get
    _ set
    _ MkOptDescr get set a
    _ =
      String -> OptionField a
    forall a. HasCallStack => String -> a
    error (String -> OptionField a) -> String -> OptionField a
    forall a b. (a -> b) -> a -> b
    $
        String
    "Distribution.command.option: "
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "An OptionField must have at least one LFlag"

    -- | Create an option taking several OptDescrs.
    --   You will have to give the flags and description individually to the
    --   OptDescr constructor.
    multiOption
      :: Name
      -> get
      -> set
      -> [get -> set -> OptDescr a]
      -- ^ MkOptDescr constructors partially
      --  applied to flags and description.
      -> OptionField a
    multiOption :: forall get set a.
    String -> get -> set -> [get -> set -> OptDescr a] -> OptionField a
    multiOption String
    n get
    get set
    set [get -> set -> OptDescr a]
    args = String -> [OptDescr a] -> OptionField a
    forall a. String -> [OptDescr a] -> OptionField a
    OptionField String
    n [get -> set -> OptDescr a
    arg get
    get set
    set | get -> set -> OptDescr a
    arg <- [get -> set -> OptDescr a]
    args]

    type MkOptDescr get set a =
      SFlags
      -> LFlags
      -> Description
      -> get
      -> set
      -> OptDescr a

    -- | Create a string-valued command line interface.
    -- Usually called in the context of 'option' or 'multiOption'.
    --
    -- Example: @'reqArg' ad mkflag showflag@
    --
    -- * @ad@: Placeholder shown to the user, e.g. @"FILES"@ if files are expected
    --         parameters.
    -- * @mkflag@: How to parse the argument into the option.
    -- * @showflag@: If parsing goes wrong, display a useful error message to
    --               the user.
    reqArg
      :: Monoid b
      => ArgPlaceHolder
      -> ReadE b
      -> (b -> [String])
      -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg :: forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg String
    ad ReadE b
    mkflag b -> [String]
    showflag String
    sf [String]
    lf String
    d a -> b
    get b -> a -> a
    set =
      String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> [String])
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> [String])
    -> OptDescr a
    ReqArg
        String
    d
        (String
    sf, [String]
    lf)
        String
    ad
        ((b -> a -> a) -> ReadE b -> ReadE (a -> a)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\b
    a a
    b -> b -> a -> a
    set (a -> b
    get a
    b b -> b -> b
    forall a. Monoid a => a -> a -> a
    `mappend` b
    a) a
    b) ReadE b
    mkflag)
        (b -> [String]
    showflag (b -> [String]) -> (a -> b) -> a -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get)

    -- | Create a string-valued command line interface with a default value.
    optArg
      :: Monoid b
      => ArgPlaceHolder
      -> ReadE b
      -> (String, b)
      -> (b -> [Maybe String])
      -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg :: forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (String, b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg String
    ad ReadE b
    mkflag (String
    dv, b
    mkDef) b -> [Maybe String]
    showflag String
    sf [String]
    lf String
    d a -> b
    get b -> a -> a
    set =
      String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (String, a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (String, a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    OptArg
        String
    d
        (String
    sf, [String]
    lf)
        String
    ad
        ((b -> a -> a) -> ReadE b -> ReadE (a -> a)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\b
    a a
    b -> b -> a -> a
    set (a -> b
    get a
    b b -> b -> b
    forall a. Monoid a => a -> a -> a
    `mappend` b
    a) a
    b) ReadE b
    mkflag)
        (String
    dv, \a
    b -> b -> a -> a
    set (a -> b
    get a
    b b -> b -> b
    forall a. Monoid a => a -> a -> a
    `mappend` b
    mkDef) a
    b)
        (b -> [Maybe String]
    showflag (b -> [Maybe String]) -> (a -> b) -> a -> [Maybe String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get)

    -- | (String -> a) variant of "reqArg"
    reqArg'
      :: Monoid b
      => ArgPlaceHolder
      -> (String -> b)
      -> (b -> [String])
      -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg' :: forall b a.
    Monoid b =>
    String
    -> (String -> b)
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg' String
    ad String -> b
    mkflag b -> [String]
    showflag =
      String
    -> ReadE b
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (b -> [String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg String
    ad ((String -> b) -> ReadE b
    forall a. (String -> a) -> ReadE a
    succeedReadE String -> b
    mkflag) b -> [String]
    showflag

    -- | (String -> a) variant of "optArg"
    optArg'
      :: Monoid b
      => ArgPlaceHolder
      -> (Maybe String -> b)
      -> (b -> [Maybe String])
      -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg' :: forall b a.
    Monoid b =>
    String
    -> (Maybe String -> b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg' String
    ad Maybe String -> b
    mkflag b -> [Maybe String]
    showflag =
      String
    -> ReadE b
    -> (String, b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (String, b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg String
    ad ((String -> b) -> ReadE b
    forall a. (String -> a) -> ReadE a
    succeedReadE (Maybe String -> b
    mkflag (Maybe String -> b) -> (String -> Maybe String) -> String -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe String
    forall a. a -> Maybe a
    Just)) (String
    "", Maybe String -> b
    mkflag Maybe String
    forall a. Maybe a
    Nothing) b -> [Maybe String]
    showflag

    optArgDef'
      :: Monoid b
      => ArgPlaceHolder
      -> (String, Maybe String -> b)
      -> (b -> [Maybe String])
      -> MkOptDescr (a -> b) (b -> a -> a) a
    optArgDef' :: forall b a.
    Monoid b =>
    String
    -> (String, Maybe String -> b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArgDef' String
    ad (String
    dv, Maybe String -> b
    mkflag) b -> [Maybe String]
    showflag =
      String
    -> ReadE b
    -> (String, b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> (String, b)
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg String
    ad ((String -> b) -> ReadE b
    forall a. (String -> a) -> ReadE a
    succeedReadE (Maybe String -> b
    mkflag (Maybe String -> b) -> (String -> Maybe String) -> String -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe String
    forall a. a -> Maybe a
    Just)) (String
    dv, Maybe String -> b
    mkflag Maybe String
    forall a. Maybe a
    Nothing) b -> [Maybe String]
    showflag

    noArg :: Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a
    noArg :: forall b a. Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a
    noArg b
    flag String
    sf [String]
    lf String
    d = [(b, OptFlags, String)] -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Eq b =>
    [(b, OptFlags, String)] -> MkOptDescr (a -> b) (b -> a -> a) a
    choiceOpt [(b
    flag, (String
    sf, [String]
    lf), String
    d)] String
    sf [String]
    lf String
    d

    boolOpt
      :: (b -> Maybe Bool)
      -> (Bool -> b)
      -> SFlags
      -> SFlags
      -> MkOptDescr (a -> b) (b -> a -> a) a
    boolOpt :: forall b a.
    (b -> Maybe Bool)
    -> (Bool -> b)
    -> String
    -> String
    -> MkOptDescr (a -> b) (b -> a -> a) a
    boolOpt b -> Maybe Bool
    g Bool -> b
    s String
    sfT String
    sfF String
    _sf _lf :: [String]
    _lf@(String
    n : [String]
    _) String
    d a -> b
    get b -> a -> a
    set =
      String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    BoolOpt String
    d (String
    sfT, [String
    "enable-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n]) (String
    sfF, [String
    "disable-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n]) (b -> a -> a
    set (b -> a -> a) -> (Bool -> b) -> Bool -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> b
    s) (b -> Maybe Bool
    g (b -> Maybe Bool) -> (a -> b) -> a -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get)
    boolOpt b -> Maybe Bool
    _ Bool -> b
    _ String
    _ String
    _ String
    _ [String]
    _ String
    _ a -> b
    _ b -> a -> a
    _ =
      String -> OptDescr a
    forall a. HasCallStack => String -> a
    error
        String
    "Distribution.Simple.Setup.boolOpt: unreachable"

    boolOpt'
      :: (b -> Maybe Bool)
      -> (Bool -> b)
      -> OptFlags
      -> OptFlags
      -> MkOptDescr (a -> b) (b -> a -> a) a
    boolOpt' :: forall b a.
    (b -> Maybe Bool)
    -> (Bool -> b)
    -> OptFlags
    -> OptFlags
    -> MkOptDescr (a -> b) (b -> a -> a) a
    boolOpt' b -> Maybe Bool
    g Bool -> b
    s OptFlags
    ffT OptFlags
    ffF String
    _sf [String]
    _lf String
    d a -> b
    get b -> a -> a
    set = String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    BoolOpt String
    d OptFlags
    ffT OptFlags
    ffF (b -> a -> a
    set (b -> a -> a) -> (Bool -> b) -> Bool -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> b
    s) (b -> Maybe Bool
    g (b -> Maybe Bool) -> (a -> b) -> a -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get)

    -- | create a Choice option
    choiceOpt
      :: Eq b
      => [(b, OptFlags, Description)]
      -> MkOptDescr (a -> b) (b -> a -> a) a
    choiceOpt :: forall b a.
    Eq b =>
    [(b, OptFlags, String)] -> MkOptDescr (a -> b) (b -> a -> a) a
    choiceOpt [(b, OptFlags, String)]
    aa_ff String
    _sf [String]
    _lf String
    _d a -> b
    get b -> a -> a
    set = [(String, OptFlags, a -> a, a -> Bool)] -> OptDescr a
    forall a. [(String, OptFlags, a -> a, a -> Bool)] -> OptDescr a
    ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    alts
      where
        alts :: [(String, OptFlags, a -> a, a -> Bool)]
    alts = [(String
    d, OptFlags
    flags, b -> a -> a
    set b
    alt, (b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    alt) (b -> Bool) -> (a -> b) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    get) | (b
    alt, OptFlags
    flags, String
    d) <- [(b, OptFlags, String)]
    aa_ff]

    -- | create a Choice option out of an enumeration type.
    --   As long flags, the Show output is used. As short flags, the first character
    --   which does not conflict with a previous one is used.
    choiceOptFromEnum
      :: (Bounded b, Enum b, Show b, Eq b)
      => MkOptDescr (a -> b) (b -> a -> a) a
    choiceOptFromEnum :: forall b a.
    (Bounded b, Enum b, Show b, Eq b) =>
    MkOptDescr (a -> b) (b -> a -> a) a
    choiceOptFromEnum String
    _sf [String]
    _lf String
    d a -> b
    get =
      [(b, OptFlags, String)] -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Eq b =>
    [(b, OptFlags, String)] -> MkOptDescr (a -> b) (b -> a -> a) a
    choiceOpt
        [ (b
    x, (String
    sf, [(Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ b -> String
    forall a. Show a => a -> String
    show b
    x]), String
    d')
        | (b
    x, String
    sf) <- [(b, String)]
    sflags'
        , let d' :: String
    d' = String
    d String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ b -> String
    forall a. Show a => a -> String
    show b
    x
        ]
        String
    _sf
        [String]
    _lf
        String
    d
        a -> b
    get
      where
        sflags' :: [(b, String)]
    sflags' = ([(b, String)] -> b -> [(b, String)])
    -> [(b, String)] -> [b] -> [(b, String)]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl [(b, String)] -> b -> [(b, String)]
    forall {a}. Show a => [(a, String)] -> a -> [(a, String)]
    f [] [b
    firstOne ..]
        f :: [(a, String)] -> a -> [(a, String)]
    f [(a, String)]
    prev a
    x =
          let prevflags :: String
    prevflags = ((a, String) -> String) -> [(a, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (a, String) -> String
    forall a b. (a, b) -> b
    snd [(a, String)]
    prev
           in [(a, String)]
    prev
                [(a, String)] -> [(a, String)] -> [(a, String)]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [(a, String)] -> [(a, String)]
    forall a. Int -> [a] -> [a]
    take
                  Int
    1
                  [ (a
    x, [Char -> Char
    toLower Char
    sf])
                  | Char
    sf <- a -> String
    forall a. Show a => a -> String
    show a
    x
                  , Char -> Bool
    isAlpha Char
    sf
                  , Char -> Char
    toLower Char
    sf Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` String
    prevflags
                  ]
        firstOne :: b
    firstOne = b
    forall a. Bounded a => a
    minBound b -> b -> b
    forall a. a -> a -> a
    `asTypeOf` a -> b
    get a
    forall a. HasCallStack => a
    undefined

    commandGetOpts
      :: ShowOrParseArgs
      -> CommandUI flags
      -> [GetOpt.OptDescr (flags -> flags)]
    commandGetOpts :: forall flags.
    ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    commandGetOpts ShowOrParseArgs
    showOrParse CommandUI flags
    command =
      (OptionField flags -> [OptDescr (flags -> flags)])
    -> [OptionField flags] -> [OptDescr (flags -> flags)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OptionField flags -> [OptDescr (flags -> flags)]
    forall a. OptionField a -> [OptDescr (a -> a)]
    viewAsGetOpt (CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
    forall flags.
    CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
    commandOptions CommandUI flags
    command ShowOrParseArgs
    showOrParse)

    viewAsGetOpt :: OptionField a -> [GetOpt.OptDescr (a -> a)]
    viewAsGetOpt :: forall a. OptionField a -> [OptDescr (a -> a)]
    viewAsGetOpt (OptionField String
    _n [OptDescr a]
    aa) = (OptDescr a -> [OptDescr (a -> a)])
    -> [OptDescr a] -> [OptDescr (a -> a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OptDescr a -> [OptDescr (a -> a)]
    forall {a}. OptDescr a -> [OptDescr (a -> a)]
    optDescrToGetOpt [OptDescr a]
    aa
      where
        optDescrToGetOpt :: OptDescr a -> [OptDescr (a -> a)]
    optDescrToGetOpt (ReqArg String
    d (String
    cs, [String]
    ss) String
    arg_desc ReadE (a -> a)
    set a -> [String]
    _) =
          [String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    cs [String]
    ss ((String -> Either String (a -> a)) -> String -> ArgDescr (a -> a)
    forall a. (String -> Either String a) -> String -> ArgDescr a
    GetOpt.ReqArg (ReadE (a -> a) -> String -> Either String (a -> a)
    forall a. ReadE a -> String -> Either String a
    runReadE ReadE (a -> a)
    set) String
    arg_desc) String
    d]
        optDescrToGetOpt (OptArg String
    d (String
    cs, [String]
    ss) String
    arg_desc ReadE (a -> a)
    set (String
    dv, a -> a
    def) a -> [Maybe String]
    _) =
          [String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    cs [String]
    ss (String
    -> (Maybe String -> Either String (a -> a))
    -> String
    -> ArgDescr (a -> a)
    forall a.
    String -> (Maybe String -> Either String a) -> String -> ArgDescr a
    GetOpt.OptArg String
    dv Maybe String -> Either String (a -> a)
    set' String
    arg_desc) String
    d]
          where
            set' :: Maybe String -> Either String (a -> a)
    set' Maybe String
    Nothing = (a -> a) -> Either String (a -> a)
    forall a b. b -> Either a b
    Right a -> a
    def
            set' (Just String
    txt) = ReadE (a -> a) -> String -> Either String (a -> a)
    forall a. ReadE a -> String -> Either String a
    runReadE ReadE (a -> a)
    set String
    txt
        optDescrToGetOpt (ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    alts) =
          [String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sf [String]
    lf ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg a -> a
    set) String
    d | (String
    d, (String
    sf, [String]
    lf), a -> a
    set, a -> Bool
    _) <- [(String, OptFlags, a -> a, a -> Bool)]
    alts]
        optDescrToGetOpt (BoolOpt String
    d (String
    sfT, [String]
    lfT) ([], []) Bool -> a -> a
    set a -> Maybe Bool
    _) =
          [String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfT [String]
    lfT ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg (Bool -> a -> a
    set Bool
    True)) String
    d]
        optDescrToGetOpt (BoolOpt String
    d ([], []) (String
    sfF, [String]
    lfF) Bool -> a -> a
    set a -> Maybe Bool
    _) =
          [String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfF [String]
    lfF ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg (Bool -> a -> a
    set Bool
    False)) String
    d]
        optDescrToGetOpt (BoolOpt String
    d (String
    sfT, [String]
    lfT) (String
    sfF, [String]
    lfF) Bool -> a -> a
    set a -> Maybe Bool
    _) =
          [ String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfT [String]
    lfT ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg (Bool -> a -> a
    set Bool
    True)) (String
    "Enable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    d)
          , String
    -> [String] -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfF [String]
    lfF ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg (Bool -> a -> a
    set Bool
    False)) (String
    "Disable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    d)
          ]

    getCurrentChoice :: OptDescr a -> a -> [String]
    getCurrentChoice :: forall a. OptDescr a -> a -> [String]
    getCurrentChoice (ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    alts) a
    a =
      [String
    lf | (String
    _, (String
    _sf, String
    lf : [String]
    _), a -> a
    _, a -> Bool
    currentChoice) <- [(String, OptFlags, a -> a, a -> Bool)]
    alts, a -> Bool
    currentChoice a
    a]
    getCurrentChoice OptDescr a
    _ a
    _ = String -> [String]
    forall a. HasCallStack => String -> a
    error String
    "Command.getChoice: expected a Choice OptDescr"

    liftOption :: (b -> a) -> (a -> (b -> b)) -> OptionField a -> OptionField b
    liftOption :: forall b a.
    (b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
    liftOption b -> a
    get' a -> b -> b
    set' OptionField a
    opt =
      OptionField a
    opt{optionDescr = liftOptDescr get' set' `map` optionDescr opt}

    -- | @since 3.4.0.0
    liftOptionL :: ALens' b a -> OptionField a -> OptionField b
    liftOptionL :: forall b a. ALens' b a -> OptionField a -> OptionField b
    liftOptionL ALens' b a
    l = (b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
    forall b a.
    (b -> a) -> (a -> b -> b) -> OptionField a -> OptionField b
    liftOption (b -> ALens' b a -> a
    forall s t a b. s -> ALens s t a b -> a
    ^# ALens' b a
    l) (ALens' b a
    l ALens' b a -> a -> b -> b
    forall s t a b. ALens s t a b -> b -> s -> t
    #~)

    liftOptDescr :: (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b
    liftOptDescr :: forall b a. (b -> a) -> (a -> b -> b) -> OptDescr a -> OptDescr b
    liftOptDescr b -> a
    get' a -> b -> b
    set' (ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    opts) =
      [(String, OptFlags, b -> b, b -> Bool)] -> OptDescr b
    forall a. [(String, OptFlags, a -> a, a -> Bool)] -> OptDescr a
    ChoiceOpt
        [ (String
    d, OptFlags
    ff, (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' a -> a
    set, (a -> Bool
    get (a -> Bool) -> (b -> a) -> b -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    get'))
        | (String
    d, OptFlags
    ff, a -> a
    set, a -> Bool
    get) <- [(String, OptFlags, a -> a, a -> Bool)]
    opts
        ]
    liftOptDescr b -> a
    get' a -> b -> b
    set' (OptArg String
    d OptFlags
    ff String
    ad ReadE (a -> a)
    set (String
    dv, a -> a
    mkDef) a -> [Maybe String]
    get) =
      String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (String, b -> b)
    -> (b -> [Maybe String])
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (String, a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    OptArg
        String
    d
        OptFlags
    ff
        String
    ad
        ((b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' ((a -> a) -> b -> b) -> ReadE (a -> a) -> ReadE (b -> b)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ReadE (a -> a)
    set)
        (String
    dv, (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' a -> a
    mkDef)
        (a -> [Maybe String]
    get (a -> [Maybe String]) -> (b -> a) -> b -> [Maybe String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    get')
    liftOptDescr b -> a
    get' a -> b -> b
    set' (ReqArg String
    d OptFlags
    ff String
    ad ReadE (a -> a)
    set a -> [String]
    get) =
      String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (b -> [String])
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> [String])
    -> OptDescr a
    ReqArg String
    d OptFlags
    ff String
    ad ((b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' ((a -> a) -> b -> b) -> ReadE (a -> a) -> ReadE (b -> b)
    forall a b. (a -> b) -> ReadE a -> ReadE b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ReadE (a -> a)
    set) (a -> [String]
    get (a -> [String]) -> (b -> a) -> b -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    get')
    liftOptDescr b -> a
    get' a -> b -> b
    set' (BoolOpt String
    d OptFlags
    ffT OptFlags
    ffF Bool -> a -> a
    set a -> Maybe Bool
    get) =
      String
    -> OptFlags
    -> OptFlags
    -> (Bool -> b -> b)
    -> (b -> Maybe Bool)
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> OptFlags
    -> (Bool -> a -> a)
    -> (a -> Maybe Bool)
    -> OptDescr a
    BoolOpt String
    d OptFlags
    ffT OptFlags
    ffF ((b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' ((a -> a) -> b -> b) -> (Bool -> a -> a) -> Bool -> b -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> a
    set) (a -> Maybe Bool
    get (a -> Maybe Bool) -> (b -> a) -> b -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    get')

    liftSet :: (b -> a) -> (a -> (b -> b)) -> (a -> a) -> b -> b
    liftSet :: forall b a. (b -> a) -> (a -> b -> b) -> (a -> a) -> b -> b
    liftSet b -> a
    get' a -> b -> b
    set' a -> a
    set b
    x = a -> b -> b
    set' (a -> a
    set (a -> a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ b -> a
    get' b
    x) b
    x

    -- | Show flags in the standard long option command line format
    commandShowOptions :: CommandUI flags -> flags -> [String]
    commandShowOptions :: forall flags. CommandUI flags -> flags -> [String]
    commandShowOptions CommandUI flags
    command flags
    v =
      [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ flags -> OptDescr flags -> [String]
    forall a. a -> OptDescr a -> [String]
    showOptDescr flags
    v OptDescr flags
    od | OptionField flags
    o <- CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
    forall flags.
    CommandUI flags -> ShowOrParseArgs -> [OptionField flags]
    commandOptions CommandUI flags
    command ShowOrParseArgs
    ParseArgs, OptDescr flags
    od <- OptionField flags -> [OptDescr flags]
    forall a. OptionField a -> [OptDescr a]
    optionDescr OptionField flags
    o
        ]
      where
        maybePrefix :: [String] -> [String]
    maybePrefix [] = []
        maybePrefix (String
    lOpt : [String]
    _) = [String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lOpt]

        showOptDescr :: a -> OptDescr a -> [String]
        showOptDescr :: forall a. a -> OptDescr a -> [String]
    showOptDescr a
    x (BoolOpt String
    _ (String
    _, [String]
    lfTs) (String
    _, [String]
    lfFs) Bool -> a -> a
    _ a -> Maybe Bool
    enabled) =
          case a -> Maybe Bool
    enabled a
    x of
            Maybe Bool
    Nothing -> []
            Just Bool
    True -> [String] -> [String]
    maybePrefix [String]
    lfTs
            Just Bool
    False -> [String] -> [String]
    maybePrefix [String]
    lfFs
        showOptDescr a
    x c :: OptDescr a
    c@ChoiceOpt{} =
          [String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    val | String
    val <- OptDescr a -> a -> [String]
    forall a. OptDescr a -> a -> [String]
    getCurrentChoice OptDescr a
    c a
    x]
        showOptDescr a
    x (ReqArg String
    _ (String
    _ssff, String
    lf : [String]
    _) String
    _ ReadE (a -> a)
    _ a -> [String]
    showflag) =
          [ String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lf String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    flag
          | String
    flag <- a -> [String]
    showflag a
    x
          ]
        showOptDescr a
    x (OptArg String
    _ (String
    _ssff, String
    lf : [String]
    _) String
    _ ReadE (a -> a)
    _ (String, a -> a)
    _ a -> [Maybe String]
    showflag) =
          [ case Maybe String
    flag of
            Just String
    s -> String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lf String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
            Maybe String
    Nothing -> String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lf
          | Maybe String
    flag <- a -> [Maybe String]
    showflag a
    x
          ]
        showOptDescr a
    _ OptDescr a
    _ =
          String -> [String]
    forall a. HasCallStack => String -> a
    error String
    "Distribution.Simple.Command.showOptDescr: unreachable"

    commandListOptions :: CommandUI flags -> [String]
    commandListOptions :: forall flags. CommandUI flags -> [String]
    commandListOptions CommandUI flags
    command =
      (OptDescr (Either CommonFlag (flags -> flags)) -> [String])
    -> [OptDescr (Either CommonFlag (flags -> flags))] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OptDescr (Either CommonFlag (flags -> flags)) -> [String]
    forall {a}. OptDescr a -> [String]
    listOption ([OptDescr (Either CommonFlag (flags -> flags))] -> [String])
    -> [OptDescr (Either CommonFlag (flags -> flags))] -> [String]
    forall a b. (a -> b) -> a -> b
    $
        ShowOrParseArgs
    -> [OptDescr (flags -> flags)]
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    forall a.
    ShowOrParseArgs -> [OptDescr a] -> [OptDescr (Either CommonFlag a)]
    addCommonFlags ShowOrParseArgs
    ShowArgs ([OptDescr (flags -> flags)]
     -> [OptDescr (Either CommonFlag (flags -> flags))])
    -> [OptDescr (flags -> flags)]
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    forall a b. (a -> b) -> a -> b
    $ -- This is a slight hack, we don't want
        -- "--list-options" showing up in the
        -- list options output, so use ShowArgs
          ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    forall flags.
    ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    commandGetOpts ShowOrParseArgs
    ShowArgs CommandUI flags
    command
      where
        listOption :: OptDescr a -> [String]
    listOption (GetOpt.Option String
    shortNames [String]
    longNames ArgDescr a
    _ String
    _) =
          [String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    name] | Char
    name <- String
    shortNames]
            [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name | String
    name <- [String]
    longNames]

    -- | The help text for this command with descriptions of all the options.
    commandHelp :: CommandUI flags -> String -> String
    commandHelp :: forall flags. CommandUI flags -> String -> String
    commandHelp CommandUI flags
    command String
    pname =
      CommandUI flags -> String
    forall flags. CommandUI flags -> String
    commandSynopsis CommandUI flags
    command
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\n"
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CommandUI flags -> String -> String
    forall flags. CommandUI flags -> String -> String
    commandUsage CommandUI flags
    command String
    pname
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ( case CommandUI flags -> Maybe (String -> String)
    forall flags. CommandUI flags -> Maybe (String -> String)
    commandDescription CommandUI flags
    command of
              Maybe (String -> String)
    Nothing -> String
    ""
              Just String -> String
    desc -> Char
    '\n' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    desc String
    pname
           )
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ( if String
    cname String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ""
              then String
    "Global flags:"
              else String
    "Flags for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":"
           )
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ( String -> [OptDescr (Either CommonFlag (flags -> flags))] -> String
    forall a. String -> [OptDescr a] -> String
    GetOpt.usageInfo String
    ""
              ([OptDescr (Either CommonFlag (flags -> flags))] -> String)
    -> ([OptDescr (flags -> flags)]
        -> [OptDescr (Either CommonFlag (flags -> flags))])
    -> [OptDescr (flags -> flags)]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowOrParseArgs
    -> [OptDescr (flags -> flags)]
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    forall a.
    ShowOrParseArgs -> [OptDescr a] -> [OptDescr (Either CommonFlag a)]
    addCommonFlags ShowOrParseArgs
    ShowArgs
              ([OptDescr (flags -> flags)] -> String)
    -> [OptDescr (flags -> flags)] -> String
    forall a b. (a -> b) -> a -> b
    $ ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    forall flags.
    ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    commandGetOpts ShowOrParseArgs
    ShowArgs CommandUI flags
    command
           )
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ( case CommandUI flags -> Maybe (String -> String)
    forall flags. CommandUI flags -> Maybe (String -> String)
    commandNotes CommandUI flags
    command of
              Maybe (String -> String)
    Nothing -> String
    ""
              Just String -> String
    notes -> Char
    '\n' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    notes String
    pname
           )
      where
        cname :: String
    cname = CommandUI flags -> String
    forall flags. CommandUI flags -> String
    commandName CommandUI flags
    command

    -- | Default "usage" documentation text for commands.
    usageDefault :: String -> String -> String
    usageDefault :: String -> String -> String
    usageDefault String
    name String
    pname =
      String
    "Usage: "
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " [FLAGS]\n\n"
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Flags for "
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name
        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":"

    -- | Create "usage" documentation from a list of parameter
    --   configurations.
    usageAlternatives :: String -> [String] -> String -> String
    usageAlternatives :: String -> [String] -> String -> String
    usageAlternatives String
    name [String]
    strs String
    pname =
      [String] -> String
    unlines
        [ String
    start String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
        | let starts :: [String]
    starts = String
    "Usage: " String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    forall a. a -> [a]
    repeat String
    "   or: "
        , (String
    start, String
    s) <- [String] -> [String] -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [String]
    starts [String]
    strs
        ]

    -- | Make a Command from standard 'GetOpt' options.
    mkCommandUI
      :: String
      -- ^ name
      -> String
      -- ^ synopsis
      -> [String]
      -- ^ usage alternatives
      -> flags
      -- ^ initial\/empty flags
      -> (ShowOrParseArgs -> [OptionField flags])
      -- ^ options
      -> CommandUI flags
    mkCommandUI :: forall flags.
    String
    -> String
    -> [String]
    -> flags
    -> (ShowOrParseArgs -> [OptionField flags])
    -> CommandUI flags
    mkCommandUI String
    name String
    synopsis [String]
    usages flags
    flags ShowOrParseArgs -> [OptionField flags]
    options =
      CommandUI
        { commandName :: String
    commandName = String
    name
        , commandSynopsis :: String
    commandSynopsis = String
    synopsis
        , commandDescription :: Maybe (String -> String)
    commandDescription = Maybe (String -> String)
    forall a. Maybe a
    Nothing
        , commandNotes :: Maybe (String -> String)
    commandNotes = Maybe (String -> String)
    forall a. Maybe a
    Nothing
        , commandUsage :: String -> String
    commandUsage = String -> [String] -> String -> String
    usageAlternatives String
    name [String]
    usages
        , commandDefaultFlags :: flags
    commandDefaultFlags = flags
    flags
        , commandOptions :: ShowOrParseArgs -> [OptionField flags]
    commandOptions = ShowOrParseArgs -> [OptionField flags]
    options
        }

    -- | Common flags that apply to every command
    data CommonFlag = HelpFlag | ListOptionsFlag

    commonFlags :: ShowOrParseArgs -> [GetOpt.OptDescr CommonFlag]
    commonFlags :: ShowOrParseArgs -> [OptDescr CommonFlag]
    commonFlags ShowOrParseArgs
    showOrParseArgs = case ShowOrParseArgs
    showOrParseArgs of
      ShowOrParseArgs
    ShowArgs -> [OptDescr CommonFlag
    help]
      ShowOrParseArgs
    ParseArgs -> [OptDescr CommonFlag
    help, OptDescr CommonFlag
    list]
      where
        help :: OptDescr CommonFlag
    help =
          String
    -> [String] -> ArgDescr CommonFlag -> String -> OptDescr CommonFlag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option
            String
    helpShortFlags
            [String
    "help"]
            (CommonFlag -> ArgDescr CommonFlag
    forall a. a -> ArgDescr a
    GetOpt.NoArg CommonFlag
    HelpFlag)
            String
    "Show this help text"
        helpShortFlags :: String
    helpShortFlags = case ShowOrParseArgs
    showOrParseArgs of
          ShowOrParseArgs
    ShowArgs -> [Char
    'h']
          ShowOrParseArgs
    ParseArgs -> [Char
    'h', Char
    '?']
        list :: OptDescr CommonFlag
    list =
          String
    -> [String] -> ArgDescr CommonFlag -> String -> OptDescr CommonFlag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option
            []
            [String
    "list-options"]
            (CommonFlag -> ArgDescr CommonFlag
    forall a. a -> ArgDescr a
    GetOpt.NoArg CommonFlag
    ListOptionsFlag)
            String
    "Print a list of command line flags"

    addCommonFlags
      :: ShowOrParseArgs
      -> [GetOpt.OptDescr a]
      -> [GetOpt.OptDescr (Either CommonFlag a)]
    addCommonFlags :: forall a.
    ShowOrParseArgs -> [OptDescr a] -> [OptDescr (Either CommonFlag a)]
    addCommonFlags ShowOrParseArgs
    showOrParseArgs [OptDescr a]
    options =
      (OptDescr CommonFlag -> OptDescr (Either CommonFlag a))
    -> [OptDescr CommonFlag] -> [OptDescr (Either CommonFlag a)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CommonFlag -> Either CommonFlag a)
    -> OptDescr CommonFlag -> OptDescr (Either CommonFlag a)
    forall a b. (a -> b) -> OptDescr a -> OptDescr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CommonFlag -> Either CommonFlag a
    forall a b. a -> Either a b
    Left) (ShowOrParseArgs -> [OptDescr CommonFlag]
    commonFlags ShowOrParseArgs
    showOrParseArgs)
        [OptDescr (Either CommonFlag a)]
    -> [OptDescr (Either CommonFlag a)]
    -> [OptDescr (Either CommonFlag a)]
    forall a. [a] -> [a] -> [a]
    ++ (OptDescr a -> OptDescr (Either CommonFlag a))
    -> [OptDescr a] -> [OptDescr (Either CommonFlag a)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> Either CommonFlag a)
    -> OptDescr a -> OptDescr (Either CommonFlag a)
    forall a b. (a -> b) -> OptDescr a -> OptDescr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Either CommonFlag a
    forall a b. b -> Either a b
    Right) [OptDescr a]
    options

    -- | Parse a bunch of command line arguments
    commandParseArgs
      :: CommandUI flags
      -> Bool
      -- ^ Is the command a global or subcommand?
      -> [String]
      -> CommandParse (flags -> flags, [String])
    commandParseArgs :: forall flags.
    CommandUI flags
    -> Bool -> [String] -> CommandParse (flags -> flags, [String])
    commandParseArgs CommandUI flags
    command Bool
    global [String]
    args =
      let options :: [OptDescr (Either CommonFlag (flags -> flags))]
    options =
            ShowOrParseArgs
    -> [OptDescr (flags -> flags)]
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    forall a.
    ShowOrParseArgs -> [OptDescr a] -> [OptDescr (Either CommonFlag a)]
    addCommonFlags ShowOrParseArgs
    ParseArgs ([OptDescr (flags -> flags)]
     -> [OptDescr (Either CommonFlag (flags -> flags))])
    -> [OptDescr (flags -> flags)]
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    forall a b. (a -> b) -> a -> b
    $
              ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    forall flags.
    ShowOrParseArgs -> CommandUI flags -> [OptDescr (flags -> flags)]
    commandGetOpts ShowOrParseArgs
    ParseArgs CommandUI flags
    command
          order :: ArgOrder a
    order
            | Bool
    global = ArgOrder a
    forall a. ArgOrder a
    GetOpt.RequireOrder
            | Bool
    otherwise = ArgOrder a
    forall a. ArgOrder a
    GetOpt.Permute
       in case ArgOrder (Either CommonFlag (flags -> flags))
    -> [OptDescr (Either CommonFlag (flags -> flags))]
    -> [String]
    -> ([Either CommonFlag (flags -> flags)], [String], [String],
        [String])
    forall a.
    ArgOrder a
    -> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
    GetOpt.getOpt' ArgOrder (Either CommonFlag (flags -> flags))
    forall a. ArgOrder a
    order [OptDescr (Either CommonFlag (flags -> flags))]
    options [String]
    args of
            ([Either CommonFlag (flags -> flags)]
    flags, [String]
    _, [String]
    _, [String]
    _)
              | (Either CommonFlag (flags -> flags) -> Bool)
    -> [Either CommonFlag (flags -> flags)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Either CommonFlag (flags -> flags) -> Bool
    forall {b}. Either CommonFlag b -> Bool
    listFlag [Either CommonFlag (flags -> flags)]
    flags -> [String] -> CommandParse (flags -> flags, [String])
    forall flags. [String] -> CommandParse flags
    CommandList (CommandUI flags -> [String]
    forall flags. CommandUI flags -> [String]
    commandListOptions CommandUI flags
    command)
              | (Either CommonFlag (flags -> flags) -> Bool)
    -> [Either CommonFlag (flags -> flags)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Either CommonFlag (flags -> flags) -> Bool
    forall {b}. Either CommonFlag b -> Bool
    helpFlag [Either CommonFlag (flags -> flags)]
    flags -> (String -> String) -> CommandParse (flags -> flags, [String])
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp (CommandUI flags -> String -> String
    forall flags. CommandUI flags -> String -> String
    commandHelp CommandUI flags
    command)
              where
                listFlag :: Either CommonFlag b -> Bool
    listFlag (Left CommonFlag
    ListOptionsFlag) = Bool
    True; listFlag Either CommonFlag b
    _ = Bool
    False
                helpFlag :: Either CommonFlag b -> Bool
    helpFlag (Left CommonFlag
    HelpFlag) = Bool
    True; helpFlag Either CommonFlag b
    _ = Bool
    False
            ([Either CommonFlag (flags -> flags)]
    flags, [String]
    opts, [String]
    opts', [])
              | Bool
    global Bool -> Bool -> Bool
    || [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    opts' -> (flags -> flags, [String])
    -> CommandParse (flags -> flags, [String])
    forall flags. flags -> CommandParse flags
    CommandReadyToGo ([Either CommonFlag (flags -> flags)] -> flags -> flags
    forall {a} {t}. [Either a (t -> t)] -> t -> t
    accum [Either CommonFlag (flags -> flags)]
    flags, [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    mix [String]
    opts [String]
    opts')
              | Bool
    otherwise -> [String] -> CommandParse (flags -> flags, [String])
    forall flags. [String] -> CommandParse flags
    CommandErrors ([String] -> [String]
    unrecognised [String]
    opts')
            ([Either CommonFlag (flags -> flags)]
    _, [String]
    _, [String]
    _, [String]
    errs) -> [String] -> CommandParse (flags -> flags, [String])
    forall flags. [String] -> CommandParse flags
    CommandErrors [String]
    errs
      where
        -- Note: It is crucial to use reverse function composition here or to
        -- reverse the flags here as we want to process the flags left to right
        -- but data flow in function composition is right to left.
        accum :: [Either a (t -> t)] -> t -> t
    accum [Either a (t -> t)]
    flags = ((t -> t) -> (t -> t) -> t -> t) -> (t -> t) -> [t -> t] -> t -> t
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (((t -> t) -> (t -> t) -> t -> t) -> (t -> t) -> (t -> t) -> t -> t
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (t -> t) -> (t -> t) -> t -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.)) t -> t
    forall a. a -> a
    id [t -> t
    f | Right t -> t
    f <- [Either a (t -> t)]
    flags]
        unrecognised :: [String] -> [String]
    unrecognised [String]
    opts =
          [ String
    "unrecognized "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (CommandUI flags -> String
    forall flags. CommandUI flags -> String
    commandName CommandUI flags
    command)
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " option `"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    opt
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'\n"
          | String
    opt <- [String]
    opts
          ]
        -- For unrecognised global flags we put them in the position just after
        -- the command, if there is one. This gives us a chance to parse them
        -- as sub-command rather than global flags.
        mix :: [a] -> [a] -> [a]
    mix [] [a]
    ys = [a]
    ys
        mix (a
    x : [a]
    xs) [a]
    ys = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ys [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    xs

    data CommandParse flags
      = CommandHelp (String -> String)
      | CommandList [String]
      | CommandErrors [String]
      | CommandReadyToGo flags
    instance Functor CommandParse where
      fmap :: forall a b. (a -> b) -> CommandParse a -> CommandParse b
    fmap a -> b
    _ (CommandHelp String -> String
    help) = (String -> String) -> CommandParse b
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
      fmap a -> b
    _ (CommandList [String]
    opts) = [String] -> CommandParse b
    forall flags. [String] -> CommandParse flags
    CommandList [String]
    opts
      fmap a -> b
    _ (CommandErrors [String]
    errs) = [String] -> CommandParse b
    forall flags. [String] -> CommandParse flags
    CommandErrors [String]
    errs
      fmap a -> b
    f (CommandReadyToGo a
    flags) = b -> CommandParse b
    forall flags. flags -> CommandParse flags
    CommandReadyToGo (a -> b
    f a
    flags)

    data CommandType = NormalCommand | HiddenCommand
    data Command action
      = Command String String ([String] -> CommandParse action) CommandType

    -- | Mark command as hidden. Hidden commands don't show up in the 'progname
    -- help' or 'progname --help' output.
    hiddenCommand :: Command action -> Command action
    hiddenCommand :: forall action. Command action -> Command action
    hiddenCommand (Command String
    name String
    synopsis [String] -> CommandParse action
    f CommandType
    _cmdType) =
      String
    -> String
    -> ([String] -> CommandParse action)
    -> CommandType
    -> Command action
    forall action.
    String
    -> String
    -> ([String] -> CommandParse action)
    -> CommandType
    -> Command action
    Command String
    name String
    synopsis [String] -> CommandParse action
    f CommandType
    HiddenCommand

    commandAddAction
      :: CommandUI flags
      -> (flags -> [String] -> action)
      -> Command action
    commandAddAction :: forall flags action.
    CommandUI flags -> (flags -> [String] -> action) -> Command action
    commandAddAction CommandUI flags
    command flags -> [String] -> action
    action =
      String
    -> String
    -> ([String] -> CommandParse action)
    -> CommandType
    -> Command action
    forall action.
    String
    -> String
    -> ([String] -> CommandParse action)
    -> CommandType
    -> Command action
    Command
        (CommandUI flags -> String
    forall flags. CommandUI flags -> String
    commandName CommandUI flags
    command)
        (CommandUI flags -> String
    forall flags. CommandUI flags -> String
    commandSynopsis CommandUI flags
    command)
        (((flags -> flags, [String]) -> action)
    -> CommandParse (flags -> flags, [String]) -> CommandParse action
    forall a b. (a -> b) -> CommandParse a -> CommandParse b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((flags -> flags) -> [String] -> action)
    -> (flags -> flags, [String]) -> action
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (flags -> flags) -> [String] -> action
    applyDefaultArgs) (CommandParse (flags -> flags, [String]) -> CommandParse action)
    -> ([String] -> CommandParse (flags -> flags, [String]))
    -> [String]
    -> CommandParse action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandUI flags
    -> Bool -> [String] -> CommandParse (flags -> flags, [String])
    forall flags.
    CommandUI flags
    -> Bool -> [String] -> CommandParse (flags -> flags, [String])
    commandParseArgs CommandUI flags
    command Bool
    False)
        CommandType
    NormalCommand
      where
        applyDefaultArgs :: (flags -> flags) -> [String] -> action
    applyDefaultArgs flags -> flags
    mkflags [String]
    args =
          let flags :: flags
    flags = flags -> flags
    mkflags (CommandUI flags -> flags
    forall flags. CommandUI flags -> flags
    commandDefaultFlags CommandUI flags
    command)
           in flags -> [String] -> action
    action flags
    flags [String]
    args

    -- Print suggested command if edit distance is < 5
    badCommand :: [Command action] -> String -> CommandParse a
    badCommand :: forall action a. [Command action] -> String -> CommandParse a
    badCommand [Command action]
    commands' String
    cname =
      case [String]
    eDists of
        [] -> [String] -> CommandParse a
    forall flags. [String] -> CommandParse flags
    CommandErrors [String
    unErr]
        (String
    s : [String]
    _) ->
          [String] -> CommandParse a
    forall flags. [String] -> CommandParse flags
    CommandErrors
            [ String
    unErr
            , String
    "Maybe you meant `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "`?\n"
            ]
      where
        eDists :: [String]
    eDists =
          ((String, Int) -> String) -> [(String, Int)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Int) -> String
    forall a b. (a, b) -> a
    fst ([(String, Int)] -> [String])
    -> ([(String, Int)] -> [(String, Int)])
    -> [(String, Int)]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, Int) -> (String, Int) -> Ordering)
    -> [(String, Int)] -> [(String, Int)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    List.sortBy (((String, Int) -> Int)
    -> (String, Int) -> (String, Int) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (String, Int) -> Int
    forall a b. (a, b) -> b
    snd) ([(String, Int)] -> [String]) -> [(String, Int)] -> [String]
    forall a b. (a -> b) -> a -> b
    $
            [ (String
    cname', Int
    dist)
            | -- Note that this is not commandNames, so close suggestions will show
            -- hidden commands
            (Command String
    cname' String
    _ [String] -> CommandParse action
    _ CommandType
    _) <- [Command action]
    commands'
            , let dist :: Int
    dist = String -> String -> Int
    forall a. Eq a => [a] -> [a] -> Int
    editDistance String
    cname' String
    cname
            , Int
    dist Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    5
            ]
        unErr :: String
    unErr = String
    "unrecognised command: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (try --help)"

    commandsRun
      :: CommandUI a
      -> [Command action]
      -> [String]
      -> IO (CommandParse (a, CommandParse action))
    commandsRun :: forall a action.
    CommandUI a
    -> [Command action]
    -> [String]
    -> IO (CommandParse (a, CommandParse action))
    commandsRun CommandUI a
    globalCommand [Command action]
    commands [String]
    args =
      CommandUI a
    -> [Command action]
    -> ([Command action]
        -> String -> [String] -> IO (CommandParse action))
    -> [String]
    -> IO (CommandParse (a, CommandParse action))
    forall a action.
    CommandUI a
    -> [Command action]
    -> ([Command action]
        -> String -> [String] -> IO (CommandParse action))
    -> [String]
    -> IO (CommandParse (a, CommandParse action))
    commandsRunWithFallback CommandUI a
    globalCommand [Command action]
    commands [Command action] -> String -> [String] -> IO (CommandParse action)
    forall action.
    [Command action] -> String -> [String] -> IO (CommandParse action)
    defaultCommandFallback [String]
    args

    defaultCommandFallback
      :: [Command action]
      -> String
      -> [String]
      -> IO (CommandParse action)
    defaultCommandFallback :: forall action.
    [Command action] -> String -> [String] -> IO (CommandParse action)
    defaultCommandFallback [Command action]
    commands' String
    name [String]
    _cmdArgs = CommandParse action -> IO (CommandParse action)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse action -> IO (CommandParse action))
    -> CommandParse action -> IO (CommandParse action)
    forall a b. (a -> b) -> a -> b
    $ [Command action] -> String -> CommandParse action
    forall action a. [Command action] -> String -> CommandParse a
    badCommand [Command action]
    commands' String
    name

    commandsRunWithFallback
      :: CommandUI a
      -> [Command action]
      -> ([Command action] -> String -> [String] -> IO (CommandParse action))
      -> [String]
      -> IO (CommandParse (a, CommandParse action))
    commandsRunWithFallback :: forall a action.
    CommandUI a
    -> [Command action]
    -> ([Command action]
        -> String -> [String] -> IO (CommandParse action))
    -> [String]
    -> IO (CommandParse (a, CommandParse action))
    commandsRunWithFallback CommandUI a
    globalCommand [Command action]
    commands [Command action] -> String -> [String] -> IO (CommandParse action)
    defaultCommand [String]
    args =
      case CommandUI a -> Bool -> [String] -> CommandParse (a -> a, [String])
    forall flags.
    CommandUI flags
    -> Bool -> [String] -> CommandParse (flags -> flags, [String])
    commandParseArgs CommandUI a
    globalCommand Bool
    True [String]
    args of
        CommandHelp String -> String
    help -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
        CommandList [String]
    opts -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ [String] -> CommandParse (a, CommandParse action)
    forall flags. [String] -> CommandParse flags
    CommandList ([String]
    opts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    commandNames)
        CommandErrors [String]
    errs -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ [String] -> CommandParse (a, CommandParse action)
    forall flags. [String] -> CommandParse flags
    CommandErrors [String]
    errs
        CommandReadyToGo (a -> a
    mkflags, [String]
    args') -> case [String]
    args' of
          (String
    "help" : [String]
    cmdArgs) -> a -> [String] -> IO (CommandParse (a, CommandParse action))
    forall {a}.
    a -> [String] -> IO (CommandParse (a, CommandParse action))
    handleHelpCommand a
    flags [String]
    cmdArgs
          (String
    name : [String]
    cmdArgs) -> case String -> [Command action]
    lookupCommand String
    name of
            [Command String
    _ String
    _ [String] -> CommandParse action
    action CommandType
    _] ->
              CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (a, CommandParse action) -> CommandParse (a, CommandParse action)
    forall flags. flags -> CommandParse flags
    CommandReadyToGo (a
    flags, [String] -> CommandParse action
    action [String]
    cmdArgs)
            [Command action]
    _ -> do
              final_cmd <- [Command action] -> String -> [String] -> IO (CommandParse action)
    defaultCommand [Command action]
    commands' String
    name [String]
    cmdArgs
              return $ CommandReadyToGo (flags, final_cmd)
          [] -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (a, CommandParse action) -> CommandParse (a, CommandParse action)
    forall flags. flags -> CommandParse flags
    CommandReadyToGo (a
    flags, CommandParse action
    forall {flags}. CommandParse flags
    noCommand)
          where
            flags :: a
    flags = a -> a
    mkflags (CommandUI a -> a
    forall flags. CommandUI flags -> flags
    commandDefaultFlags CommandUI a
    globalCommand)
      where
        lookupCommand :: String -> [Command action]
    lookupCommand String
    cname =
          [ Command action
    cmd | cmd :: Command action
    cmd@(Command String
    cname' String
    _ [String] -> CommandParse action
    _ CommandType
    _) <- [Command action]
    commands', String
    cname' String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    cname
          ]

        noCommand :: CommandParse flags
    noCommand = [String] -> CommandParse flags
    forall flags. [String] -> CommandParse flags
    CommandErrors [String
    "no command given (try --help)\n"]

        commands' :: [Command action]
    commands' = [Command action]
    commands [Command action] -> [Command action] -> [Command action]
    forall a. [a] -> [a] -> [a]
    ++ [CommandUI () -> (() -> [String] -> action) -> Command action
    forall flags action.
    CommandUI flags -> (flags -> [String] -> action) -> Command action
    commandAddAction CommandUI ()
    helpCommandUI () -> [String] -> action
    forall a. HasCallStack => a
    undefined]
        commandNames :: [String]
    commandNames = [String
    name | (Command String
    name String
    _ [String] -> CommandParse action
    _ CommandType
    NormalCommand) <- [Command action]
    commands']

        -- A bit of a hack: support "prog help" as a synonym of "prog --help"
        -- furthermore, support "prog help command" as "prog command --help"
        handleHelpCommand :: a -> [String] -> IO (CommandParse (a, CommandParse action))
    handleHelpCommand a
    flags [String]
    cmdArgs =
          case CommandUI ()
    -> Bool -> [String] -> CommandParse (() -> (), [String])
    forall flags.
    CommandUI flags
    -> Bool -> [String] -> CommandParse (flags -> flags, [String])
    commandParseArgs CommandUI ()
    helpCommandUI Bool
    True [String]
    cmdArgs of
            CommandHelp String -> String
    help -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
            CommandList [String]
    list -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ [String] -> CommandParse (a, CommandParse action)
    forall flags. [String] -> CommandParse flags
    CommandList ([String]
    list [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    commandNames)
            CommandErrors [String]
    _ -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
            CommandReadyToGo (() -> ()
    _, []) -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
            CommandReadyToGo (() -> ()
    _, (String
    name : [String]
    cmdArgs')) ->
              case String -> [Command action]
    lookupCommand String
    name of
                [Command String
    _ String
    _ [String] -> CommandParse action
    action CommandType
    _] ->
                  case [String] -> CommandParse action
    action (String
    "--help" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    cmdArgs') of
                    CommandHelp String -> String
    help -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
                    CommandList [String]
    _ -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ [String] -> CommandParse (a, CommandParse action)
    forall flags. [String] -> CommandParse flags
    CommandList []
                    CommandParse action
    _ -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CommandParse (a, CommandParse action)
     -> IO (CommandParse (a, CommandParse action)))
    -> CommandParse (a, CommandParse action)
    -> IO (CommandParse (a, CommandParse action))
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
                [Command action]
    _ -> do
                  fall_back <- [Command action] -> String -> [String] -> IO (CommandParse action)
    defaultCommand [Command action]
    commands' String
    name (String
    "--help" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    cmdArgs')
                  return $ CommandReadyToGo (flags, fall_back)
          where
            globalHelp :: String -> String
    globalHelp = CommandUI a -> String -> String
    forall flags. CommandUI flags -> String -> String
    commandHelp CommandUI a
    globalCommand

    -- Levenshtein distance, from https://wiki.haskell.org/Edit_distance
    -- (Author: JeanPhilippeBernardy, Simple Permissive Licence)
    editDistance :: Eq a => [a] -> [a] -> Int
    editDistance :: forall a. Eq a => [a] -> [a] -> Int
    editDistance [a]
    xs [a]
    ys = Array (Int, Int) Int
    table Array (Int, Int) Int -> (Int, Int) -> Int
    forall i e. Ix i => Array i e -> i -> e
    Array.! (Int
    m, Int
    n)
      where
        (Int
    m, Int
    n) = ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs, [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    ys)
        x :: Array Int a
    x = (Int, Int) -> [(Int, a)] -> Array Int a
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    Array.array (Int
    1, Int
    m) ([Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1 ..] [a]
    xs)
        y :: Array Int a
    y = (Int, Int) -> [(Int, a)] -> Array Int a
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    Array.array (Int
    1, Int
    n) ([Int] -> [a] -> [(Int, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1 ..] [a]
    ys)

        table :: Array.Array (Int, Int) Int
        table :: Array (Int, Int) Int
    table = ((Int, Int), (Int, Int))
    -> [((Int, Int), Int)] -> Array (Int, Int) Int
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    Array.array ((Int, Int), (Int, Int))
    bnds [((Int, Int)
    ij, (Int, Int) -> Int
    dist (Int, Int)
    ij) | (Int, Int)
    ij <- ((Int, Int), (Int, Int)) -> [(Int, Int)]
    forall a. Ix a => (a, a) -> [a]
    Array.range ((Int, Int), (Int, Int))
    bnds]
        bnds :: ((Int, Int), (Int, Int))
    bnds = ((Int
    0, Int
    0), (Int
    m, Int
    n))

        dist :: (Int, Int) -> Int
    dist (Int
    0, Int
    j) = Int
    j
        dist (Int
    i, Int
    0) = Int
    i
        dist (Int
    i, Int
    j) =
          [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum
            [ Array (Int, Int) Int
    table Array (Int, Int) Int -> (Int, Int) -> Int
    forall i e. Ix i => Array i e -> i -> e
    Array.! (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    j) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
            , Array (Int, Int) Int
    table Array (Int, Int) Int -> (Int, Int) -> Int
    forall i e. Ix i => Array i e -> i -> e
    Array.! (Int
    i, Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
            , if Array Int a
    x Array Int a -> Int -> a
    forall i e. Ix i => Array i e -> i -> e
    Array.! Int
    i a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Array Int a
    y Array Int a -> Int -> a
    forall i e. Ix i => Array i e -> i -> e
    Array.! Int
    j
                then Array (Int, Int) Int
    table Array (Int, Int) Int -> (Int, Int) -> Int
    forall i e. Ix i => Array i e -> i -> e
    Array.! (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                else Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Array (Int, Int) Int
    table Array (Int, Int) Int -> (Int, Int) -> Int
    forall i e. Ix i => Array i e -> i -> e
    Array.! (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    j Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
            ]

    -- | Utility function, many commands do not accept additional flags. This
    -- action fails with a helpful error message if the user supplies any extra.
    noExtraFlags :: [String] -> IO ()
    noExtraFlags :: [String] -> IO ()
    noExtraFlags [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    noExtraFlags [String]
    extraFlags =
      String -> IO ()
    forall a. String -> IO a
    dieNoVerbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unrecognised flags: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String]
    extraFlags

    -- TODO: eliminate this function and turn it into a variant on commandAddAction
    --      instead like commandAddActionNoArgs that doesn't supply the [String]

    -- | Helper function for creating globalCommand description
    getNormalCommandDescriptions :: [Command action] -> [(String, String)]
    getNormalCommandDescriptions :: forall action. [Command action] -> [(String, String)]
    getNormalCommandDescriptions [Command action]
    cmds =
      [ (String
    name, String
    description)
      | Command String
    name String
    description [String] -> CommandParse action
    _ CommandType
    NormalCommand <- [Command action]
    cmds
      ]

    helpCommandUI :: CommandUI ()
    helpCommandUI :: CommandUI ()
    helpCommandUI =
      ( String
    -> String
    -> [String]
    -> ()
    -> (ShowOrParseArgs -> [OptionField ()])
    -> CommandUI ()
    forall flags.
    String
    -> String
    -> [String]
    -> flags
    -> (ShowOrParseArgs -> [OptionField flags])
    -> CommandUI flags
    mkCommandUI
          String
    "help"
          String
    "Help about commands."
          [String
    "[FLAGS]", String
    "COMMAND [FLAGS]"]
          ()
          ([OptionField ()] -> ShowOrParseArgs -> [OptionField ()]
    forall a b. a -> b -> a
    const [])
      )
        { commandNotes = Just $ \String
    pname ->
            String
    "Examples:\n"
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "  "
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pname
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " help help\n"
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "    Oh, apparently you already know this.\n"
        }

    -- | wraps a @CommandUI@ together with a function that turns it into a @Command@.
    -- By hiding the type of flags for the UI allows construction of a list of all UIs at the
    -- top level of the program. That list can then be used for generation of manual page
    -- as well as for executing the selected command.
    data CommandSpec action
      = forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandType

    commandFromSpec :: CommandSpec a -> Command a
    commandFromSpec :: forall a. CommandSpec a -> Command a
    commandFromSpec (CommandSpec CommandUI flags
    ui CommandUI flags -> Command a
    action CommandType
    _) = CommandUI flags -> Command a
    action CommandUI flags
    ui