{-|
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)
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 -> FilePath
_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
_initStr   :: Maybe DefSetting -- ^ TODO: What does this do?
  , Cmd -> Maybe DefSetting
_cmpSeq    :: Maybe DefSetting -- ^ Key to use for compose-key sequences
  , 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 -> FilePath
(Int -> Cmd -> ShowS)
-> (Cmd -> FilePath) -> ([Cmd] -> ShowS) -> Show Cmd
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cmd -> ShowS
showsPrec :: Int -> Cmd -> ShowS
$cshow :: Cmd -> FilePath
show :: Cmd -> FilePath
$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
<> FilePath -> InfoMod Cmd
forall a. FilePath -> InfoMod a
progDesc FilePath
"Start KMonad"
    InfoMod Cmd -> InfoMod Cmd -> InfoMod Cmd
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Cmd
forall a. FilePath -> InfoMod a
header   FilePath
"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 = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> FilePath
showVersion Version
version FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", commit " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> $(gitHash))
  (  FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version"
  )

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

-- | Parse the full command
cmdP :: Parser Cmd
cmdP :: Parser Cmd
cmdP =
  FilePath
-> Bool
-> LogLevel
-> Milliseconds
-> DefSetting
-> DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Maybe DefSetting
-> Cmd
Cmd (FilePath
 -> Bool
 -> LogLevel
 -> Milliseconds
 -> DefSetting
 -> DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Maybe DefSetting
 -> Cmd)
-> Parser FilePath
-> Parser
     (Bool
      -> LogLevel
      -> Milliseconds
      -> DefSetting
      -> DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Maybe DefSetting
      -> Cmd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
fileP
      Parser
  (Bool
   -> LogLevel
   -> Milliseconds
   -> DefSetting
   -> 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
      -> 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
   -> Cmd)
-> Parser LogLevel
-> Parser
     (Milliseconds
      -> DefSetting
      -> 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
   -> Cmd)
-> Parser Milliseconds
-> Parser
     (DefSetting
      -> 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
   -> Cmd)
-> Parser DefSetting
-> Parser
     (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
   -> Cmd)
-> Parser 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 DefSetting
fallThrghP
      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)
initStrP
      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)
cmpSeqP
      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 FilePath
fileP = Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
  (  FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
  Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"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
  (  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"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
  (  FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long    FilePath
"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
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"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
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. FilePath -> Mod f a
help    FilePath
"How much info to print out (debug, info, warn, error)" )
  where
    f :: ReadM LogLevel
f = (FilePath -> Maybe LogLevel) -> ReadM LogLevel
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader ((FilePath -> Maybe LogLevel) -> ReadM LogLevel)
-> (FilePath -> Maybe LogLevel) -> ReadM LogLevel
forall a b. (a -> b) -> a -> b
$ (FilePath -> [(FilePath, LogLevel)] -> Maybe LogLevel)
-> [(FilePath, LogLevel)] -> FilePath -> Maybe LogLevel
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [(FilePath, LogLevel)] -> Maybe LogLevel
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [ (FilePath
"debug", LogLevel
LevelDebug), (FilePath
"warn", LogLevel
LevelWarn)
                                  , (FilePath
"info",  LogLevel
LevelInfo),  (FilePath
"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
  (  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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
  (  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Whether to simply re-emit unhandled events"
  )

-- | TODO what does this do?
initStrP :: Parser (Maybe DefSetting)
initStrP :: Parser (Maybe DefSetting)
initStrP = 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
$ Text -> DefSetting
SInitStr (Text -> DefSetting) -> Parser Text -> Parser DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
  (  FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"init"
  Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
  Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING"
  Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"TODO"
  )

-- | 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))
  (  FilePath -> Mod OptionFields DefButton
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod OptionFields DefButton
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BUTTON"
  Mod OptionFields DefButton
-> Mod OptionFields DefButton -> Mod OptionFields DefButton
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields DefButton
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Which key to use to emit compose-key sequences"
  )

-- | 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)
  (  FilePath -> Mod OptionFields OToken
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod OptionFields OToken
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OTOKEN"
  Mod OptionFields OToken
-> Mod OptionFields OToken -> Mod OptionFields OToken
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields OToken
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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)
  (  FilePath -> Mod OptionFields IToken
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod OptionFields IToken
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"ITOKEN"
  Mod OptionFields IToken
-> Mod OptionFields IToken -> Mod OptionFields IToken
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields IToken
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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)
  (  FilePath -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long  FilePath
"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
<> (Milliseconds -> FilePath) -> Mod OptionFields Milliseconds
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath)
-> (Milliseconds -> Int) -> Milliseconds -> FilePath
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
<> FilePath -> Mod OptionFields Milliseconds
forall (f :: * -> *) a. FilePath -> Mod f a
help  FilePath
"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 = (FilePath -> Either FilePath a) -> ReadM a
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((ParseErrorBundle Text Void -> FilePath)
-> Either (ParseErrorBundle Text Void) a -> Either FilePath a
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft ParseErrorBundle Text Void -> FilePath
forall a. Show a => a -> FilePath
show (Either (ParseErrorBundle Text Void) a -> Either FilePath a)
-> (FilePath -> Either (ParseErrorBundle Text Void) a)
-> FilePath
-> Either FilePath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
M.parse Parser a
p FilePath
"" (Text -> Either (ParseErrorBundle Text Void) a)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. IsString a => FilePath -> a
fromString)