-- | Module    : Termonad.Cli
-- Description : Termonad CLI argument parsing module.
-- Copyright   : (c) Dennis Gosnell, 2023
-- License     : BSD3
-- Stability   : experimental
-- Portability : POSIX
--
-- 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'.

module Termonad.Cli where

import Termonad.Prelude

import Control.Applicative ((<|>), (<**>))
import Data.Text (pack)
import GI.Vte (CursorBlinkMode)
import Options.Applicative (fullDesc, info, helper, progDesc, ParserInfo, execParser, Parser, Mod, OptionFields, option, str, value, short, long, metavar, help, ReadM, maybeReader, auto, flag')
import Termonad.Types (ConfigOptions (..), Option (Set, Unset), ShowScrollbar, FontSize (..), ShowTabBar, showScrollbarFromString, showTabBarFromString, cursorBlinkModeFromString, FontConfig (..))


-- | A data type that contains arguments from the command line.
data CliArgs = CliArgs
  { CliArgs -> CliConfigOptions
cliConfigOptions :: CliConfigOptions
  , CliArgs -> ExtraCliArgs
extraCliArgs :: ExtraCliArgs
  } deriving (CliArgs -> CliArgs -> Bool
(CliArgs -> CliArgs -> Bool)
-> (CliArgs -> CliArgs -> Bool) -> Eq CliArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CliArgs -> CliArgs -> Bool
== :: CliArgs -> CliArgs -> Bool
$c/= :: CliArgs -> CliArgs -> Bool
/= :: CliArgs -> CliArgs -> Bool
Eq, Int -> CliArgs -> ShowS
[CliArgs] -> ShowS
CliArgs -> String
(Int -> CliArgs -> ShowS)
-> (CliArgs -> String) -> ([CliArgs] -> ShowS) -> Show CliArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CliArgs -> ShowS
showsPrec :: Int -> CliArgs -> ShowS
$cshow :: CliArgs -> String
show :: CliArgs -> String
$cshowList :: [CliArgs] -> ShowS
showList :: [CliArgs] -> ShowS
Show)

-- | 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
defaultCliArgs :: CliArgs
defaultCliArgs :: CliArgs
defaultCliArgs =
  CliArgs
    { cliConfigOptions :: CliConfigOptions
cliConfigOptions = CliConfigOptions
defaultCliConfigOptions
    , extraCliArgs :: ExtraCliArgs
extraCliArgs = ExtraCliArgs
defaultExtraCliArgs
    }

-- | CLI arguments that correspond to fields in 'ConfigOptions'.
--
-- See 'ConfigOptions' for what each of these options mean.
data CliConfigOptions = CliConfigOptions
  { CliConfigOptions -> Option Text
cliConfFontFamily :: !(Option Text)
  , CliConfigOptions -> Option FontSize
cliConfFontSize :: !(Option FontSize)
  , CliConfigOptions -> Option ShowScrollbar
cliConfShowScrollbar :: !(Option ShowScrollbar)
  , CliConfigOptions -> Option Integer
cliConfScrollbackLen :: !(Option Integer)
  , CliConfigOptions -> Option Bool
cliConfConfirmExit :: !(Option Bool)
  , CliConfigOptions -> Option Text
cliConfWordCharExceptions :: !(Option Text)
  , CliConfigOptions -> Option Bool
cliConfShowMenu :: !(Option Bool)
  , CliConfigOptions -> Option ShowTabBar
cliConfShowTabBar :: !(Option ShowTabBar)
  , CliConfigOptions -> Option CursorBlinkMode
cliConfCursorBlinkMode :: !(Option CursorBlinkMode)
  , CliConfigOptions -> Option Bool
cliConfBoldIsBright :: !(Option Bool)
  , CliConfigOptions -> Option Bool
cliConfEnableSixel :: !(Option Bool)
  , CliConfigOptions -> Option Bool
cliConfAllowBold :: !(Option Bool)
  } deriving (CliConfigOptions -> CliConfigOptions -> Bool
(CliConfigOptions -> CliConfigOptions -> Bool)
-> (CliConfigOptions -> CliConfigOptions -> Bool)
-> Eq CliConfigOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CliConfigOptions -> CliConfigOptions -> Bool
== :: CliConfigOptions -> CliConfigOptions -> Bool
$c/= :: CliConfigOptions -> CliConfigOptions -> Bool
/= :: CliConfigOptions -> CliConfigOptions -> Bool
Eq, Int -> CliConfigOptions -> ShowS
[CliConfigOptions] -> ShowS
CliConfigOptions -> String
(Int -> CliConfigOptions -> ShowS)
-> (CliConfigOptions -> String)
-> ([CliConfigOptions] -> ShowS)
-> Show CliConfigOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CliConfigOptions -> ShowS
showsPrec :: Int -> CliConfigOptions -> ShowS
$cshow :: CliConfigOptions -> String
show :: CliConfigOptions -> String
$cshowList :: [CliConfigOptions] -> ShowS
showList :: [CliConfigOptions] -> ShowS
Show)

-- | The default 'CliConfigOptions'.  All 'Option's 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
defaultCliConfigOptions :: CliConfigOptions
defaultCliConfigOptions :: CliConfigOptions
defaultCliConfigOptions =
  CliConfigOptions
    { cliConfFontFamily :: Option Text
cliConfFontFamily = Option Text
forall a. Option a
Unset
    , cliConfFontSize :: Option FontSize
cliConfFontSize = Option FontSize
forall a. Option a
Unset
    , cliConfShowScrollbar :: Option ShowScrollbar
cliConfShowScrollbar = Option ShowScrollbar
forall a. Option a
Unset
    , cliConfScrollbackLen :: Option Integer
cliConfScrollbackLen = Option Integer
forall a. Option a
Unset
    , cliConfConfirmExit :: Option Bool
cliConfConfirmExit = Option Bool
forall a. Option a
Unset
    , cliConfWordCharExceptions :: Option Text
cliConfWordCharExceptions = Option Text
forall a. Option a
Unset
    , cliConfShowMenu :: Option Bool
cliConfShowMenu = Option Bool
forall a. Option a
Unset
    , cliConfShowTabBar :: Option ShowTabBar
cliConfShowTabBar = Option ShowTabBar
forall a. Option a
Unset
    , cliConfCursorBlinkMode :: Option CursorBlinkMode
cliConfCursorBlinkMode = Option CursorBlinkMode
forall a. Option a
Unset
    , cliConfBoldIsBright :: Option Bool
cliConfBoldIsBright = Option Bool
forall a. Option a
Unset
    , cliConfEnableSixel :: Option Bool
cliConfEnableSixel = Option Bool
forall a. Option a
Unset
    , cliConfAllowBold :: Option Bool
cliConfAllowBold = Option Bool
forall a. Option a
Unset
    }

-- | Extra CLI arguments for values that don't make sense in 'ConfigOptions'.
data ExtraCliArgs = ExtraCliArgs
  deriving (ExtraCliArgs -> ExtraCliArgs -> Bool
(ExtraCliArgs -> ExtraCliArgs -> Bool)
-> (ExtraCliArgs -> ExtraCliArgs -> Bool) -> Eq ExtraCliArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraCliArgs -> ExtraCliArgs -> Bool
== :: ExtraCliArgs -> ExtraCliArgs -> Bool
$c/= :: ExtraCliArgs -> ExtraCliArgs -> Bool
/= :: ExtraCliArgs -> ExtraCliArgs -> Bool
Eq, Int -> ExtraCliArgs -> ShowS
[ExtraCliArgs] -> ShowS
ExtraCliArgs -> String
(Int -> ExtraCliArgs -> ShowS)
-> (ExtraCliArgs -> String)
-> ([ExtraCliArgs] -> ShowS)
-> Show ExtraCliArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraCliArgs -> ShowS
showsPrec :: Int -> ExtraCliArgs -> ShowS
$cshow :: ExtraCliArgs -> String
show :: ExtraCliArgs -> String
$cshowList :: [ExtraCliArgs] -> ShowS
showList :: [ExtraCliArgs] -> ShowS
Show)

-- | The default 'ExtraCliArgs'.
--
-- >>> :{
--   let defExtraCliArgs =
--         ExtraCliArgs
--   in defaultExtraCliArgs == defExtraCliArgs
-- :}
-- True
defaultExtraCliArgs :: ExtraCliArgs
defaultExtraCliArgs :: ExtraCliArgs
defaultExtraCliArgs = ExtraCliArgs
ExtraCliArgs

-- | Similar to 'Options.Applicative.strOption', but specifically work on a
-- value that is an 'Option'.
strOption' :: IsString s => Mod OptionFields (Option s) -> Parser (Option s)
strOption' :: forall s.
IsString s =>
Mod OptionFields (Option s) -> Parser (Option s)
strOption' Mod OptionFields (Option s)
mods = ReadM (Option s)
-> Mod OptionFields (Option s) -> Parser (Option s)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((s -> Option s) -> ReadM s -> ReadM (Option s)
forall a b. (a -> b) -> ReadM a -> ReadM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Option s
forall a. a -> Option a
Set ReadM s
forall s. IsString s => ReadM s
str) (Option s -> Mod OptionFields (Option s)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Option s
forall a. Option a
Unset Mod OptionFields (Option s)
-> Mod OptionFields (Option s) -> Mod OptionFields (Option s)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Option s)
mods)

