    -- Try to ensure that https://github.com/fpco/optparse-simple/issues/12 doesn't recur.
    {-# LANGUAGE OverloadedStrings #-}

    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE CPP #-}

    -- | Simple interface to program arguments.
    --
    -- Typical usage with no commands:
    --
    -- @
    -- do (opts,()) <-
    --      simpleOptions "ver"
    --                    "header"
    --                    "desc"
    --                    (flag () () (long "some-flag"))
    --                    empty
    --    doThings opts
    -- @
    --
    -- Typical usage with commands:
    --
    -- @
    -- do (opts,runCmd) <-
    --      simpleOptions "ver"
    --                    "header"
    --                    "desc"
    --                    (pure ()) $
    --      do addCommand "delete"
    --                    "Delete the thing"
    --                    (const deleteTheThing)
    --                    (pure ())
    --         addCommand "create"
    --                    "Create a thing"
    --                    createAThing
    --                    (strOption (long "hello"))
    --    runCmd
    -- @

    module Options.Applicative.Simple
      ( module Options.Applicative.Simple
      , module Options.Applicative
      ) where

    import           Control.Monad.Trans.Class (lift)
    import           Control.Monad.Trans.Except
    import           Control.Monad.Trans.Writer
    #if !MIN_VERSION_base(4,11,0)
    import           Data.Semigroup
    #endif
    import           Data.Version
    import           GitHash (GitInfo, giDirty, giHash, tGitInfoCwdTry)
    import           Language.Haskell.TH (Q,Exp)
    import qualified Language.Haskell.TH.Syntax as TH
    import           Language.Haskell.TH.Syntax.Compat
    import           Options.Applicative
    import           System.Environment

    -- | Generate and execute a simple options parser.
    simpleOptions
      :: String
      -- ^ version string
      -> String
      -- ^ header
      -> String
      -- ^ program description
      -> Parser a
      -- ^ global settings
      -> ExceptT b (Writer (Mod CommandFields b)) ()
      -- ^ commands (use 'addCommand')
      -> IO (a,b)
    simpleOptions :: forall a b.
    String
    -> String
    -> String
    -> Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    -> IO (a, b)
    simpleOptions String
    versionString String
    h String
    pd Parser a
    globalParser ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser =
      do args <- IO [String]
    getArgs
         case execParserPure (prefs idm) parser args of
           Failure ParserFailure ParserHelp
    _ | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args -> [String] -> IO (a, b) -> IO (a, b)
    forall a. [String] -> IO a -> IO a
    withArgs [String
    "--help"] (ParserInfo (a, b) -> IO (a, b)
    forall a. ParserInfo a -> IO a
    execParser ParserInfo (a, b)
    parser)
           ParserResult (a, b)
    parseResult -> ParserResult (a, b) -> IO (a, b)
    forall a. ParserResult a -> IO a
    handleParseResult ParserResult (a, b)
    parseResult
      where parser :: ParserInfo (a, b)
    parser = Parser (a, b) -> InfoMod (a, b) -> ParserInfo (a, b)
    forall a. Parser a -> InfoMod a -> ParserInfo a
    info (Parser ((a, b) -> (a, b))
    forall {a}. Parser (a -> a)
    versionOption Parser ((a, b) -> (a, b)) -> Parser (a, b) -> Parser (a, b)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) () -> Parser (a, b)
    forall a b.
    Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) () -> Parser (a, b)
    simpleParser Parser a
    globalParser ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser) InfoMod (a, b)
    forall {a}. InfoMod a
    desc
            desc :: InfoMod a
    desc = InfoMod a
    forall {a}. InfoMod a
    fullDesc InfoMod a -> InfoMod a -> InfoMod a
    forall a. Semigroup a => a -> a -> a
    <> String -> InfoMod a
    forall a. String -> InfoMod a
    header String
    h InfoMod a -> InfoMod a -> InfoMod a
    forall a. Semigroup a => a -> a -> a
    <> String -> InfoMod a
    forall a. String -> InfoMod a
    progDesc String
    pd
            versionOption :: Parser (a -> a)
    versionOption =
              String -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
    infoOption
                String
    versionString
                (String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "version" Mod OptionFields (a -> a)
    -> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
    forall a. Semigroup a => a -> a -> a
    <>
                 String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Show version")

    -- | Generate a string like @Version 1.2, Git revision 1234@.
    --
    -- @$(simpleVersion …)@ @::@ 'String'
    simpleVersion :: Version -> Q Exp
    simpleVersion :: Version -> Q Exp
    simpleVersion Version
    version =
      [|concat (["Version "
               ,$(String -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    TH.lift (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Version -> String
    showVersion Version
    version)
               ] ++
               case $(Splice Q (Either String GitInfo) -> Q Exp
    forall a (m :: * -> *). Quote m => Splice m a -> m Exp
    unTypeSplice Splice Q (Either String GitInfo)
    tGitInfoCwdTry) :: Either String GitInfo of
                 Left _ -> []
                 Right gi -> [ ", Git revision "
                             , giHash gi
                             , if giDirty gi then " (dirty)" else ""
                             ]
               )|]

    -- | Add a command to the options dispatcher.
    addCommand :: String   -- ^ command string
               -> String   -- ^ title of command
               -> (a -> b) -- ^ constructor to wrap up command in common data type
               -> Parser a -- ^ command parser
               -> ExceptT b (Writer (Mod CommandFields b)) ()
    addCommand :: forall a b.
    String
    -> String
    -> (a -> b)
    -> Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    addCommand String
    cmd String
    title a -> b
    constr Parser a
    inner =
      Writer (Mod CommandFields b) ()
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT b m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Mod CommandFields b -> Writer (Mod CommandFields b) ()
    forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell (String -> ParserInfo b -> Mod CommandFields b
    forall a. String -> ParserInfo a -> Mod CommandFields a
    command String
    cmd
                          (Parser b -> InfoMod b -> ParserInfo b
    forall a. Parser a -> InfoMod a -> ParserInfo a
    info (a -> b
    constr (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser (a -> a)
    forall {a}. Parser (a -> a)
    helper Parser (a -> a) -> Parser a -> Parser a
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser a
    inner))
                                (String -> InfoMod b
    forall a. String -> InfoMod a
    progDesc String
    title))))

    -- | Add a command that takes sub-commands to the options dispatcher.
    --
    -- Example:
    --
    -- @
    -- addSubCommands "thing"
    --                "Subcommands that operate on things"
    --                (do addCommand "delete"
    --                               "Delete the thing"
    --                               (const deleteTheThing)
    --                               (pure ())
    --                    addCommand "create"
    --                               "Create a thing"
    --                               createAThing
    --                               (strOption (long "hello")))
    -- @
    --
    -- If there are common options between all the sub-commands, use 'addCommand'
    -- in combination with 'simpleParser' instead of 'addSubCommands'.
    addSubCommands
      :: String
      -- ^ command string
      -> String
      -- ^ title of command
      -> ExceptT b (Writer (Mod CommandFields b)) ()
      -- ^ sub-commands (use 'addCommand')
      -> ExceptT b (Writer (Mod CommandFields b)) ()
    addSubCommands :: forall b.
    String
    -> String
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    addSubCommands String
    cmd String
    title ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser =
      String
    -> String
    -> (((), b) -> b)
    -> Parser ((), b)
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    forall a b.
    String
    -> String
    -> (a -> b)
    -> Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) ()
    addCommand String
    cmd
                 String
    title
                 (\((), b
    a) -> b
    a)
                 (Parser ()
    -> ExceptT b (Writer (Mod CommandFields b)) () -> Parser ((), b)
    forall a b.
    Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) () -> Parser (a, b)
    simpleParser (() -> Parser ()
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser)

    -- | Generate a simple options parser.
    --
    -- Most of the time you should use 'simpleOptions' instead, but 'simpleParser'
    -- can be used for sub-commands that need common options.  For example:
    --
    -- @
    -- addCommand "thing"
    --            "Subcommands that operate on things"
    --            (\\(opts,runSubCmd) -> runSubCmd opts)
    --            (simpleParser (flag () () (long "some-flag")) $
    --             do addCommand "delete"
    --                           "Delete the thing"
    --                           (const deleteTheThing)
    --                           (pure ())
    --                addCommand "create"
    --                           "Create a thing"
    --                           createAThing
    --                           (strOption (long "hello")))
    -- @
    --
    simpleParser
      :: Parser a
      -- ^ common settings
      -> ExceptT b (Writer (Mod CommandFields b)) ()
      -- ^ commands (use 'addCommand')
      -> Parser (a,b)
    simpleParser :: forall a b.
    Parser a
    -> ExceptT b (Writer (Mod CommandFields b)) () -> Parser (a, b)
    simpleParser Parser a
    commonParser ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser =
      Parser ((a, b) -> (a, b))
    forall {a}. Parser (a -> a)
    helpOption Parser ((a, b) -> (a, b)) -> Parser (a, b) -> Parser (a, b)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (a, b)
    config
      where helpOption :: Parser (a -> a)
    helpOption =
    #if MIN_VERSION_optparse_applicative(0,16,0)
              ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a.
    ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    abortOption (Maybe String -> ParseError
    ShowHelpText Maybe String
    forall a. Maybe a
    Nothing) (Mod OptionFields (a -> a) -> Parser (a -> a))
    -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a b. (a -> b) -> a -> b
    $
    #else
              abortOption ShowHelpText $
    #endif
              String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => String -> Mod f a
    long String
    "help" Mod OptionFields (a -> a)
    -> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
    forall a. Semigroup a => a -> a -> a
    <>
              String -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. String -> Mod f a
    help String
    "Show this help text"
            config :: Parser (a, b)
    config =
              (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser a
    commonParser Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
              case Writer (Mod CommandFields b) (Either b ())
    -> (Either b (), Mod CommandFields b)
    forall w a. Writer w a -> (a, w)
    runWriter (ExceptT b (Writer (Mod CommandFields b)) ()
    -> Writer (Mod CommandFields b) (Either b ())
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT ExceptT b (Writer (Mod CommandFields b)) ()
    commandParser) of
                (Right (),Mod CommandFields b
    d) -> Mod CommandFields b -> Parser b
    forall a. Mod CommandFields a -> Parser a
    subparser Mod CommandFields b
    d
                (Left b
    b,Mod CommandFields b
    _) -> b -> Parser b
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure b
    b