{-|
Module      : KMonad.Args.Cmd
Description : Parse command-line options into a 'Cmd' for KMonad to execute
Copyright   : (c) David Janssen, 2019
License     : MIT

Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)

-}
module KMonad.Args.Cmd
  ( Cmd(..)
  , HasCmd(..)
  , getCmd
  )
where

import KMonad.Prelude hiding (try)
import KMonad.Args.Parser (itokens, keywordButtons, noKeywordButtons, otokens, symbol, numP, implArndButtons)
import KMonad.Args.TH (gitHash)
import KMonad.Args.Types (DefSetting(..))
import KMonad.Util
import Paths_kmonad (version)

import qualified KMonad.Parsing as M  -- [M]egaparsec functionality

import Data.Version (showVersion)
import Options.Applicative


--------------------------------------------------------------------------------
-- $cmd
--
-- The different things KMonad can be instructed to do.

-- | Record describing the instruction to KMonad
data Cmd = Cmd
  { Cmd -> String
_cfgFile   :: FilePath     -- ^ Which file to read the config from
  , Cmd -> Bool
_dryRun    :: Bool         -- ^ Flag to indicate we are only test-parsing
  , Cmd -> LogLevel
_logLvl    :: LogLevel     -- ^ Level of logging to use
  , Cmd -> Milliseconds
_strtDel   :: Milliseconds -- ^ How long to wait before acquiring the input keyboard

    -- All 'KDefCfg' options of a 'KExpr'
  , Cmd -> DefSetting
_cmdAllow  :: DefSetting       -- ^ Allow execution of arbitrary shell-commands?
  , Cmd -> DefSetting
_fallThrgh :: DefSetting       -- ^ Re-emit unhandled events?
  , Cmd -> Maybe DefSetting
_cmpSeq    :: Maybe DefSetting -- ^ Key to use for compose-key sequences
  , Cmd -> Maybe DefSetting
_cmpSeqDelay :: Maybe DefSetting -- ^ Specify compose sequence key delays
  , Cmd -> Maybe DefSetting
_keySeqDelay :: Maybe DefSetting -- ^ Specify key event output delays
  , Cmd -> Maybe DefSetting
_implArnd  :: Maybe DefSetting -- ^ How to handle implicit `around`s
  , Cmd -> Maybe DefSetting
_oToken    :: Maybe DefSetting -- ^ How to emit the output
  , Cmd -> Maybe DefSetting
_iToken    :: Maybe DefSetting -- ^ How to capture the input
  }
  deriving Int -> Cmd -> ShowS
[Cmd] -> ShowS
Cmd -> String
(Int -> Cmd -> ShowS)
-> (Cmd -> String) -> ([Cmd] -> ShowS) -> Show Cmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cmd -> ShowS
showsPrec :: Int -> Cmd -> ShowS
$cshow :: Cmd -> String
show :: Cmd -> String
$cshowList :: [Cmd] -> ShowS
showList :: [Cmd] -> ShowS
Show
makeClassy ''Cmd

-- | Parse 'Cmd' from the evocation of this program
getCmd :: IO Cmd
getCmd :: IO Cmd
getCmd = ParserPrefs -> ParserInfo Cmd -> IO Cmd
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty) (ParserInfo Cmd -> IO Cmd) -> ParserInfo Cmd -> IO Cmd
forall a b. (a -> b) -> a -> b
$
  Parser Cmd -> InfoMod Cmd -> ParserInfo Cmd
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Cmd
cmdP Parser Cmd -> Parser (Cmd -> Cmd) -> Parser Cmd
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Cmd -> Cmd)
forall a. Parser (a -> a)
versioner Parser Cmd -> Parser (Cmd -> Cmd) -> Parser Cmd
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Cmd -> Cmd)
forall a. Parser (a -> a)
helper)
    (  InfoMod Cmd
forall a. InfoMod a
fullDesc
    InfoMod Cmd -> InfoMod Cmd -> InfoMod Cmd
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Cmd
forall a. String -> InfoMod a
progDesc String
"Start KMonad"
    InfoMod Cmd -> InfoMod Cmd -> InfoMod Cmd
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Cmd
forall a. String -> InfoMod a
header   String
"kmonad - an onion of buttons."
    )

-- | Equip a parser with version information about the program
versioner :: Parser (a -> a)
versioner :: forall a. Parser (a -> a)
versioner = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> String
showVersion Version
version String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", commit " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"?" $(gitHash))
  (  String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
  Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
  Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version"
  )

