module Stackctl.Subcommand
  ( Subcommand (..)
  , subcommand
  , runSubcommand
  , runSubcommand'
  , runAppSubcommand
  ) where

import Stackctl.Prelude

import qualified Env
import Options.Applicative
import Stackctl.AWS (handlingServiceError)
import Stackctl.AutoSSO
import Stackctl.CLI
import Stackctl.ColorOption
import Stackctl.Options
import Stackctl.VerboseOption

data Subcommand options subOptions = Subcommand
  { forall options subOptions. Subcommand options subOptions -> Text
name :: Text
  , forall options subOptions. Subcommand options subOptions -> Text
description :: Text
  , forall options subOptions.
Subcommand options subOptions -> Parser subOptions
parse :: Parser subOptions
  , forall options subOptions.
Subcommand options subOptions -> subOptions -> options -> IO ()
run :: subOptions -> options -> IO ()
  }

subcommand
  :: Subcommand options subOptions -> Mod CommandFields (options -> IO ())
subcommand :: forall options subOptions.
Subcommand options subOptions
-> Mod CommandFields (options -> IO ())
subcommand Subcommand {Text
Parser subOptions
subOptions -> options -> IO ()
run :: subOptions -> options -> IO ()
parse :: Parser subOptions
description :: Text
name :: Text
run :: forall options subOptions.
Subcommand options subOptions -> subOptions -> options -> IO ()
parse :: forall options subOptions.
Subcommand options subOptions -> Parser subOptions
description :: forall options subOptions. Subcommand options subOptions -> Text
name :: forall options subOptions. Subcommand options subOptions -> Text
..} =
  forall a. String -> ParserInfo a -> Mod CommandFields a
command (Text -> String
unpack Text
name) (subOptions -> options -> IO ()
run forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> ParserInfo a
withInfo Text
description Parser subOptions
parse)

runSubcommand :: Mod CommandFields (Options -> IO a) -> IO a
runSubcommand :: forall a. Mod CommandFields (Options -> IO a) -> IO a
runSubcommand =
  forall options a.
Semigroup options =>
Text
-> Parser Error options
-> Parser options
-> Mod CommandFields (options -> IO a)
-> IO a
runSubcommand' Text
"Work with Stack specifications" Parser Error Options
envParser Parser Options
optionsParser

-- brittany-disable-next-binding

runSubcommand'
  :: Semigroup options
  => Text
  -> Env.Parser Env.Error options
  -> Parser options
  -> Mod CommandFields (options -> IO a)
  -> IO a
runSubcommand' :: forall options a.
Semigroup options =>
Text
-> Parser Error options
-> Parser options
-> Mod CommandFields (options -> IO a)
-> IO a
runSubcommand' Text
title Parser Error options
parseEnv Parser options
parseCLI Mod CommandFields (options -> IO a)
sp = do
  (options
options, options -> IO a
act) <-
    forall {p :: * -> * -> *} {b} {c}.
(Bifunctor p, Semigroup b) =>
b -> p b c -> p b c
applyEnv
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
AsUnset e =>
(Info Error -> Info e) -> Parser e a -> IO a
Env.parse (forall e. String -> Info e -> Info e
Env.header forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
title) Parser Error options
parseEnv
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ParserInfo a -> IO a
execParser (forall a. Text -> Parser a -> ParserInfo a
withInfo Text
title forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser options
parseCLI forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Mod CommandFields a -> Parser a
subparser Mod CommandFields (options -> IO a)
sp)

  options -> IO a
act options
options
 where
  applyEnv :: b -> p b c -> p b c
applyEnv b
env = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (b
env forall a. Semigroup a => a -> a -> a
<>)

-- | Use this in the 'run' member of a 'Subcommand' that wants 'AppT'
--
-- @
--   -- ...
--   , parse = parseFooOptions
--   , run = 'runAppSubcommand' runFoo
--   }
--
-- runFoo :: (MonadReader env m, HasAws env) => FooOptions -> m ()
-- runFoo = undefined
-- @
runAppSubcommand
  :: ( HasColorOption options
     , HasVerboseOption options
     , HasAutoSSOOption options
     )
  => (subOptions -> AppT (App options) IO a)
  -> subOptions
  -> options
  -> IO a
runAppSubcommand :: forall options subOptions a.
(HasColorOption options, HasVerboseOption options,
 HasAutoSSOOption options) =>
(subOptions -> AppT (App options) IO a)
-> subOptions -> options -> IO a
runAppSubcommand subOptions -> AppT (App options) IO a
f subOptions
subOptions options
options =
  forall (m :: * -> *) options a.
(MonadMask m, MonadUnliftIO m, HasColorOption options,
 HasVerboseOption options, HasAutoSSOOption options) =>
options -> AppT (App options) m a -> m a
runAppT options
options
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
m a -> m a
handlingServiceError
    forall a b. (a -> b) -> a -> b
$ subOptions -> AppT (App options) IO a
f subOptions
subOptions

withInfo :: Text -> Parser a -> ParserInfo a
withInfo :: forall a. Text -> Parser a -> ParserInfo a
withInfo Text
d Parser a
p = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall a b. (a -> b) -> a -> b
$ forall a. String -> InfoMod a
progDesc (Text -> String
unpack Text
d) forall a. Semigroup a => a -> a -> a
<> forall a. InfoMod a
fullDesc