-- | Similar to 'Options.Applicative.option', but specifically work on a
-- value that is an 'Option'.
option' :: ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option' :: forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option' ReadM a
readM Mod OptionFields (Option a)
mods = ReadM (Option a)
-> Mod OptionFields (Option a) -> Parser (Option a)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((a -> Option a) -> ReadM a -> ReadM (Option a)
forall a b. (a -> b) -> ReadM a -> ReadM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Option a
forall a. a -> Option a
Set ReadM a
readM) (Option a -> Mod OptionFields (Option a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Option a
forall a. Option a
Unset Mod OptionFields (Option a)
-> Mod OptionFields (Option a) -> Mod OptionFields (Option a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Option a)
mods)

-- | Similar to 'Options.Applicative.maybeReader', but work on 'Text' instead
-- of 'String'.
maybeTextReader :: (Text -> Maybe a) -> ReadM a
maybeTextReader :: forall a. (Text -> Maybe a) -> ReadM a
maybeTextReader Text -> Maybe a
f = (String -> Maybe a) -> ReadM a
forall a. (String -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe a
f (Text -> Maybe a) -> (String -> Text) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack)

-- | 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.
optionFlag
  :: 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)
optionFlag :: forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag a
valNormal a
valNo Char
shortNormal Char
shortNo String
longFlag String
helpNormal String
helpNo =
  Parser (Option a)