--------------------------------------------------------------------------------
-- $prs
--
-- The different command-line parsers

-- | Parse the full command
cmdP :: Parser Cmd
cmdP :: Parser Cmd
cmdP =
  String
-> Bool
-> LogLevel
-> Milliseconds
-> DefSetting
-> DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Cmd
Cmd (String
 -> Bool
 -> LogLevel
 -> Milliseconds
 -> DefSetting
 -> DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Cmd)
-> Parser String
-> Parser
     (Bool
      -> LogLevel
      -> Milliseconds
      -> DefSetting
      -> DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
fileP
      Parser
  (Bool
   -> LogLevel
   -> Milliseconds
   -> DefSetting
   -> DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser Bool
-> Parser
     (LogLevel
      -> Milliseconds
      -> DefSetting
      -> DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
dryrunP
      Parser
  (LogLevel
   -> Milliseconds
   -> DefSetting
   -> DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser LogLevel
-> Parser
     (Milliseconds
      -> DefSetting
      -> DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LogLevel
levelP
      Parser
  (Milliseconds
   -> DefSetting
   -> DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser Milliseconds
-> Parser
     (DefSetting
      -> DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Milliseconds
startDelayP
      Parser
  (DefSetting
   -> DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser DefSetting
-> Parser
     (DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefSetting
cmdAllowP
      Parser
  (DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser DefSetting
-> Parser
     (Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefSetting
fallThrghP
      Parser
  (Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser (Maybe DefSetting)
-> Parser
     (Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
cmpSeqP
      Parser
  (Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Maybe DefSetting
   -> Cmd)
-> Parser (Maybe DefSetting)
-> Parser
     (Maybe DefSetting
      -> Maybe DefSetting -> Maybe DefSetting -> Maybe DefSetting -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
cmpSeqDelayP
      Parser
  (Maybe DefSetting
   -> Maybe DefSetting -> Maybe DefSetting -> Maybe DefSetting -> Cmd)
-> Parser (Maybe DefSetting)
-> Parser
     (Maybe DefSetting -> Maybe DefSetting -> Maybe DefSetting -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
keySeqDelayP
      Parser
  (Maybe DefSetting -> Maybe DefSetting -> Maybe DefSetting -> Cmd)
-> Parser (Maybe DefSetting)
-> Parser (Maybe DefSetting -> Maybe DefSetting -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
implArndP
      Parser (Maybe DefSetting -> Maybe DefSetting -> Cmd)
-> Parser (Maybe DefSetting) -> Parser (Maybe DefSetting -> Cmd)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
oTokenP
      Parser (Maybe DefSetting -> Cmd)
-> Parser (Maybe DefSetting) -> Parser Cmd
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DefSetting)
iTokenP

-- | Parse a filename that points us at the config-file
fileP :: Parser FilePath
fileP :: Parser String
fileP = Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
  (  String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
  Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help    String
"The configuration file")

-- | Parse a flag that allows us to switch to parse-only mode
dryrunP :: Parser Bool
dryrunP :: Parser Bool
dryrunP = Mod FlagFields Bool -> Parser Bool
switch
  (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long    String
"dry-run"
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'd'
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help    String
"If used, do not start KMonad, only try parsing the config file"
  )


-- | Parse the log-level as either a level option or a verbose flag
levelP :: Parser LogLevel
levelP :: Parser LogLevel
levelP = ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM LogLevel
f
  (  String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => String -> Mod f a
long    String
"log-level"
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short   Char
'l'
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Log level"
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> LogLevel -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value   LogLevel
LevelWarn
  Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields LogLevel
forall (f :: * -> *) a. String -> Mod f a
help    String
"How much info to print out (debug, info, warn, error)" )
  where
    f :: ReadM LogLevel
f = (String -> Maybe LogLevel) -> ReadM LogLevel
forall a. (String -> Maybe a) -> ReadM a
maybeReader ((String -> Maybe LogLevel) -> ReadM LogLevel)
-> (String -> Maybe LogLevel) -> ReadM LogLevel
forall a b. (a -> b) -> a -> b
$ (String -> [(String, LogLevel)] -> Maybe LogLevel)
-> [(String, LogLevel)] -> String -> Maybe LogLevel
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [(String, LogLevel)] -> Maybe LogLevel
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [ (String
"debug", LogLevel
LevelDebug), (String
"warn", LogLevel
LevelWarn)
                                  , (String
"info",  LogLevel
LevelInfo),  (String
"error", LogLevel
LevelError) ]

-- | Allow the execution of arbitrary shell-commands
cmdAllowP :: Parser DefSetting
cmdAllowP :: Parser DefSetting
cmdAllowP = Bool -> DefSetting
SAllowCmd (Bool -> DefSetting) -> Parser Bool -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
  (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"allow-cmd"
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to allow the execution of arbitrary shell-commands"
  )

-- | Re-emit unhandled events
fallThrghP :: Parser DefSetting
fallThrghP :: Parser DefSetting
fallThrghP = Bool -> DefSetting
SFallThrough (Bool -> DefSetting) -> Parser Bool -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
  (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fallthrough"
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to simply re-emit unhandled events"
  )

-- | Key to use for compose-key sequences
cmpSeqP :: Parser (Maybe DefSetting)
cmpSeqP :: Parser (Maybe DefSetting)
cmpSeqP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ DefButton -> DefSetting
SCmpSeq (DefButton -> DefSetting) -> Parser DefButton -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM DefButton -> Mod OptionFields DefButton -> Parser DefButton
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
  ([(Text, Parser DefButton)] -> ReadM DefButton
forall a. [(Text, Parser a)] -> ReadM a
tokenParser [(Text, Parser DefButton)]
keywordButtons ReadM DefButton -> ReadM DefButton -> ReadM DefButton
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DefButton -> ReadM DefButton
forall a. Parser a -> ReadM a
megaReadM ([Parser DefButton] -> Parser DefButton
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Parser DefButton]
noKeywordButtons))
  (  String -> Mod OptionFields DefButton
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cmp-seq"
  Mod OptionFields DefButton
-> Mod OptionFields DefButton -> Mod OptionFields DefButton
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields DefButton
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
  Mod OptionFields DefButton
-> Mod OptionFields DefButton -> Mod OptionFields DefButton
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DefButton
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"BUTTON"
  Mod OptionFields DefButton
-> Mod OptionFields DefButton -> Mod OptionFields DefButton
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields DefButton
forall (f :: * -> *) a. String -> Mod f a
help String
"Which key to use to emit compose-key sequences"
  )

-- | Specify compose sequence key delays.
cmpSeqDelayP :: Parser (Maybe DefSetting)
cmpSeqDelayP :: Parser (Maybe DefSetting)
cmpSeqDelayP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ Int -> DefSetting
SCmpSeqDelay (Int -> DefSetting) -> Parser Int -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> ReadM Int -> ReadM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> ReadM Int
forall a. Parser a -> ReadM a
megaReadM Parser Int
numP)
  (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long  String
"cmp-seq-delay"
  Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TIME"
  Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help  String
"How many ms to wait between each key of a compose sequence"
  )

-- | Specify key event output delays.
keySeqDelayP :: Parser (Maybe DefSetting)
keySeqDelayP :: Parser (Maybe DefSetting)
keySeqDelayP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ Int -> DefSetting
SKeySeqDelay (Int -> DefSetting) -> Parser Int -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> ReadM Int -> ReadM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> ReadM Int
forall a. Parser a -> ReadM a
megaReadM Parser Int
numP)
  (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long  String
"key-seq-delay"
  Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TIME"
  Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help  String
"How many ms to wait between each key event outputted"
  )

-- | How to handle implicit `around`s
implArndP :: Parser (Maybe DefSetting)
implArndP :: Parser (Maybe DefSetting)
implArndP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ ImplArnd -> DefSetting
SImplArnd (ImplArnd -> DefSetting) -> Parser ImplArnd -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ImplArnd -> Mod OptionFields ImplArnd -> Parser ImplArnd
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
  ((String -> Maybe ImplArnd) -> ReadM ImplArnd
forall a. (String -> Maybe a) -> ReadM a
maybeReader ((String -> Maybe ImplArnd) -> ReadM ImplArnd)
-> (String -> Maybe ImplArnd) -> ReadM ImplArnd
forall a b. (a -> b) -> a -> b
$ \String
x -> [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
implArndButtons [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
-> Getting
     (First ImplArnd)
     [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
     ImplArnd
-> Maybe ImplArnd
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((Text, ImplArnd, DefButton -> DefButton -> DefButton)
 -> Const
      (First ImplArnd)
      (Text, ImplArnd, DefButton -> DefButton -> DefButton))
-> [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
-> Const
     (First ImplArnd)
     [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
  [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
each (((Text, ImplArnd, DefButton -> DefButton -> DefButton)
  -> Const
       (First ImplArnd)
       (Text, ImplArnd, DefButton -> DefButton -> DefButton))
 -> [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
 -> Const
      (First ImplArnd)
      [(Text, ImplArnd, DefButton -> DefButton -> DefButton)])
-> ((ImplArnd -> Const (First ImplArnd) ImplArnd)
    -> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
    -> Const
         (First ImplArnd)
         (Text, ImplArnd, DefButton -> DefButton -> DefButton))
-> Getting
     (First ImplArnd)
     [(Text, ImplArnd, DefButton -> DefButton -> DefButton)]
     ImplArnd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ImplArnd, DefButton -> DefButton -> DefButton) -> Bool)
-> ((Text, ImplArnd, DefButton -> DefButton -> DefButton)
    -> Const
         (First ImplArnd)
         (Text, ImplArnd, DefButton -> DefButton -> DefButton))
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
-> Const
     (First ImplArnd)
     (Text, ImplArnd, DefButton -> DefButton -> DefButton)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((Text, ImplArnd, DefButton -> DefButton -> DefButton)
    -> String)
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String)
-> ((Text, ImplArnd, DefButton -> DefButton -> DefButton) -> Text)
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  Text (Text, ImplArnd, DefButton -> DefButton -> DefButton) Text
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton) -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Text (Text, ImplArnd, DefButton -> DefButton -> DefButton) Text
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
  Text
  Text
_1) (((Text, ImplArnd, DefButton -> DefButton -> DefButton)
  -> Const
       (First ImplArnd)
       (Text, ImplArnd, DefButton -> DefButton -> DefButton))
 -> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
 -> Const
      (First ImplArnd)
      (Text, ImplArnd, DefButton -> DefButton -> DefButton))
-> ((ImplArnd -> Const (First ImplArnd) ImplArnd)
    -> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
    -> Const
         (First ImplArnd)
         (Text, ImplArnd, DefButton -> DefButton -> DefButton))
-> (ImplArnd -> Const (First ImplArnd) ImplArnd)
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
-> Const
     (First ImplArnd)
     (Text, ImplArnd, DefButton -> DefButton -> DefButton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImplArnd -> Const (First ImplArnd) ImplArnd)
-> (Text, ImplArnd, DefButton -> DefButton -> DefButton)
-> Const
     (First ImplArnd)
     (Text, ImplArnd, DefButton -> DefButton -> DefButton)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
  (Text, ImplArnd, DefButton -> DefButton -> DefButton)
  ImplArnd
  ImplArnd
_2)
  (  String -> Mod OptionFields ImplArnd
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"implicit-around"
  Mod OptionFields ImplArnd
-> Mod OptionFields ImplArnd -> Mod OptionFields ImplArnd
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ImplArnd
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ia"
  Mod OptionFields ImplArnd
-> Mod OptionFields ImplArnd -> Mod OptionFields ImplArnd
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ImplArnd
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"AROUND"
  Mod OptionFields ImplArnd
-> Mod OptionFields ImplArnd -> Mod OptionFields ImplArnd
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ImplArnd
forall (f :: * -> *) a. String -> Mod f a
help String
"How to translate implicit arounds (`A`, `S-a`)"
  )

-- | Where to emit the output
oTokenP :: Parser (Maybe DefSetting)
oTokenP :: Parser (Maybe DefSetting)
oTokenP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ OToken -> DefSetting
SOToken (OToken -> DefSetting) -> Parser OToken -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM OToken -> Mod OptionFields OToken -> Parser OToken
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ([(Text, Parser OToken)] -> ReadM OToken
forall a. [(Text, Parser a)] -> ReadM a
tokenParser [(Text, Parser OToken)]
otokens)
  (  String -> Mod OptionFields OToken
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output"
  Mod OptionFields OToken
-> Mod OptionFields OToken -> Mod OptionFields OToken
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields OToken
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
  Mod OptionFields OToken
-> Mod OptionFields OToken -> Mod OptionFields OToken
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OToken
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"OTOKEN"
  Mod OptionFields OToken
-> Mod OptionFields OToken -> Mod OptionFields OToken
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields OToken
forall (f :: * -> *) a. String -> Mod f a
help String
"Emit output to OTOKEN"
  )

-- | How to capture the keyboard input
iTokenP :: Parser (Maybe DefSetting)
iTokenP :: Parser (Maybe DefSetting)
iTokenP = Parser DefSetting -> Parser (Maybe DefSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DefSetting -> Parser (Maybe DefSetting))
-> Parser DefSetting -> Parser (Maybe DefSetting)
forall a b. (a -> b) -> a -> b
$ IToken -> DefSetting
SIToken (IToken -> DefSetting) -> Parser IToken -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM IToken -> Mod OptionFields IToken -> Parser IToken
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ([(Text, Parser IToken)] -> ReadM IToken
forall a. [(Text, Parser a)] -> ReadM a
tokenParser [(Text, Parser IToken)]
itokens)
  (  String -> Mod OptionFields IToken
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"input"
  Mod OptionFields IToken
-> Mod OptionFields IToken -> Mod OptionFields IToken
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields IToken
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
  Mod OptionFields IToken
-> Mod OptionFields IToken -> Mod OptionFields IToken
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IToken
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ITOKEN"
  Mod OptionFields IToken
-> Mod OptionFields IToken -> Mod OptionFields IToken
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields IToken
forall (f :: * -> *) a. String -> Mod f a
help String
"Capture input via ITOKEN"
  )

-- | Parse a flag that disables auto-releasing the release of enter
startDelayP :: Parser Milliseconds
startDelayP :: Parser Milliseconds
startDelayP = ReadM Milliseconds
-> Mod OptionFields Milliseconds -> Parser Milliseconds
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Milliseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Milliseconds) -> ReadM Int -> ReadM Milliseconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> ReadM Int
forall a. Parser a -> ReadM a
megaReadM Parser Int
numP)
  (  String -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. HasName f => String -> Mod f a
long  String
"start-delay"
  Mod OptionFields Milliseconds
-> Mod OptionFields Milliseconds -> Mod OptionFields Milliseconds
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'w'
  Mod OptionFields Milliseconds
-> Mod OptionFields Milliseconds -> Mod OptionFields Milliseconds
forall a. Semigroup a => a -> a -> a
<> Milliseconds -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Milliseconds
300
  Mod OptionFields Milliseconds
-> Mod OptionFields Milliseconds -> Mod OptionFields Milliseconds
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TIME"
  Mod OptionFields Milliseconds
-> Mod OptionFields Milliseconds -> Mod OptionFields Milliseconds
forall a. Semigroup a => a -> a -> a
<> (Milliseconds -> String) -> Mod OptionFields Milliseconds
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Milliseconds -> Int) -> Milliseconds -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds -> Int
unMS )
  Mod OptionFields Milliseconds
-> Mod OptionFields Milliseconds -> Mod OptionFields Milliseconds
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. String -> Mod f a
help  String
"How many ms to wait before grabbing the input keyboard (time to release enter if launching from terminal)")

-- | Transform a bunch of tokens of the form @(Keyword, Parser)@ into an
-- optparse-applicative parser
tokenParser :: [(Text, M.Parser a)] -> ReadM a
tokenParser :: forall a. [(Text, Parser a)] -> ReadM a
tokenParser = Parser a -> ReadM a
forall a. Parser a -> ReadM a
megaReadM (Parser a -> ReadM a)
-> ([(Text, Parser a)] -> Parser a)
-> [(Text, Parser a)]
-> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser a] -> Parser a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice ([Parser a] -> Parser a)
-> ([(Text, Parser a)] -> [Parser a])
-> [(Text, Parser a)]
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Parser a) -> Parser a) -> [(Text, Parser a)] -> [Parser a]
forall a b. (a -> b) -> [a] -> [b]
map (Parser a -> Parser a
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser a -> Parser a)
-> ((Text, Parser a) -> Parser a) -> (Text, Parser a) -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Parser a -> Parser a) -> (Text, Parser a) -> Parser a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ParsecT Void Text Identity () -> Parser a -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (ParsecT Void Text Identity () -> Parser a -> Parser a)
-> (Text -> ParsecT Void Text Identity ())
-> Text
-> Parser a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity ()
symbol))

-- | Megaparsec <--> optparse-applicative interface
megaReadM :: M.Parser a -> ReadM a
megaReadM :: forall a. Parser a -> ReadM a
megaReadM Parser a
p = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader ((ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show (Either (ParseErrorBundle Text Void) a -> Either String a)
-> (String -> Either (ParseErrorBundle Text Void) a)
-> String
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
M.parse Parser a
p String
"" (Text -> Either (ParseErrorBundle Text Void) a)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString)