termonad-4.6.0.0: Terminal emulator configurable in Haskell
Copyright(c) Dennis Gosnell 2023
LicenseBSD3
Stabilityexperimental
PortabilityPOSIX
Safe HaskellSafe-Inferred
LanguageHaskell2010

Termonad.Cli

Description

This module exposes Termonad's CLI argument parsing functionality.

The main function for parsing CLI arguments is parseCliArgs. The function that knows how to combine CLI arguments with normal ConfigOptions is applyCliArgs.

Synopsis

Documentation

data CliArgs Source #

A data type that contains arguments from the command line.

Instances

Instances details
Show CliArgs Source # 
Instance details

Defined in Termonad.Cli

Eq CliArgs Source # 
Instance details

Defined in Termonad.Cli

Methods

(==) :: CliArgs -> CliArgs -> Bool #

(/=) :: CliArgs -> CliArgs -> Bool #

defaultCliArgs :: CliArgs Source #

The default CliArgs. This corresponds to the value CliArgs will become when no CLI arguments have been passed.

>>> :{
  let defCliArgs =
        CliArgs
          { cliConfigOptions = defaultCliConfigOptions
          , extraCliArgs = defaultExtraCliArgs
          }
  in defaultCliArgs == defCliArgs
:}
True

defaultCliConfigOptions :: CliConfigOptions Source #

The default CliConfigOptions. All Options are Unset, which means they won't override options from ConfigOptions in applyCliArgs.

>>> :{
  let defCliConfOpt =
        CliConfigOptions
          { cliConfFontFamily = Unset
          , cliConfFontSize = Unset
          , cliConfShowScrollbar = Unset
          , cliConfScrollbackLen = Unset
          , cliConfConfirmExit = Unset
          , cliConfWordCharExceptions = Unset
          , cliConfShowMenu = Unset
          , cliConfShowTabBar = Unset
          , cliConfCursorBlinkMode = Unset
          , cliConfBoldIsBright = Unset
          , cliConfEnableSixel = Unset
          , cliConfAllowBold = Unset
          }
  in defaultCliConfigOptions == defCliConfOpt
:}
True

data ExtraCliArgs Source #

Extra CLI arguments for values that don't make sense in ConfigOptions.

Constructors

ExtraCliArgs 

Instances

Instances details
Show ExtraCliArgs Source # 
Instance details

Defined in Termonad.Cli

Eq ExtraCliArgs Source # 
Instance details

Defined in Termonad.Cli

defaultExtraCliArgs :: ExtraCliArgs Source #

The default ExtraCliArgs.

>>> :{
  let defExtraCliArgs =
        ExtraCliArgs
  in defaultExtraCliArgs == defExtraCliArgs
:}
True

strOption' :: IsString s => Mod OptionFields (Option s) -> Parser (Option s) Source #

Similar to strOption, but specifically work on a value that is an Option.

option' :: ReadM a -> Mod OptionFields (Option a) -> Parser (Option a) Source #

Similar to option, but specifically work on a value that is an Option.

maybeTextReader :: (Text -> Maybe a) -> ReadM a Source #

Similar to maybeReader, but work on Text instead of String.

optionFlag Source #

Arguments

:: a

Value when specified without no- prefix.

-> a

Value when specified with no- prefix.

-> Char

Short flag for without no- prefix.

-> Char

Short flag for with no- prefix.

-> String

Long flag.

-> String

Help text for without no- prefix option.

-> String

Help text for with no- prefix option.

-> Parser (Option a) 

Helper for making a flag CLI argument that optionally takes a no- prefix.

Example:

'optionFlag' 'True' 'False' 'f' 'n' "foo" "Does foo" "Does not do foo" :: Parser (Option Bool)

This creates a Parser that accepts both a --foo and a --no-foo flag. Passing --foo returns Set True, while passing --no-foo returns Set False. Passing neither --foo nor --no-foo returns Unset.

TODO: This doesn't quite work. If the user passes both --foo and --no-foo flags, this should ideally take the value of the last flag passed. However, it appears that if you pass both flags, the second flag is just not recognized and optparse-applicative raises an error.

parseCliArgs :: IO CliArgs Source #

Parse and return CliArguments.

applyCliArgs :: CliArgs -> ConfigOptions -> ConfigOptions Source #

Overwrite the arguments in ConfigOptions that have been Set in CliArgs.

>>> import Termonad.Types (defaultConfigOptions)
>>> let cliConfOpts = defaultCliConfigOptions { cliConfScrollbackLen = Set 50 }
>>> let cliArgs = defaultCliArgs { cliConfigOptions = cliConfOpts }
>>> let overwrittenConfOpts = defaultConfigOptions { scrollbackLen = 50 }
>>> applyCliArgs cliArgs defaultConfigOptions == overwrittenConfOpts
True