flagNormal Parser (Option a) -> Parser (Option a) -> Parser (Option a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Option a)
flagNo Parser (Option a) -> Parser (Option a) -> Parser (Option a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Option a -> Parser (Option a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Option a
forall a. Option a
Unset
  where
    flagNormal :: Parser (Option a)
flagNormal =
      Option a -> Mod FlagFields (Option a) -> Parser (Option a)
forall a. a -> Mod FlagFields a -> Parser a
flag' (a -> Option a
forall a. a -> Option a
Set a
valNormal) (Char -> Mod FlagFields (Option a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
shortNormal Mod FlagFields (Option a)
-> Mod FlagFields (Option a) -> Mod FlagFields (Option a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Option a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
longFlag Mod FlagFields (Option a)
-> Mod FlagFields (Option a) -> Mod FlagFields (Option a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Option a)
forall (f :: * -> *) a. String -> Mod f a
help String
helpNormal)
    flagNo :: Parser (Option a)
flagNo =
      Option a -> Mod FlagFields (Option a) -> Parser (Option a)
forall a. a -> Mod FlagFields a -> Parser a
flag' (a -> Option a
forall a. a -> Option a
Set a
valNo) (Char -> Mod FlagFields (Option a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
shortNo Mod FlagFields (Option a)
-> Mod FlagFields (Option a) -> Mod FlagFields (Option a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Option a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"no-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
longFlag) Mod FlagFields (Option a)
-> Mod FlagFields (Option a) -> Mod FlagFields (Option a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Option a)
forall (f :: * -> *) a. String -> Mod f a
help String
helpNo)

cliConfigOptionsParser :: Parser CliConfigOptions
cliConfigOptionsParser :: Parser CliConfigOptions
cliConfigOptionsParser =
  Option Text
-> Option FontSize
-> Option ShowScrollbar
-> Option Integer
-> Option Bool
-> Option Text
-> Option Bool
-> Option ShowTabBar
-> Option CursorBlinkMode
-> Option Bool
-> Option Bool
-> Option Bool
-> CliConfigOptions
CliConfigOptions
    (Option Text
 -> Option FontSize
 -> Option ShowScrollbar
 -> Option Integer
 -> Option Bool
 -> Option Text
 -> Option Bool
 -> Option ShowTabBar
 -> Option CursorBlinkMode
 -> Option Bool
 -> Option Bool
 -> Option Bool
 -> CliConfigOptions)
-> Parser (Option Text)
-> Parser
     (Option FontSize
      -> Option ShowScrollbar
      -> Option Integer
      -> Option Bool
      -> Option Text
      -> Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Option Text)
fontFamilyParser
    Parser
  (Option FontSize
   -> Option ShowScrollbar
   -> Option Integer
   -> Option Bool
   -> Option Text
   -> Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option FontSize)
-> Parser
     (Option ShowScrollbar
      -> Option Integer
      -> Option Bool
      -> Option Text
      -> Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option FontSize)
fontSizeParser
    Parser
  (Option ShowScrollbar
   -> Option Integer
   -> Option Bool
   -> Option Text
   -> Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option ShowScrollbar)
-> Parser
     (Option Integer
      -> Option Bool
      -> Option Text
      -> Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option ShowScrollbar)
showScrollbarParser
    Parser
  (Option Integer
   -> Option Bool
   -> Option Text
   -> Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option Integer)
-> Parser
     (Option Bool
      -> Option Text
      -> Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Integer)
scrollbackLenParser
    Parser
  (Option Bool
   -> Option Text
   -> Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option Bool)
-> Parser
     (Option Text
      -> Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Bool)
confirmExitParser
    Parser
  (Option Text
   -> Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option Text)
-> Parser
     (Option Bool
      -> Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Text)
wordCharExceptionsParser
    Parser
  (Option Bool
   -> Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option Bool)
-> Parser
     (Option ShowTabBar
      -> Option CursorBlinkMode
      -> Option Bool
      -> Option Bool
      -> Option Bool
      -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Bool)
showMenuParser
    Parser
  (Option ShowTabBar
   -> Option CursorBlinkMode
   -> Option Bool
   -> Option Bool
   -> Option Bool
   -> CliConfigOptions)
-> Parser (Option ShowTabBar)
-> Parser
     (Option CursorBlinkMode
      -> Option Bool -> Option Bool -> Option Bool -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option ShowTabBar)
showTabBarParser
    Parser
  (Option CursorBlinkMode
   -> Option Bool -> Option Bool -> Option Bool -> CliConfigOptions)
-> Parser (Option CursorBlinkMode)
-> Parser
     (Option Bool -> Option Bool -> Option Bool -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option CursorBlinkMode)
cursorBlinkModeParser
    Parser
  (Option Bool -> Option Bool -> Option Bool -> CliConfigOptions)
-> Parser (Option Bool)
-> Parser (Option Bool -> Option Bool -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Bool)
boldIsBrightParser
    Parser (Option Bool -> Option Bool -> CliConfigOptions)
-> Parser (Option Bool) -> Parser (Option Bool -> CliConfigOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Bool)
enableSixelParser
    Parser (Option Bool -> CliConfigOptions)
-> Parser (Option Bool) -> Parser CliConfigOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Bool)
allowBoldParser

fontFamilyParser :: Parser (Option Text)
fontFamilyParser :: Parser (Option Text)
fontFamilyParser =
  Mod OptionFields (Option Text) -> Parser (Option Text)
forall s.
IsString s =>
Mod OptionFields (Option s) -> Parser (Option s)
strOption'
    ( Char -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"font-family" Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FONT_FAMILY" Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"Font family to use. Defaults to \"Monospace\". Examples: \
        \\"DejaVu Sans Mono\", \"Source Code Pro\""
    )

fontSizeParser :: Parser (Option FontSize)
fontSizeParser :: Parser (Option FontSize)
fontSizeParser = Option Int -> Option Double -> Option FontSize
f (Option Int -> Option Double -> Option FontSize)
-> Parser (Option Int) -> Parser (Option Double -> Option FontSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Option Int)
pointsParser Parser (Option Double -> Option FontSize)
-> Parser (Option Double) -> Parser (Option FontSize)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Option Double)
unitsParser
  where
    f :: Option Int -> Option Double -> Option FontSize
    f :: Option Int -> Option Double -> Option FontSize
f Option Int
optionPoints Option Double
optionUnits =
      case ((Int -> FontSize) -> Option Int -> Option FontSize
forall a b. (a -> b) -> Option a -> Option b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> FontSize
FontSizePoints Option Int
optionPoints, (Double -> FontSize) -> Option Double -> Option FontSize
forall a b. (a -> b) -> Option a -> Option b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FontSize
FontSizeUnits Option Double
optionUnits) of
        (Option FontSize
Unset, Option FontSize
units) -> Option FontSize
units
        (Option FontSize
points, Option FontSize
_) -> Option FontSize
points

    pointsParser :: Parser (Option Int)
    pointsParser :: Parser (Option Int)
pointsParser =
      ReadM Int -> Mod OptionFields (Option Int) -> Parser (Option Int)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
        ReadM Int
forall a. Read a => ReadM a
auto
        ( Char -> Mod OptionFields (Option Int)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields (Option Int)
-> Mod OptionFields (Option Int) -> Mod OptionFields (Option Int)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"font-size-points" Mod OptionFields (Option Int)
-> Mod OptionFields (Option Int) -> Mod OptionFields (Option Int)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"POINTS" Mod OptionFields (Option Int)
-> Mod OptionFields (Option Int) -> Mod OptionFields (Option Int)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Int)
forall (f :: * -> *) a. String -> Mod f a
help
            String
"Font size in POINTS. Defaults to \"12\" if not specified. \
            \If you specify both --font-size-points and --font-size-units, \
            \--font-size-points will take priority.  --font-size-points \
            \should be similar to font sizes you may be \
            \familiar with from other applications."
        )

    unitsParser :: Parser (Option Double)
    unitsParser :: Parser (Option Double)
unitsParser =
      ReadM Double
-> Mod OptionFields (Option Double) -> Parser (Option Double)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
        ReadM Double
forall a. Read a => ReadM a
auto
        ( Char -> Mod OptionFields (Option Double)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"font-size-units" Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Double)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"UNITS" Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
-> Mod OptionFields (Option Double)
forall a. Semigroup a => a -> a -> a
<>
          String -> Mod OptionFields (Option Double)
forall (f :: * -> *) a. String -> Mod f a
help
            String
"Font size in device units/pixels. Example: \"20.5\", \
            \\"30\".  If not specified, the default from \
            \--font-size-points is used."
        )

showScrollbarParser :: Parser (Option ShowScrollbar)
showScrollbarParser :: Parser (Option ShowScrollbar)
showScrollbarParser =
  ReadM ShowScrollbar
-> Mod OptionFields (Option ShowScrollbar)
-> Parser (Option ShowScrollbar)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
    ((Text -> Maybe ShowScrollbar) -> ReadM ShowScrollbar
forall a. (Text -> Maybe a) -> ReadM a
maybeTextReader Text -> Maybe ShowScrollbar
showScrollbarFromString)
    ( Char -> Mod OptionFields (Option ShowScrollbar)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowScrollbar)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-scrollbar" Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowScrollbar)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SHOW_SCROLLBAR" Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
