{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
module Iris.Env (
CliEnv (..),
mkCliEnv,
asksCliEnv,
asksAppEnv,
) where
import Control.Monad.Reader (MonadReader, asks)
import Data.Kind (Type)
import System.IO (stderr, stdout)
import Iris.Cli.Interactive (InteractiveMode, handleInteractiveMode)
import Iris.Cli.Internal (Cmd (..))
import Iris.Cli.ParserInfo (cmdParserInfo)
import Iris.Colour.Mode (ColourMode, detectColourMode)
import Iris.Settings (CliEnvSettings (..))
import qualified Options.Applicative as Opt
data CliEnv (cmd :: Type) (appEnv :: Type) = CliEnv
{ forall cmd appEnv. CliEnv cmd appEnv -> cmd
cliEnvCmd :: cmd
, forall cmd appEnv. CliEnv cmd appEnv -> ColourMode
cliEnvStdoutColourMode :: ColourMode
, forall cmd appEnv. CliEnv cmd appEnv -> ColourMode
cliEnvStderrColourMode :: ColourMode
, forall cmd appEnv. CliEnv cmd appEnv -> appEnv
cliEnvAppEnv :: appEnv
, forall cmd appEnv. CliEnv cmd appEnv -> InteractiveMode
cliEnvInteractiveMode :: InteractiveMode
}
mkCliEnv
:: forall cmd appEnv
. CliEnvSettings cmd appEnv
-> IO (CliEnv cmd appEnv)
mkCliEnv :: forall cmd appEnv.
CliEnvSettings cmd appEnv -> IO (CliEnv cmd appEnv)
mkCliEnv cliEnvSettings :: CliEnvSettings cmd appEnv
cliEnvSettings@CliEnvSettings{appEnv
String
Maybe String
Maybe VersionSettings
Parser cmd
cliEnvSettingsAppName :: forall cmd appEnv. CliEnvSettings cmd appEnv -> Maybe String
cliEnvSettingsVersionSettings :: forall cmd appEnv.
CliEnvSettings cmd appEnv -> Maybe VersionSettings
cliEnvSettingsProgDesc :: forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsHeaderDesc :: forall cmd appEnv. CliEnvSettings cmd appEnv -> String
cliEnvSettingsAppEnv :: forall cmd appEnv. CliEnvSettings cmd appEnv -> appEnv
cliEnvSettingsCmdParser :: forall cmd appEnv. CliEnvSettings cmd appEnv -> Parser cmd
cliEnvSettingsAppName :: Maybe String
cliEnvSettingsVersionSettings :: Maybe VersionSettings
cliEnvSettingsProgDesc :: String
cliEnvSettingsHeaderDesc :: String
cliEnvSettingsAppEnv :: appEnv
cliEnvSettingsCmdParser :: Parser cmd
..} = do
Cmd{cmd
ColourOption
InteractiveMode
cmdCmd :: forall cmd. Cmd cmd -> cmd
cmdColourOption :: forall cmd. Cmd cmd -> ColourOption
cmdInteractiveMode :: forall cmd. Cmd cmd -> InteractiveMode
cmdCmd :: cmd
cmdColourOption :: ColourOption
cmdInteractiveMode :: InteractiveMode
..} <- forall a. ParserInfo a -> IO a
Opt.execParser forall a b. (a -> b) -> a -> b
$ forall cmd appEnv.
CliEnvSettings cmd appEnv -> ParserInfo (Cmd cmd)
cmdParserInfo CliEnvSettings cmd appEnv
cliEnvSettings
ColourMode
stdoutColourMode <- Handle -> ColourOption -> Maybe String -> IO ColourMode
detectColourMode Handle
stdout ColourOption
cmdColourOption Maybe String
cliEnvSettingsAppName
ColourMode
stderrColourMode <- Handle -> ColourOption -> Maybe String -> IO ColourMode
detectColourMode Handle
stderr ColourOption
cmdColourOption Maybe String
cliEnvSettingsAppName
InteractiveMode
interactive <- InteractiveMode -> IO InteractiveMode
handleInteractiveMode InteractiveMode
cmdInteractiveMode
pure
CliEnv
{ cliEnvCmd :: cmd
cliEnvCmd = cmd
cmdCmd
, cliEnvStdoutColourMode :: ColourMode
cliEnvStdoutColourMode = ColourMode
stdoutColourMode
, cliEnvStderrColourMode :: ColourMode
cliEnvStderrColourMode = ColourMode
stderrColourMode
, cliEnvAppEnv :: appEnv
cliEnvAppEnv = appEnv
cliEnvSettingsAppEnv
, cliEnvInteractiveMode :: InteractiveMode
cliEnvInteractiveMode = InteractiveMode
interactive
}
asksCliEnv
:: MonadReader (CliEnv cmd appEnv) m
=> (CliEnv cmd appEnv -> field)
-> m field
asksCliEnv :: forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(CliEnv cmd appEnv -> field) -> m field
asksCliEnv = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks
asksAppEnv
:: MonadReader (CliEnv cmd appEnv) m
=> (appEnv -> field)
-> m field
asksAppEnv :: forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(appEnv -> field) -> m field
asksAppEnv appEnv -> field
getField = forall cmd appEnv (m :: * -> *) field.
MonadReader (CliEnv cmd appEnv) m =>
(CliEnv cmd appEnv -> field) -> m field
asksCliEnv (appEnv -> field
getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cmd appEnv. CliEnv cmd appEnv -> appEnv
cliEnvAppEnv)