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

    -----------------------------------------------------------------------------
    -- |
    -- 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,

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

    -- ** Constructing Option Fields
      option, multiOption,

    -- ** Liftings & Projections
      liftOption, liftOptionL,

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

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

      ) where

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

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

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

    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)) (a->a)  (a -> [Maybe String])

                     | ChoiceOpt [(Description, OptFlags, a->a, a -> Bool)]

                     | BoolOpt Description OptFlags{-True-} OptFlags{-False-}
                       (Bool -> a -> a) (a-> Maybe Bool)

    -- | 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
    -> LFlags
    -> String
    -> get
    -> set
    -> MkOptDescr get set a
    -> OptionField a
    option String
    sf lf :: LFlags
    lf@(String
    n:LFlags
    _) 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 LFlags
    lf String
    d get
    get set
    set]
    option String
    _ LFlags
    _ 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 -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg String
    ad ReadE b
    mkflag b -> LFlags
    showflag String
    sf LFlags
    lf String
    d a -> b
    get b -> a -> a
    set =
      String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> LFlags)
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> LFlags)
    -> OptDescr a
    ReqArg String
    d (String
    sf,LFlags
    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 -> LFlags
    showflag (b -> LFlags) -> (a -> b) -> a -> LFlags
    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 -> b -> (b -> [Maybe String])
                       -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg :: forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> b
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    optArg String
    ad ReadE b
    mkflag b
    def b -> [Maybe String]
    showflag String
    sf LFlags
    lf String
    d a -> b
    get b -> a -> a
    set  =
      String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> a)
    -> (a -> [Maybe String])
    -> OptDescr a
    OptArg String
    d (String
    sf,LFlags
    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)
                   (\a
    b ->          b -> a -> a
    set (a -> b
    get a
    b b -> b -> b
    forall a. Monoid a => a -> a -> a
    `mappend` b
    def) 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 -> LFlags)
    -> MkOptDescr (a -> b) (b -> a -> a) a
    reqArg' String
    ad String -> b
    mkflag b -> LFlags
    showflag =
        String
    -> ReadE b -> (b -> LFlags) -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Monoid b =>
    String
    -> ReadE b -> (b -> LFlags) -> 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 -> LFlags
    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
    -> b
    -> (b -> [Maybe String])
    -> MkOptDescr (a -> b) (b -> a -> a) a
    forall b a.
    Monoid b =>
    String
    -> ReadE b
    -> 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)) b
    def b -> [Maybe String]
    showflag
          where def :: b
    def = Maybe String -> b
    mkflag Maybe String
    forall a. Maybe a
    Nothing

    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 LFlags
    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,LFlags
    lf), String
    d)] String
    sf LFlags
    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 :: LFlags
    _lf@(String
    n:LFlags
    _) 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
    _ LFlags
    _ 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 LFlags
    _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 LFlags
    _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 LFlags
    _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 LFlags
    _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,LFlags
    ss) String
    arg_desc ReadE (a -> a)
    set a -> LFlags
    _) =
             [String
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    cs LFlags
    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,LFlags
    ss) String
    arg_desc ReadE (a -> a)
    set a -> a
    def a -> [Maybe String]
    _) =
             [String
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    cs LFlags
    ss ((Maybe String -> Either String (a -> a))
    -> String -> ArgDescr (a -> a)
    forall a. (Maybe String -> Either String a) -> String -> ArgDescr a
    GetOpt.OptArg 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
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sf LFlags
    lf ((a -> a) -> ArgDescr (a -> a)
    forall a. a -> ArgDescr a
    GetOpt.NoArg a -> a
    set) String
    d | (String
    d,(String
    sf,LFlags
    lf),a -> a
    set,a -> Bool
    _) <- [(String, OptFlags, a -> a, a -> Bool)]
    alts ]
        optDescrToGetOpt (BoolOpt String
    d (String
    sfT, LFlags
    lfT) ([],  [])  Bool -> a -> a
    set a -> Maybe Bool
    _) =
             [ String
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfT LFlags
    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, LFlags
    lfF) Bool -> a -> a
    set a -> Maybe Bool
    _) =
             [ String
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfF LFlags
    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,LFlags
    lfT)  (String
    sfF, LFlags
    lfF) Bool -> a -> a
    set a -> Maybe Bool
    _) =
             [ String
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfT LFlags
    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
    -> LFlags -> ArgDescr (a -> a) -> String -> OptDescr (a -> a)
    forall a. String -> LFlags -> ArgDescr a -> String -> OptDescr a
    GetOpt.Option String
    sfF LFlags
    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 -> LFlags
    getCurrentChoice (ChoiceOpt [(String, OptFlags, a -> a, a -> Bool)]
    alts) a
    a =
        [ String
    lf | (String
    _,(String
    _sf,String
    lf:LFlags
    _), a -> a
    _, a -> Bool
    currentChoice) <- [(String, OptFlags, a -> a, a -> Bool)]
    alts, a -> Bool
    currentChoice a
    a]

    getCurrentChoice OptDescr a
    _ a
    _ = String -> LFlags
    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 a -> a
    def a -> [Maybe String]
    get) =
        String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (b -> b)
    -> (b -> [Maybe String])
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (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)
        ((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
    def) (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 -> LFlags
    get) =
        String
    -> OptFlags
    -> String
    -> ReadE (b -> b)
    -> (b -> LFlags)
    -> OptDescr b
    forall a.
    String
    -> OptFlags
    -> String
    -> ReadE (a -> a)
    -> (a -> LFlags)
    -> 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 -> LFlags
    get (a -> LFlags) -> (b -> a) -> b -> LFlags
    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 -> LFlags
    commandShowOptions CommandUI flags
    command flags
    v = [LFlags] -> LFlags
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
      [ flags -> OptDescr flags -> LFlags
    forall a. a -> OptDescr a -> LFlags
    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 :: LFlags -> LFlags
    maybePrefix []       = []
        maybePrefix (String
    lOpt:LFlags
    _) = [String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lOpt]

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

    commandListOptions :: CommandUI flags -> [String]
    commandListOptions :: forall flags. CommandUI flags -> LFlags
    commandListOptions CommandUI flags
    command =
      (OptDescr (Either CommonFlag (flags -> flags)) -> LFlags)
    -> [OptDescr (Either CommonFlag (flags -> flags))] -> LFlags
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OptDescr (Either CommonFlag (flags -> flags)) -> LFlags
    forall {a}. OptDescr a -> LFlags
    listOption ([OptDescr (Either CommonFlag (flags -> flags))] -> LFlags)
    -> [OptDescr (Either CommonFlag (flags -> flags))] -> LFlags
    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 -> LFlags
    listOption (GetOpt.Option String
    shortNames LFlags
    longNames ArgDescr a
    _ String
    _) =
             [ String
    "-"  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    name] | Char
    name <- String
    shortNames ]
          LFlags -> LFlags -> LFlags
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    name  | String
    name <- LFlags
    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 -> LFlags -> String -> String
    usageAlternatives String
    name LFlags
    strs String
    pname = LFlags -> 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 :: LFlags
    starts = String
    "Usage: " String -> LFlags -> LFlags
    forall a. a -> [a] -> [a]
    : String -> LFlags
    forall a. a -> [a]
    repeat String
    "   or: "
      , (String
    start, String
    s) <- LFlags -> LFlags -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip LFlags
    starts LFlags
    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
    -> LFlags
    -> flags
    -> (ShowOrParseArgs -> [OptionField flags])
    -> CommandUI flags
    mkCommandUI String
    name String
    synopsis LFlags
    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 -> LFlags -> String -> String
    usageAlternatives String
    name LFlags
    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
    -> LFlags -> ArgDescr CommonFlag -> String -> OptDescr CommonFlag
    forall a. String -> LFlags -> 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
    -> LFlags -> ArgDescr CommonFlag -> String -> OptDescr CommonFlag
    forall a. String -> LFlags -> 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 -> LFlags -> CommandParse (flags -> flags, LFlags)
    commandParseArgs CommandUI flags
    command Bool
    global LFlags
    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))]
    -> LFlags
    -> ([Either CommonFlag (flags -> flags)], LFlags, LFlags, LFlags)
    forall a.
    ArgOrder a
    -> [OptDescr a] -> LFlags -> ([a], LFlags, LFlags, LFlags)
    GetOpt.getOpt' ArgOrder (Either CommonFlag (flags -> flags))
    forall a. ArgOrder a
    order [OptDescr (Either CommonFlag (flags -> flags))]
    options LFlags
    args of
        ([Either CommonFlag (flags -> flags)]
    flags, LFlags
    _, LFlags
    _,  LFlags
    _)
          | (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 -> LFlags -> CommandParse (flags -> flags, LFlags)
    forall flags. LFlags -> CommandParse flags
    CommandList (CommandUI flags -> LFlags
    forall flags. CommandUI flags -> LFlags
    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, LFlags)
    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, LFlags
    opts, LFlags
    opts', [])
          | Bool
    global Bool -> Bool -> Bool
    || LFlags -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null LFlags
    opts' -> (flags -> flags, LFlags) -> CommandParse (flags -> flags, LFlags)
    forall flags. flags -> CommandParse flags
    CommandReadyToGo ([Either CommonFlag (flags -> flags)] -> flags -> flags
    forall {a} {c}. [Either a (c -> c)] -> c -> c
    accum [Either CommonFlag (flags -> flags)]
    flags, LFlags -> LFlags -> LFlags
    forall a. [a] -> [a] -> [a]
    mix LFlags
    opts LFlags
    opts')
          | Bool
    otherwise            -> LFlags -> CommandParse (flags -> flags, LFlags)
    forall flags. LFlags -> CommandParse flags
    CommandErrors (LFlags -> LFlags
    unrecognised LFlags
    opts')
        ([Either CommonFlag (flags -> flags)]
    _, LFlags
    _, LFlags
    _, LFlags
    errs)          -> LFlags -> CommandParse (flags -> flags, LFlags)
    forall flags. LFlags -> CommandParse flags
    CommandErrors LFlags
    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 (c -> c)] -> c -> c
    accum [Either a (c -> c)]
    flags = ((c -> c) -> (c -> c) -> c -> c) -> (c -> c) -> [c -> c] -> c -> c
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (((c -> c) -> (c -> c) -> c -> c) -> (c -> c) -> (c -> c) -> c -> c
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (c -> c) -> (c -> c) -> c -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.)) c -> c
    forall a. a -> a
    id [ c -> c
    f | Right c -> c
    f <- [Either a (c -> c)]
    flags ]
            unrecognised :: LFlags -> LFlags
    unrecognised LFlags
    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 <- LFlags
    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
    xa -> [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 LFlags
    opts)       = LFlags -> CommandParse b
    forall flags. LFlags -> CommandParse flags
    CommandList LFlags
    opts
      fmap a -> b
    _ (CommandErrors LFlags
    errs)     = LFlags -> CommandParse b
    forall flags. LFlags -> CommandParse flags
    CommandErrors LFlags
    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
    synopsys LFlags -> CommandParse action
    f CommandType
    _cmdType) =
      String
    -> String
    -> (LFlags -> CommandParse action)
    -> CommandType
    -> Command action
    forall action.
    String
    -> String
    -> (LFlags -> CommandParse action)
    -> CommandType
    -> Command action
    Command String
    name String
    synopsys LFlags -> CommandParse action
    f CommandType
    HiddenCommand

    commandAddAction :: CommandUI flags
                     -> (flags -> [String] -> action)
                     -> Command action
    commandAddAction :: forall flags action.
    CommandUI flags -> (flags -> LFlags -> action) -> Command action
    commandAddAction CommandUI flags
    command flags -> LFlags -> action
    action =
      String
    -> String
    -> (LFlags -> CommandParse action)
    -> CommandType
    -> Command action
    forall action.
    String
    -> String
    -> (LFlags -> 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, LFlags) -> action)
    -> CommandParse (flags -> flags, LFlags) -> 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) -> LFlags -> action)
    -> (flags -> flags, LFlags) -> action
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (flags -> flags) -> LFlags -> action
    applyDefaultArgs) (CommandParse (flags -> flags, LFlags) -> CommandParse action)
    -> (LFlags -> CommandParse (flags -> flags, LFlags))
    -> LFlags
    -> CommandParse action
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandUI flags
    -> Bool -> LFlags -> CommandParse (flags -> flags, LFlags)
    forall flags.
    CommandUI flags
    -> Bool -> LFlags -> CommandParse (flags -> flags, LFlags)
    commandParseArgs CommandUI flags
    command Bool
    False)
              CommandType
    NormalCommand

      where applyDefaultArgs :: (flags -> flags) -> LFlags -> action
    applyDefaultArgs flags -> flags
    mkflags LFlags
    args =
              let flags :: flags
    flags = flags -> flags
    mkflags (CommandUI flags -> flags
    forall flags. CommandUI flags -> flags
    commandDefaultFlags CommandUI flags
    command)
               in flags -> LFlags -> action
    action flags
    flags LFlags
    args

    commandsRun :: CommandUI a
                -> [Command action]
                -> [String]
                -> CommandParse (a, CommandParse action)
    commandsRun :: forall a action.
    CommandUI a
    -> [Command action]
    -> LFlags
    -> CommandParse (a, CommandParse action)
    commandsRun CommandUI a
    globalCommand [Command action]
    commands LFlags
    args =
      case CommandUI a -> Bool -> LFlags -> CommandParse (a -> a, LFlags)
    forall flags.
    CommandUI flags
    -> Bool -> LFlags -> CommandParse (flags -> flags, LFlags)
    commandParseArgs CommandUI a
    globalCommand Bool
    True LFlags
    args of
        CommandHelp      String -> String
    help          -> (String -> String) -> CommandParse (a, CommandParse action)
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
        CommandList      LFlags
    opts          -> LFlags -> CommandParse (a, CommandParse action)
    forall flags. LFlags -> CommandParse flags
    CommandList (LFlags
    opts LFlags -> LFlags -> LFlags
    forall a. [a] -> [a] -> [a]
    ++ LFlags
    commandNames)
        CommandErrors    LFlags
    errs          -> LFlags -> CommandParse (a, CommandParse action)
    forall flags. LFlags -> CommandParse flags
    CommandErrors LFlags
    errs
        CommandReadyToGo (a -> a
    mkflags, LFlags
    args') -> case LFlags
    args' of
          (String
    "help":LFlags
    cmdArgs) -> LFlags -> CommandParse (a, CommandParse action)
    forall flags. LFlags -> CommandParse flags
    handleHelpCommand LFlags
    cmdArgs
          (String
    name:LFlags
    cmdArgs)   -> case String -> [Command action]
    lookupCommand String
    name of
            [Command String
    _ String
    _ LFlags -> CommandParse action
    action CommandType
    _]
              -> (a, CommandParse action) -> CommandParse (a, CommandParse action)
    forall flags. flags -> CommandParse flags
    CommandReadyToGo (a
    flags, LFlags -> CommandParse action
    action LFlags
    cmdArgs)
            [Command action]
    _ -> (a, CommandParse action) -> CommandParse (a, CommandParse action)
    forall flags. flags -> CommandParse flags
    CommandReadyToGo (a
    flags, String -> CommandParse action
    forall a. String -> CommandParse a
    badCommand String
    name)
          []               -> (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
    _ LFlags -> CommandParse action
    _ CommandType
    _) <- [Command action]
    commands'
                                    , String
    cname' String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    cname ]
        noCommand :: CommandParse flags
    noCommand        = LFlags -> CommandParse flags
    forall flags. LFlags -> CommandParse flags
    CommandErrors [String
    "no command given (try --help)\n"]

        -- Print suggested command if edit distance is < 5
        badCommand :: String -> CommandParse a
        badCommand :: forall a. String -> CommandParse a
    badCommand String
    cname =
          case LFlags
    eDists of
            [] -> LFlags -> CommandParse a
    forall flags. LFlags -> CommandParse flags
    CommandErrors [String
    unErr]
            (String
    s:LFlags
    _) -> LFlags -> CommandParse a
    forall flags. LFlags -> 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 :: LFlags
    eDists = ((String, Int) -> String) -> [(String, Int)] -> LFlags
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Int) -> String
    forall a b. (a, b) -> a
    fst ([(String, Int)] -> LFlags)
    -> ([(String, Int)] -> [(String, Int)])
    -> [(String, Int)]
    -> LFlags
    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)] -> LFlags) -> [(String, Int)] -> LFlags
    forall a b. (a -> b) -> a -> b
    $
                       [ (String
    cname', Int
    dist)
                       | (Command String
    cname' String
    _ LFlags -> 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)"

        commands' :: [Command action]
    commands'      = [Command action]
    commands [Command action] -> [Command action] -> [Command action]
    forall a. [a] -> [a] -> [a]
    ++ [CommandUI () -> (() -> LFlags -> action) -> Command action
    forall flags action.
    CommandUI flags -> (flags -> LFlags -> action) -> Command action
    commandAddAction CommandUI ()
    helpCommandUI () -> LFlags -> action
    forall a. HasCallStack => a
    undefined]
        commandNames :: LFlags
    commandNames   = [ String
    name | (Command String
    name String
    _ LFlags -> 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 :: LFlags -> CommandParse flags
    handleHelpCommand LFlags
    cmdArgs =
          case CommandUI () -> Bool -> LFlags -> CommandParse (() -> (), LFlags)
    forall flags.
    CommandUI flags
    -> Bool -> LFlags -> CommandParse (flags -> flags, LFlags)
    commandParseArgs CommandUI ()
    helpCommandUI Bool
    True LFlags
    cmdArgs of
            CommandHelp      String -> String
    help    -> (String -> String) -> CommandParse flags
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
            CommandList      LFlags
    list    -> LFlags -> CommandParse flags
    forall flags. LFlags -> CommandParse flags
    CommandList (LFlags
    list LFlags -> LFlags -> LFlags
    forall a. [a] -> [a] -> [a]
    ++ LFlags
    commandNames)
            CommandErrors    LFlags
    _       -> (String -> String) -> CommandParse flags
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
            CommandReadyToGo (() -> ()
    _,[])  -> (String -> String) -> CommandParse flags
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
            CommandReadyToGo (() -> ()
    _,(String
    name:LFlags
    cmdArgs')) ->
              case String -> [Command action]
    lookupCommand String
    name of
                [Command String
    _ String
    _ LFlags -> CommandParse action
    action CommandType
    _] ->
                  case LFlags -> CommandParse action
    action (String
    "--help"String -> LFlags -> LFlags
    forall a. a -> [a] -> [a]
    :LFlags
    cmdArgs') of
                    CommandHelp String -> String
    help -> (String -> String) -> CommandParse flags
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    help
                    CommandList LFlags
    _    -> LFlags -> CommandParse flags
    forall flags. LFlags -> CommandParse flags
    CommandList []
                    CommandParse action
    _                -> (String -> String) -> CommandParse flags
    forall flags. (String -> String) -> CommandParse flags
    CommandHelp String -> String
    globalHelp
                [Command action]
    _                    -> String -> CommandParse flags
    forall a. String -> CommandParse a
    badCommand String
    name

         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
    iInt -> 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
    jInt -> 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
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1,Int
    jInt -> 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
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1,Int
    jInt -> 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 :: LFlags -> IO ()
    noExtraFlags [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    noExtraFlags LFlags
    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 -> LFlags -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " LFlags
    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 LFlags -> CommandParse action
    _ CommandType
    NormalCommand <- [Command action]
    cmds ]

    helpCommandUI :: CommandUI ()
    helpCommandUI :: CommandUI ()
    helpCommandUI =
      (String
    -> String
    -> LFlags
    -> ()
    -> (ShowOrParseArgs -> [OptionField ()])
    -> CommandUI ()
    forall flags.
    String
    -> String
    -> LFlags
    -> 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