-> Mod OptionFields (Option ShowScrollbar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowScrollbar)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"Whether or not to show a scrollbar in the terminal. \
        \Defaults to \"if-needed\".  Possible values = \"never\": \
        \never show the scrollbar, \"always\": always show the \
        \scrollbar, \"if-needed\": only show the scrollbar if \
        \enough text on the screen"
    )

scrollbackLenParser :: Parser (Option Integer)
scrollbackLenParser :: Parser (Option Integer)
scrollbackLenParser =
  ReadM Integer
-> Mod OptionFields (Option Integer) -> Parser (Option Integer)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
    ReadM Integer
forall a. Read a => ReadM a
auto
    ( Char -> Mod OptionFields (Option Integer)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b' Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Integer)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"scrollback-length" Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Integer)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SCROLLBACK_LENGTH" Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
-> Mod OptionFields (Option Integer)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Integer)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"Number of lines to keep in the scrollback buffer in the \
        \terminal.  Defaults to 10000 lines.  Examples: \"200\", \
        \\"3000\""
    )

confirmExitParser :: Parser (Option Bool)
confirmExitParser :: Parser (Option Bool)
confirmExitParser =
  Bool
-> Bool
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option Bool)
forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag
    Bool
True
    Bool
False
    Char
'x'
    Char
'C'
    String
