{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Options.Harg.Operations
  ( execOpt,
    execOptDef,
    execOptWithCtx,
    execOptWithCtxDef,
    execCommands,
    execCommandsDef,
    execCommandsWithCtx,
    execCommandsWithCtxDef,
  )
where

import qualified Barbies as B
import Data.Functor.Identity (Identity (..))
import qualified Options.Applicative as Optparse
import Options.Harg.Cmdline (mkOptparseParser)
import Options.Harg.Config (getConfig, mkConfigParser)
import Options.Harg.Het.All (All)
import Options.Harg.Het.HList (AssocListF, MapAssocList (..))
import Options.Harg.Het.Prod ((:*) (..))
import Options.Harg.Het.Variant (VariantF)
import Options.Harg.Pretty (ppSourceRunErrors)
import Options.Harg.Sources
  ( DefaultSources,
    HiddenSources,
    accumSourceResults,
    defaultSources,
    hiddenSources,
  )
import Options.Harg.Sources.Types (GetSource (..), RunSource (..), SourceRunError)
import Options.Harg.Subcommands (Subcommands (..))
import Options.Harg.Types (HargCtx (..), Opt, getCtx)
import Options.Harg.Util (allToDummyOpts, compose, toDummyOpts)

-- | Run the option parser and combine with values from the specified sources,
-- passing the context explicitly.
execOptWithCtx ::
  forall c a.
  ( B.TraversableB a,
    B.ApplicativeB a,
    B.TraversableB c,
    B.ApplicativeB c,
    GetSource c Identity,
    RunSource (SourceVal c) a
  ) =>
  -- | Context containing the environment and the cmdline args
  HargCtx ->
  -- | Source options
  c Opt ->
  -- | Target configuration options
  a Opt ->
  IO (a Identity)
execOptWithCtx :: HargCtx -> c Opt -> a Opt -> IO (a Identity)
execOptWithCtx ctx :: HargCtx
ctx conf :: c Opt
conf opts :: a Opt
opts = do
  let configParser :: Parser ((:*) c DefaultStrSource Identity)
configParser =
        HargCtx
-> (:*) c DefaultStrSource (Compose Opt Identity)
-> Parser ((:*) c DefaultStrSource Identity)
forall (f :: * -> *) (c :: (* -> *) -> *).
(Applicative f, TraversableB c, ApplicativeB c) =>
HargCtx -> c (Compose Opt f) -> Parser (c f)
mkConfigParser HargCtx
ctx ((:*) c DefaultStrSource (Compose Opt Identity)
 -> Parser ((:*) c DefaultStrSource Identity))
-> (:*) c DefaultStrSource (Compose Opt Identity)
-> Parser ((:*) c DefaultStrSource Identity)
forall a b. (a -> b) -> a -> b
$ (forall x. x -> Identity x)
-> (:*) c DefaultStrSource Opt
-> (:*) c DefaultStrSource (Compose Opt Identity)
forall (f :: * -> *) (g :: * -> *) (a :: (* -> *) -> *).
(Functor f, FunctorB a) =>
(forall x. x -> g x) -> a f -> a (Compose f g)
compose forall x. x -> Identity x
Identity (c Opt
conf c Opt -> DefaultStrSource Opt -> (:*) c DefaultStrSource Opt
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
a f -> b f -> (:*) a b f
:* DefaultStrSource Opt
forall (f :: * -> *). HiddenSources f
hiddenSources)
      dummyParser :: Parser (a (Const String))
dummyParser =
        [a (Compose Maybe (Const String))]
-> a (Compose Opt (Const String)) -> Parser (a (Const String))
forall (f :: * -> *) (a :: (* -> *) -> *).
(Applicative f, TraversableB a, ApplicativeB a) =>
[a (Compose Maybe f)] -> a (Compose Opt f) -> Parser (a f)
mkOptparseParser [] (a Opt -> a (Compose Opt (Const String))
forall m (a :: (* -> *) -> *).
(FunctorB a, Monoid m) =>
a Opt -> a (Compose Opt (Const m))
toDummyOpts @String a Opt
opts)
  (:*) c DefaultStrSource Identity
config <- HargCtx
-> Parser ((:*) c DefaultStrSource Identity)
-> Parser (a (Const String))
-> IO ((:*) c DefaultStrSource Identity)
forall (c :: (* -> *) -> *) (f :: * -> *) (a :: (* -> *) -> *)
       (g :: * -> *).
HargCtx -> Parser (c f) -> Parser (a g) -> IO (c f)
getConfig HargCtx
ctx Parser ((:*) c DefaultStrSource Identity)
configParser Parser (a (Const String))
dummyParser
  (SourceVal c, DefaultStrSourceVal)
sourceVals <- HargCtx
-> (:*) c DefaultStrSource Identity
-> IO (SourceVal (c :* DefaultStrSource))
forall (c :: (* -> *) -> *) (f :: * -> *).
GetSource c f =>
HargCtx -> c f -> IO (SourceVal c)
getSource HargCtx
ctx (:*) c DefaultStrSource Identity
config
  let (errs :: [SourceRunError]
errs, sources :: [a (Compose Maybe Identity)]
sources) =
        [Either SourceRunError (a (Compose SourceRunResult Identity))]
-> ([SourceRunError], [a (Compose Maybe Identity)])
forall (a :: (* -> *) -> *) (f :: * -> *).
TraversableB a =>
[Either SourceRunError (a (Compose SourceRunResult f))]
-> ([SourceRunError], [a (Compose Maybe f)])
accumSourceResults ([Either SourceRunError (a (Compose SourceRunResult Identity))]
 -> ([SourceRunError], [a (Compose Maybe Identity)]))
-> [Either SourceRunError (a (Compose SourceRunResult Identity))]
-> ([SourceRunError], [a (Compose Maybe Identity)])
forall a b. (a -> b) -> a -> b
$
          (SourceVal c, DefaultStrSourceVal)
-> a (Compose Opt Identity)
-> [Either SourceRunError (a (Compose SourceRunResult Identity))]
forall s (a :: (* -> *) -> *) (f :: * -> *).
(RunSource s a, Applicative f) =>
s
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource (SourceVal c, DefaultStrSourceVal)
sourceVals ((forall x. x -> Identity x) -> a Opt -> a (Compose Opt Identity)
forall (f :: * -> *) (g :: * -> *) (a :: (* -> *) -> *).
(Functor f, FunctorB a) =>
(forall x. x -> g x) -> a f -> a (Compose f g)
compose forall x. x -> Identity x
Identity a Opt
opts)
      optParser :: Parser (a Identity)
optParser =
        [a (Compose Maybe Identity)]
-> a (Compose Opt Identity) -> Parser (a Identity)
forall (f :: * -> *) (a :: (* -> *) -> *).
(Applicative f, TraversableB a, ApplicativeB a) =>
[a (Compose Maybe f)] -> a (Compose Opt f) -> Parser (a f)
mkOptparseParser [a (Compose Maybe Identity)]
sources ((forall x. x -> Identity x) -> a Opt -> a (Compose Opt Identity)
forall (f :: * -> *) (g :: * -> *) (a :: (* -> *) -> *).
(Functor f, FunctorB a) =>
(forall x. x -> g x) -> a f -> a (Compose f g)
compose forall x. x -> Identity x
Identity a Opt
opts)
      -- parser that includes the configuration options, otherwise parsing
      -- will find more options and fail
      allParser :: Parser (a Identity, (:*) c DefaultStrSource Identity)
allParser =
        (,) (a Identity
 -> (:*) c DefaultStrSource Identity
 -> (a Identity, (:*) c DefaultStrSource Identity))
-> Parser (a Identity)
-> Parser
     ((:*) c DefaultStrSource Identity
      -> (a Identity, (:*) c DefaultStrSource Identity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (a Identity)
optParser Parser
  ((:*) c DefaultStrSource Identity
   -> (a Identity, (:*) c DefaultStrSource Identity))
-> Parser ((:*) c DefaultStrSource Identity)
-> Parser (a Identity, (:*) c DefaultStrSource Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ((:*) c DefaultStrSource Identity)
configParser
  (a Identity, (:*) c DefaultStrSource Identity) -> a Identity
forall a b. (a, b) -> a
fst
    ((a Identity, (:*) c DefaultStrSource Identity) -> a Identity)
-> IO (a Identity, (:*) c DefaultStrSource Identity)
-> IO (a Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if [SourceRunError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SourceRunError]
errs
      then HargCtx
-> Parser (a Identity, (:*) c DefaultStrSource Identity)
-> IO (a Identity, (:*) c DefaultStrSource Identity)
forall a. HargCtx -> Parser a -> IO a
execParser HargCtx
ctx Parser (a Identity, (:*) c DefaultStrSource Identity)
allParser
      else Parser (a Identity, (:*) c DefaultStrSource Identity)
-> [SourceRunError]
-> IO (a Identity, (:*) c DefaultStrSource Identity)
forall a. Parser a -> [SourceRunError] -> IO a
failParser Parser (a Identity, (:*) c DefaultStrSource Identity)
allParser [SourceRunError]
errs

-- | Run the option parser and combine with values from the specified sources
execOpt ::
  forall c a.
  ( B.TraversableB a,
    B.ApplicativeB a,
    B.TraversableB c,
    B.ApplicativeB c,
    GetSource c Identity,
    RunSource (SourceVal c) a
  ) =>
  -- | Source options
  c Opt ->
  -- | Target configuration options
  a Opt ->
  IO (a Identity)
execOpt :: c Opt -> a Opt -> IO (a Identity)
execOpt conf :: c Opt
conf opts :: a Opt
opts = do
  HargCtx
ctx <- IO HargCtx
getCtx
  HargCtx -> c Opt -> a Opt -> IO (a Identity)
forall (c :: (* -> *) -> *) (a :: (* -> *) -> *).
(TraversableB a, ApplicativeB a, TraversableB c, ApplicativeB c,
 GetSource c Identity, RunSource (SourceVal c) a) =>
HargCtx -> c Opt -> a Opt -> IO (a Identity)
execOptWithCtx HargCtx
ctx c Opt
conf a Opt
opts

-- | Run the option parser only with default sources (environment variables),
-- passing the context explicitly.
execOptWithCtxDef ::
  forall a.
  ( B.TraversableB a,
    B.ApplicativeB a
  ) =>
  -- | Context containing the environment and the cmdline args
  HargCtx ->
  -- | Target configuration options
  a Opt ->
  IO (a Identity)
execOptWithCtxDef :: HargCtx -> a Opt -> IO (a Identity)
execOptWithCtxDef ctx :: HargCtx
ctx =
  HargCtx -> EnvSource Opt -> a Opt -> IO (a Identity)
forall (c :: (* -> *) -> *) (a :: (* -> *) -> *).
(TraversableB a, ApplicativeB a, TraversableB c, ApplicativeB c,
 GetSource c Identity, RunSource (SourceVal c) a) =>
HargCtx -> c Opt -> a Opt -> IO (a Identity)
execOptWithCtx HargCtx
ctx EnvSource Opt
forall (f :: * -> *). DefaultSources f
defaultSources

-- | Run the option parser only with default sources (environment variables)
execOptDef ::
  forall a.
  ( B.TraversableB a,
    B.ApplicativeB a
  ) =>
  -- | Target configuration options
  a Opt ->
  IO (a Identity)
execOptDef :: a Opt -> IO (a Identity)
execOptDef =
  EnvSource Opt -> a Opt -> IO (a Identity)
forall (c :: (* -> *) -> *) (a :: (* -> *) -> *).
(TraversableB a, ApplicativeB a, TraversableB c, ApplicativeB c,
 GetSource c Identity, RunSource (SourceVal c) a) =>
c Opt -> a Opt -> IO (a Identity)
execOpt EnvSource Opt
forall (f :: * -> *). DefaultSources f
defaultSources

-- | Run the subcommand parser and combine with values from the specified
-- sources, passing the context explicitly.
execCommandsWithCtx ::
  forall c ts xs.
  ( B.TraversableB (VariantF xs),
    B.TraversableB c,
    B.ApplicativeB c,
    Subcommands ts xs,
    GetSource c Identity,
    All (RunSource (SourceVal (c :* HiddenSources))) xs,
    All (RunSource ()) xs,
    MapAssocList xs
  ) =>
  -- | Context containing the environment and the cmdline args
  HargCtx ->
  -- | Source options
  c Opt ->
  -- | Target options associated with subcommands
  AssocListF ts xs Opt ->
  IO (VariantF xs Identity)
execCommandsWithCtx :: HargCtx
-> c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommandsWithCtx ctx :: HargCtx
ctx conf :: c Opt
conf opts :: AssocListF ts xs Opt
opts = do
  let configParser :: Parser ((:*) c DefaultStrSource Identity)
configParser =
        HargCtx
-> (:*) c DefaultStrSource (Compose Opt Identity)
-> Parser ((:*) c DefaultStrSource Identity)
forall (f :: * -> *) (c :: (* -> *) -> *).
(Applicative f, TraversableB c, ApplicativeB c) =>
HargCtx -> c (Compose Opt f) -> Parser (c f)
mkConfigParser HargCtx
ctx ((:*) c DefaultStrSource (Compose Opt Identity)
 -> Parser ((:*) c DefaultStrSource Identity))
-> (:*) c DefaultStrSource (Compose Opt Identity)
-> Parser ((:*) c DefaultStrSource Identity)
forall a b. (a -> b) -> a -> b
$ (forall x. x -> Identity x)
-> (:*) c DefaultStrSource Opt
-> (:*) c DefaultStrSource (Compose Opt Identity)
forall (f :: * -> *) (g :: * -> *) (a :: (* -> *) -> *).
(Functor f, FunctorB a) =>
(forall x. x -> g x) -> a f -> a (Compose f g)
compose forall x. x -> Identity x
Identity (c Opt
conf c Opt -> DefaultStrSource Opt -> (:*) c DefaultStrSource Opt
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
a f -> b f -> (:*) a b f
:* DefaultStrSource Opt
forall (f :: * -> *). HiddenSources f
hiddenSources)
      (_, dummyCommands :: [Mod CommandFields (VariantF xs (Const String))]
dummyCommands) =
        ()
-> AssocListF ts xs (Compose Opt (Const String))
-> ([SourceRunError],
    [Mod CommandFields (VariantF xs (Const String))])
forall (ts :: [Symbol]) (xs :: [(* -> *) -> *]) s (f :: * -> *).
(Subcommands ts xs, All (RunSource s) xs, Applicative f) =>
s
-> AssocListF ts xs (Compose Opt f)
-> ([SourceRunError], [Mod CommandFields (VariantF xs f)])
mapSubcommand () (AssocListF ts xs Opt
-> AssocListF ts xs (Compose Opt (Const String))
forall m (ts :: [Symbol]) (xs :: [(* -> *) -> *]).
(Monoid m, MapAssocList xs) =>
AssocListF ts xs Opt -> AssocListF ts xs (Compose Opt (Const m))
allToDummyOpts @String AssocListF ts xs Opt
opts)
      dummyParser :: Parser (VariantF xs (Const String))
dummyParser =
        Mod CommandFields (VariantF xs (Const String))
-> Parser (VariantF xs (Const String))
forall a. Mod CommandFields a -> Parser a
Optparse.subparser ([Mod CommandFields (VariantF xs (Const String))]
-> Mod CommandFields (VariantF xs (Const String))
forall a. Monoid a => [a] -> a
mconcat [Mod CommandFields (VariantF xs (Const String))]
dummyCommands)

  (:*) c DefaultStrSource Identity
config <- HargCtx
-> Parser ((:*) c DefaultStrSource Identity)
-> Parser (VariantF xs (Const String))
-> IO ((:*) c DefaultStrSource Identity)
forall (c :: (* -> *) -> *) (f :: * -> *) (a :: (* -> *) -> *)
       (g :: * -> *).
HargCtx -> Parser (c f) -> Parser (a g) -> IO (c f)
getConfig HargCtx
ctx Parser ((:*) c DefaultStrSource Identity)
configParser Parser (VariantF xs (Const String))
dummyParser
  (SourceVal c, DefaultStrSourceVal)
sourceVals <- HargCtx
-> (:*) c DefaultStrSource Identity
-> IO (SourceVal (c :* DefaultStrSource))
forall (c :: (* -> *) -> *) (f :: * -> *).
GetSource c f =>
HargCtx -> c f -> IO (SourceVal c)
getSource HargCtx
ctx (:*) c DefaultStrSource Identity
config

  let (errs :: [SourceRunError]
errs, commands :: [Mod CommandFields (VariantF xs Identity)]
commands) =
        (SourceVal c, DefaultStrSourceVal)
-> AssocListF ts xs (Compose Opt Identity)
-> ([SourceRunError], [Mod CommandFields (VariantF xs Identity)])
forall (ts :: [Symbol]) (xs :: [(* -> *) -> *]) s (f :: * -> *).
(Subcommands ts xs, All (RunSource s) xs, Applicative f) =>
s
-> AssocListF ts xs (Compose Opt f)
-> ([SourceRunError], [Mod CommandFields (VariantF xs f)])
mapSubcommand (SourceVal c, DefaultStrSourceVal)
sourceVals ((forall (a :: (* -> *) -> *).
 FunctorB a =>
 a Opt -> a (Compose Opt Identity))
-> AssocListF ts xs Opt -> AssocListF ts xs (Compose Opt Identity)
forall (as :: [(* -> *) -> *]) (f :: * -> *) (g :: * -> *)
       (ts :: [Symbol]).
MapAssocList as =>
(forall (a :: (* -> *) -> *). FunctorB a => a f -> a g)
-> AssocListF ts as f -> AssocListF ts as g
mapAssocList ((forall x. x -> Identity x) -> a Opt -> a (Compose Opt Identity)
forall (f :: * -> *) (g :: * -> *) (a :: (* -> *) -> *).
(Functor f, FunctorB a) =>
(forall x. x -> g x) -> a f -> a (Compose f g)
compose forall x. x -> Identity x
Identity) AssocListF ts xs Opt
opts)
      optParser :: Parser (VariantF xs Identity)
optParser =
        Mod CommandFields (VariantF xs Identity)
-> Parser (VariantF xs Identity)
forall a. Mod CommandFields a -> Parser a
Optparse.subparser ([Mod CommandFields (VariantF xs Identity)]
-> Mod CommandFields (VariantF xs Identity)
forall a. Monoid a => [a] -> a
mconcat [Mod CommandFields (VariantF xs Identity)]
commands)
      -- parser that includes the configuration options, otherwise parsing
      -- will find more options and fail
      allParser :: Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
allParser =
        (,) (VariantF xs Identity
 -> (:*) c DefaultStrSource Identity
 -> (VariantF xs Identity, (:*) c DefaultStrSource Identity))
-> Parser (VariantF xs Identity)
-> Parser
     ((:*) c DefaultStrSource Identity
      -> (VariantF xs Identity, (:*) c DefaultStrSource Identity))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VariantF xs Identity)
optParser Parser
  ((:*) c DefaultStrSource Identity
   -> (VariantF xs Identity, (:*) c DefaultStrSource Identity))
-> Parser ((:*) c DefaultStrSource Identity)
-> Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ((:*) c DefaultStrSource Identity)
configParser
  (VariantF xs Identity, (:*) c DefaultStrSource Identity)
-> VariantF xs Identity
forall a b. (a, b) -> a
fst
    ((VariantF xs Identity, (:*) c DefaultStrSource Identity)
 -> VariantF xs Identity)
-> IO (VariantF xs Identity, (:*) c DefaultStrSource Identity)
-> IO (VariantF xs Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if [SourceRunError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SourceRunError]
errs
      then HargCtx
-> Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
-> IO (VariantF xs Identity, (:*) c DefaultStrSource Identity)
forall a. HargCtx -> Parser a -> IO a
execParser HargCtx
ctx Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
allParser
      else Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
-> [SourceRunError]
-> IO (VariantF xs Identity, (:*) c DefaultStrSource Identity)
forall a. Parser a -> [SourceRunError] -> IO a
failParser Parser (VariantF xs Identity, (:*) c DefaultStrSource Identity)
allParser [SourceRunError]
errs

-- | Run the subcommand parser and combine with values from the specified
-- sources
execCommands ::
  forall c ts xs.
  ( B.TraversableB (VariantF xs),
    B.TraversableB c,
    B.ApplicativeB c,
    Subcommands ts xs,
    GetSource c Identity,
    All (RunSource (SourceVal (c :* HiddenSources))) xs,
    All (RunSource ()) xs,
    MapAssocList xs
  ) =>
  -- | Source options
  c Opt ->
  -- | Target options associated with subcommands
  AssocListF ts xs Opt ->
  IO (VariantF xs Identity)
execCommands :: c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommands conf :: c Opt
conf opts :: AssocListF ts xs Opt
opts = do
  HargCtx
ctx <- IO HargCtx
getCtx
  HargCtx
-> c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
forall (c :: (* -> *) -> *) (ts :: [Symbol])
       (xs :: [(* -> *) -> *]).
(TraversableB (VariantF xs), TraversableB c, ApplicativeB c,
 Subcommands ts xs, GetSource c Identity,
 All (RunSource (SourceVal (c :* DefaultStrSource))) xs,
 All (RunSource ()) xs, MapAssocList xs) =>
HargCtx
-> c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommandsWithCtx HargCtx
ctx c Opt
conf AssocListF ts xs Opt
opts

-- | Run the subcommand parser only with default sources (environment
-- variables), passing the context explicitly.
execCommandsWithCtxDef ::
  forall ts xs.
  ( B.TraversableB (VariantF xs),
    Subcommands ts xs,
    All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs,
    All (RunSource ()) xs,
    MapAssocList xs
  ) =>
  -- | Context containing the environment and the cmdline args
  HargCtx ->
  -- | Target options associated with subcommands
  AssocListF ts xs Opt ->
  IO (VariantF xs Identity)
execCommandsWithCtxDef :: HargCtx -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommandsWithCtxDef ctx :: HargCtx
ctx =
  HargCtx
-> EnvSource Opt
-> AssocListF ts xs Opt
-> IO (VariantF xs Identity)
forall (c :: (* -> *) -> *) (ts :: [Symbol])
       (xs :: [(* -> *) -> *]).
(TraversableB (VariantF xs), TraversableB c, ApplicativeB c,
 Subcommands ts xs, GetSource c Identity,
 All (RunSource (SourceVal (c :* DefaultStrSource))) xs,
 All (RunSource ()) xs, MapAssocList xs) =>
HargCtx
-> c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommandsWithCtx HargCtx
ctx EnvSource Opt
forall (f :: * -> *). DefaultSources f
defaultSources

-- | Run the subcommand parser only with default sources (environment
-- variables)
execCommandsDef ::
  forall ts xs.
  ( B.TraversableB (VariantF xs),
    Subcommands ts xs,
    All (RunSource (SourceVal (DefaultSources :* HiddenSources))) xs,
    All (RunSource ()) xs,
    MapAssocList xs
  ) =>
  -- | Target options associated with subcommands
  AssocListF ts xs Opt ->
  IO (VariantF xs Identity)
execCommandsDef :: AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommandsDef =
  EnvSource Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
forall (c :: (* -> *) -> *) (ts :: [Symbol])
       (xs :: [(* -> *) -> *]).
(TraversableB (VariantF xs), TraversableB c, ApplicativeB c,
 Subcommands ts xs, GetSource c Identity,
 All (RunSource (SourceVal (c :* DefaultStrSource))) xs,
 All (RunSource ()) xs, MapAssocList xs) =>
c Opt -> AssocListF ts xs Opt -> IO (VariantF xs Identity)
execCommands EnvSource Opt
forall (f :: * -> *). DefaultSources f
defaultSources

-- | Run the optparse-applicative parser, printing accumulated errors. Errors
-- are printed as warnings if the parser succeeds.
execParser ::
  HargCtx ->
  Optparse.Parser a ->
  IO a
execParser :: HargCtx -> Parser a -> IO a
execParser HargCtx {..} parser :: Parser a
parser =
  ParserResult a -> IO a
forall a. ParserResult a -> IO a
Optparse.handleParseResult (Args -> Parser a -> ParserResult a
forall a. Args -> Parser a -> ParserResult a
execParserPure Args
_hcArgs Parser a
parser)

failParser ::
  Optparse.Parser a ->
  [SourceRunError] ->
  IO a
failParser :: Parser a -> [SourceRunError] -> IO a
failParser parser :: Parser a
parser errs :: [SourceRunError]
errs =
  ParserResult a -> IO a
forall a. ParserResult a -> IO a
Optparse.handleParseResult (ParserFailure ParserHelp -> ParserResult a
forall a. ParserFailure ParserHelp -> ParserResult a
Optparse.Failure ParserFailure ParserHelp
failure)
  where
    failure :: ParserFailure ParserHelp
failure =
      ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
Optparse.parserFailure
        ParserPrefs
Optparse.defaultPrefs
        ParserInfo a
parserInfo
        (String -> ParseError
Optparse.ErrorMsg String
errStr)
        []
    parserInfo :: ParserInfo a
parserInfo =
      Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Optparse.info (Parser (a -> a)
forall a. Parser (a -> a)
Optparse.helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) InfoMod a
forall a. InfoMod a
Optparse.forwardOptions
    errStr :: String
errStr =
      [SourceRunError] -> String
ppSourceRunErrors [SourceRunError]
errs

-- | Run the optparse-applicative parser and return the
-- 'Optparse.ParserResult'
execParserPure ::
  [String] ->
  Optparse.Parser a ->
  Optparse.ParserResult a
execParserPure :: Args -> Parser a -> ParserResult a
execParserPure args :: Args
args parser :: Parser a
parser =
  ParserPrefs -> ParserInfo a -> Args -> ParserResult a
forall a. ParserPrefs -> ParserInfo a -> Args -> ParserResult a
Optparse.execParserPure ParserPrefs
Optparse.defaultPrefs ParserInfo a
parserInfo Args
args
  where
    parserInfo :: ParserInfo a
parserInfo =
      Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Optparse.info (Parser (a -> a)
forall a. Parser (a -> a)
Optparse.helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) InfoMod a
forall a. InfoMod a
Optparse.forwardOptions