"confirm-exit"
    String
"Ask for confirmation when closing terminals or Termonad itself. \
    \Defaults to asking for confirmation if not specified."
    String
"Do not ask for confirmation when closing terminals or Termonad \
    \itself. Defaults to asking for confirmation if not specified."

wordCharExceptionsParser :: Parser (Option Text)
wordCharExceptionsParser :: Parser (Option Text)
wordCharExceptionsParser =
  Mod OptionFields (Option Text) -> Parser (Option Text)
forall s.
IsString s =>
Mod OptionFields (Option s) -> Parser (Option s)
strOption'
    ( Char -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w' Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"word-char-exceptions" Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"EXCEPTIONS" Mod OptionFields (Option Text)
-> Mod OptionFields (Option Text) -> Mod OptionFields (Option Text)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option Text)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"The characters in this list will be counted as part of a word \
        \when double-clicking to select text in the terminal. Defaults \
        \to \"-#%&+,./=?@\\_~:\""
    )

showMenuParser :: Parser (Option Bool)
showMenuParser :: Parser (Option Bool)
showMenuParser =
  Bool
-> Bool
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option Bool)
forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag
    Bool
True
    Bool
False
    Char
'm'
    Char
'u'
    String
"show-menu"
    String
"Show the menu bar.  Defaults to showing the menu bar when not \
    \specified."
    String
"Do not show the menu bar.  Defaults to showing the menu bar when \
    \not specified."

showTabBarParser :: Parser (Option ShowTabBar)
showTabBarParser :: Parser (Option ShowTabBar)
showTabBarParser =
  ReadM ShowTabBar
-> Mod OptionFields (Option ShowTabBar)
-> Parser (Option ShowTabBar)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
    ((Text -> Maybe ShowTabBar) -> ReadM ShowTabBar
forall a. (Text -> Maybe a) -> ReadM a
maybeTextReader Text -> Maybe ShowTabBar
showTabBarFromString)
    ( Char -> Mod OptionFields (Option ShowTabBar)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowTabBar)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show-tab-bar" Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowTabBar)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SHOW_TAB_BAR" Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
-> Mod OptionFields (Option ShowTabBar)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option ShowTabBar)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"Whether or not to show the tab bar in the terminal. \
        \Defaults to \"if-needed\".  Possible values = \"never\": \
        \never show the tab bar, \"always\": always show the \
        \tab bar, \"if-needed\": only show the tab bar if \
        \multiple tabs are open."
    )

cursorBlinkModeParser :: Parser (Option CursorBlinkMode)
cursorBlinkModeParser :: Parser (Option CursorBlinkMode)
cursorBlinkModeParser =
  ReadM CursorBlinkMode
-> Mod OptionFields (Option CursorBlinkMode)
-> Parser (Option CursorBlinkMode)
forall a.
ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)
option'
    ((Text -> Maybe CursorBlinkMode) -> ReadM CursorBlinkMode
forall a. (Text -> Maybe a) -> ReadM a
maybeTextReader Text -> Maybe CursorBlinkMode
cursorBlinkModeFromString)
    ( Char -> Mod OptionFields (Option CursorBlinkMode)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option CursorBlinkMode)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cursor-blink" Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option CursorBlinkMode)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"BLINK_MODE" Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
-> Mod OptionFields (Option CursorBlinkMode)
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields (Option CursorBlinkMode)
forall (f :: * -> *) a. String -> Mod f a
help
        String
"How to handle cursor blink.  Defaults to \"on\". Possible \
        \values = \"system\": follow system settings, \"on\": cursor \
        \blinks, \"off\": no cursor blink."
    )

boldIsBrightParser :: Parser (Option Bool)
boldIsBrightParser :: Parser (Option Bool)
boldIsBrightParser =
  Bool
-> Bool
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option Bool)
forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag
    Bool
True
    Bool
False
    Char
'd'
    Char
'r'
    String
"bold-is-bright"
    String
"Force bold text to use bright colors.  Defaults to not forcing \
    \bold text to use bright colors."
    String
"Do not force bold text to use bright colors.  Defaults to not forcing \
    \bold text to use bright colors."

enableSixelParser :: Parser (Option Bool)
enableSixelParser :: Parser (Option Bool)
enableSixelParser =
  Bool
-> Bool
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option Bool)
forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag
    Bool
True
    Bool
False
    Char
's'
    Char
'i'
    String
"sixel"
    String
"Enable SIXEL support.  Note that you need to build Termonad with \
    \a VTE with SIXEL support for this to work.  Defaults to not \
    \enabling SIXEL."
    String
"Disable SIXEL support.  Defaults to disabling SIXEL support."

allowBoldParser :: Parser (Option Bool)
allowBoldParser :: Parser (Option Bool)
allowBoldParser =
  Bool
-> Bool
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option Bool)
forall a.
a
-> a
-> Char
-> Char
-> String
-> String
-> String
-> Parser (Option a)
optionFlag
    Bool
True
    Bool
False
    Char
'a'
    Char
'o'
    String
"allow-bold"
    String
"Allow Termonad to show bold text.  Defaults to enabled."
    String
"Disable Termonad from showing text as bold.  Defaults to \
    \allow showing text as bold."

extraCliArgsParser :: Parser ExtraCliArgs
extraCliArgsParser :: Parser ExtraCliArgs
extraCliArgsParser = ExtraCliArgs -> Parser ExtraCliArgs
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtraCliArgs
ExtraCliArgs

cliArgsParser :: Parser CliArgs
cliArgsParser :: Parser CliArgs
cliArgsParser =
  CliConfigOptions -> ExtraCliArgs -> CliArgs
CliArgs (CliConfigOptions -> ExtraCliArgs -> CliArgs)
-> Parser CliConfigOptions -> Parser (ExtraCliArgs -> CliArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CliConfigOptions
cliConfigOptionsParser Parser (ExtraCliArgs -> CliArgs)
-> Parser ExtraCliArgs -> Parser CliArgs
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExtraCliArgs
extraCliArgsParser

cliArgsParserInfo :: ParserInfo CliArgs
cliArgsParserInfo :: ParserInfo CliArgs
cliArgsParserInfo =
  Parser CliArgs -> InfoMod CliArgs -> ParserInfo CliArgs
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser CliArgs
cliArgsParser Parser CliArgs -> Parser (CliArgs -> CliArgs) -> Parser CliArgs
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CliArgs -> CliArgs)
forall a. Parser (a -> a)
helper)
    ( InfoMod CliArgs
forall a. InfoMod a
fullDesc InfoMod CliArgs -> InfoMod CliArgs -> InfoMod CliArgs
forall a. Semigroup a => a -> a -> a
<>
      String -> InfoMod CliArgs
forall a. String -> InfoMod a
progDesc String
"A VTE-based terminal emulator configurable in Haskell"
    )

-- | Parse and return CliArguments.
parseCliArgs :: IO CliArgs
parseCliArgs :: IO CliArgs
parseCliArgs = ParserInfo CliArgs -> IO CliArgs
forall a. ParserInfo a -> IO a
execParser ParserInfo CliArgs
cliArgsParserInfo

-- | 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
applyCliArgs :: CliArgs -> ConfigOptions -> ConfigOptions
applyCliArgs :: CliArgs -> ConfigOptions -> ConfigOptions
applyCliArgs CliArgs
cliArgs ConfigOptions
confOpts =
  let oldFontConf :: FontConfig
oldFontConf = ConfigOptions -> FontConfig
fontConfig ConfigOptions
confOpts
      newFontConfig :: FontConfig
newFontConfig =
        FontConfig
oldFontConf
          { fontFamily :: Text
fontFamily =
              Text -> Option Text -> Text
forall b. b -> Option b -> b
fromOption
                (FontConfig -> Text
fontFamily FontConfig
oldFontConf)
                (CliConfigOptions -> Option Text
cliConfFontFamily CliConfigOptions
cliConfOpts)
          , fontSize :: FontSize
fontSize =
              FontSize -> Option FontSize -> FontSize
forall b. b -> Option b -> b
fromOption
                (FontConfig -> FontSize
fontSize FontConfig
oldFontConf)
                (CliConfigOptions -> Option FontSize
cliConfFontSize CliConfigOptions
cliConfOpts)
          }
  in
  ConfigOptions
confOpts
    { fontConfig :: FontConfig
fontConfig = FontConfig
newFontConfig
    , showScrollbar :: ShowScrollbar
showScrollbar = (ConfigOptions -> ShowScrollbar)
-> (CliConfigOptions -> Option ShowScrollbar) -> ShowScrollbar
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> ShowScrollbar
showScrollbar CliConfigOptions -> Option ShowScrollbar
cliConfShowScrollbar
    , scrollbackLen :: Integer
scrollbackLen = (ConfigOptions -> Integer)
-> (CliConfigOptions -> Option Integer) -> Integer
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Integer
scrollbackLen CliConfigOptions -> Option Integer
cliConfScrollbackLen
    , confirmExit :: Bool
confirmExit = (ConfigOptions -> Bool)
-> (CliConfigOptions -> Option Bool) -> Bool
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Bool
confirmExit CliConfigOptions -> Option Bool
cliConfConfirmExit
    , wordCharExceptions :: Text
wordCharExceptions = (ConfigOptions -> Text)
-> (CliConfigOptions -> Option Text) -> Text
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Text
wordCharExceptions CliConfigOptions -> Option Text
cliConfWordCharExceptions
    , showMenu :: Bool
showMenu = (ConfigOptions -> Bool)
-> (CliConfigOptions -> Option Bool) -> Bool
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Bool
showMenu CliConfigOptions -> Option Bool
cliConfShowMenu
    , showTabBar :: ShowTabBar
showTabBar = (ConfigOptions -> ShowTabBar)
-> (CliConfigOptions -> Option ShowTabBar) -> ShowTabBar
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> ShowTabBar
showTabBar CliConfigOptions -> Option ShowTabBar
cliConfShowTabBar
    , cursorBlinkMode :: CursorBlinkMode
cursorBlinkMode = (ConfigOptions -> CursorBlinkMode)
-> (CliConfigOptions -> Option CursorBlinkMode) -> CursorBlinkMode
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> CursorBlinkMode
cursorBlinkMode CliConfigOptions -> Option CursorBlinkMode
cliConfCursorBlinkMode
    , boldIsBright :: Bool
boldIsBright = (ConfigOptions -> Bool)
-> (CliConfigOptions -> Option Bool) -> Bool
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Bool
boldIsBright CliConfigOptions -> Option Bool
cliConfBoldIsBright
    , enableSixel :: Bool
enableSixel = (ConfigOptions -> Bool)
-> (CliConfigOptions -> Option Bool) -> Bool
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Bool
enableSixel CliConfigOptions -> Option Bool
cliConfEnableSixel
    , allowBold :: Bool
allowBold = (ConfigOptions -> Bool)
-> (CliConfigOptions -> Option Bool) -> Bool
forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> Bool
allowBold CliConfigOptions -> Option Bool
cliConfAllowBold
    }
  where
    fromOpt
      :: forall a. (ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
    fromOpt :: forall a.
(ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a
fromOpt ConfigOptions -> a
getConfVal CliConfigOptions -> Option a
getCliVal =
      a -> Option a -> a
forall b. b -> Option b -> b
fromOption
        (ConfigOptions -> a
getConfVal ConfigOptions
confOpts)
        (CliConfigOptions -> Option a
getCliVal CliConfigOptions
cliConfOpts)

    fromOption :: forall b. b -> Option b -> b
    fromOption :: forall b. b -> Option b -> b
fromOption b
defVal = \case
      Set b
a -> b
a
      Option b
Unset -> b
defVal

    cliConfOpts :: CliConfigOptions
    cliConfOpts :: CliConfigOptions
cliConfOpts = CliArgs -> CliConfigOptions
cliConfigOptions CliArgs
cliArgs