{-|
Module      : KMonad.Args.Parser
Description : How to turn a text-file into config-tokens
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)

We perform configuration parsing in 2 steps:
- 1. We turn the text-file into a token representation
- 2. We check the tokens and turn them into an AppCfg

This module covers step 1.

-}
module KMonad.Args.Parser
  ( -- * Parsing 'KExpr's
    parseTokens
  , loadTokens

  -- * Building Parsers
  , symbol
  , numP

  -- * Parsers for Tokens and Buttons
  , otokens
  , itokens
  , keywordButtons
  , noKeywordButtons
  )
where

import KMonad.Prelude hiding (try, bool)

import KMonad.Parsing
import KMonad.Args.Types
import KMonad.Keyboard
import KMonad.Keyboard.ComposeSeq



import Data.Char
import RIO.List (sortBy, find)


import qualified KMonad.Util.MultiMap as Q
import qualified RIO.Text as T
import qualified Text.Megaparsec.Char.Lexer as L


--------------------------------------------------------------------------------
-- $run

-- | Try to parse a list of 'KExpr' from 'Text'
parseTokens :: Text -> Either ParseError [KExpr]
parseTokens :: Text -> Either ParseError [KExpr]
parseTokens Text
t = case Parsec Void Text [KExpr]
-> String -> Text -> Either (ParseErrorBundle Text Void) [KExpr]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text [KExpr]
configP String
"" Text
t  of
  Left  ParseErrorBundle Text Void
e -> ParseError -> Either ParseError [KExpr]
forall a b. a -> Either a b
Left (ParseError -> Either ParseError [KExpr])
-> ParseError -> Either ParseError [KExpr]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> ParseError
ParseError ParseErrorBundle Text Void
e
  Right [KExpr]
x -> [KExpr] -> Either ParseError [KExpr]
forall a b. b -> Either a b
Right [KExpr]
x

-- | Load a set of tokens from file, throw an error on parse-fail
loadTokens :: FilePath -> RIO e [KExpr]
loadTokens :: forall e. String -> RIO e [KExpr]
loadTokens String
pth = (String -> RIO e Text
forall (m :: * -> *). MonadIO m => String -> m Text
readFileUtf8 String
pth RIO e Text
-> (Text -> Either ParseError [KExpr])
-> RIO e (Either ParseError [KExpr])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Either ParseError [KExpr]
parseTokens) RIO e (Either ParseError [KExpr])
-> (Either ParseError [KExpr] -> RIO e [KExpr]) -> RIO e [KExpr]
forall a b. RIO e a -> (a -> RIO e b) -> RIO e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ParseError
e   -> ParseError -> RIO e [KExpr]
forall e a. Exception e => e -> RIO e a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ParseError
e
  Right [KExpr]
xs -> [KExpr] -> RIO e [KExpr]
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [KExpr]
xs


--------------------------------------------------------------------------------
-- $basic

-- | Consume whitespace after the provided parser
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
sc

-- | Consume 1 symbol
symbol :: Text -> Parser ()
symbol :: Text -> ParsecT Void Text Identity ()
symbol = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void Text Identity ()
sc

-- | List of all characters that /end/ a word or sequence
terminators :: String
terminators :: String
terminators = String
")\""

terminatorP :: Parser Char
terminatorP :: Parser Char
terminatorP = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
terminators)

-- | Consume all chars until a space is encounterd
word :: Parser Text
word :: ParsecT Void Text Identity Text
word = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
wordChar)
  where wordChar :: Char -> Bool
wordChar Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
terminators)

-- | Run the parser IFF it is followed by a space, eof, or reserved char
terminated :: Parser a -> Parser a
terminated :: forall a. Parser a -> Parser a
terminated Parser a
p = Parser a -> Parser a
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Parser Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
terminatorP)

-- | Run the parser IFF it is not followed by a space or eof.
prefix :: Parser a -> Parser a
prefix :: forall a. Parser a -> Parser a
prefix Parser a
p = Parser a -> Parser a
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Parser Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

-- | Create a parser that matches symbols to values and only consumes on match.
fromNamed :: [(Text, a)] -> Parser a
fromNamed :: forall a. [(Text, a)] -> Parser a
fromNamed = [ParsecT Void Text Identity a] -> ParsecT Void Text Identity a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text Identity a] -> ParsecT Void Text Identity a)
-> ([(Text, a)] -> [ParsecT Void Text Identity a])
-> [(Text, a)]
-> ParsecT Void Text Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> ParsecT Void Text Identity a)
-> [(Text, a)] -> [ParsecT Void Text Identity a]
forall a b. (a -> b) -> [a] -> [b]
map (Text, a) -> ParsecT Void Text Identity a
forall {b}. (Text, b) -> ParsecT Void Text Identity b
mkOne ([(Text, a)] -> [ParsecT Void Text Identity a])
-> ([(Text, a)] -> [(Text, a)])
-> [(Text, a)]
-> [ParsecT Void Text Identity a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, a)] -> [(Text, a)]
forall b. [(Text, b)] -> [(Text, b)]
srt
  where
    -- | Sort descending by length of key and then alphabetically
    srt :: [(Text, b)] -> [(Text, b)]
    srt :: forall b. [(Text, b)] -> [(Text, b)]
srt = ((Text, b) -> (Text, b) -> Ordering) -> [(Text, b)] -> [(Text, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, b) -> (Text, b) -> Ordering)
 -> [(Text, b)] -> [(Text, b)])
-> ((Text -> Text -> Ordering)
    -> (Text, b) -> (Text, b) -> Ordering)
-> (Text -> Text -> Ordering)
-> [(Text, b)]
-> [(Text, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Text -> Ordering)
 -> ((Text, b) -> Text) -> (Text, b) -> (Text, b) -> Ordering)
-> ((Text, b) -> Text)
-> (Text -> Text -> Ordering)
-> (Text, b)
-> (Text, b)
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Text -> Ordering)
-> ((Text, b) -> Text) -> (Text, b) -> (Text, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (Text, b) -> Text
forall a b. (a, b) -> a
fst ((Text -> Text -> Ordering) -> [(Text, b)] -> [(Text, b)])
-> (Text -> Text -> Ordering) -> [(Text, b)] -> [(Text, b)]
forall a b. (a -> b) -> a -> b
$ \Text
a Text
b ->
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Int
T.length Text
b) (Text -> Int
T.length Text
a) of
        Ordering
EQ -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
        Ordering
x  -> Ordering
x

    -- | Make a parser that matches a terminated symbol or fails
    mkOne :: (Tokens Text, b) -> ParsecT Void Text Identity b
mkOne (Tokens Text
s, b
x) = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a. Parser a -> Parser a
terminated (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
s) ParsecT Void Text Identity (Tokens Text)
-> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
x

-- | Run a parser between 2 sets of parentheses
paren :: Parser a -> Parser a
paren :: forall a. Parser a -> Parser a
paren = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity ()
symbol Text
"(") (Text -> ParsecT Void Text Identity ()
symbol Text
")")

-- | Run a parser between 2 sets of parentheses starting with a symbol
statement :: Text -> Parser a -> Parser a
statement :: forall a. Text -> Parser a -> Parser a
statement Text
s = Parser a -> Parser a
forall a. Parser a -> Parser a
paren (Parser a -> Parser a)
-> (Parser a -> Parser a) -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ParsecT Void Text Identity ()
symbol Text
s 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
*>)

-- | Run a parser that parser a bool value
bool :: Parser Bool
bool :: Parser Bool
bool = (Text -> ParsecT Void Text Identity ()
symbol Text
"true"  ParsecT Void Text Identity () -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True)
   Parser Bool -> Parser Bool -> Parser Bool
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ParsecT Void Text Identity ()
symbol Text
"false" ParsecT Void Text Identity () -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)

-- | Parse a LISP-like keyword of the form @:keyword value@
keywordP :: Text -> Parser p -> Parser p
keywordP :: forall a. Text -> Parser a -> Parser a
keywordP Text
kw Parser p
p = Text -> ParsecT Void Text Identity ()
symbol (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kw) ParsecT Void Text Identity () -> Parser p -> Parser p
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
*> Parser p -> Parser p
forall a. Parser a -> Parser a
lexeme Parser p
p
  Parser p -> String -> Parser p
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Keyword " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
kw

--------------------------------------------------------------------------------
-- $elem
--
-- Parsers for elements that are not stand-alone KExpr's

-- | Parse a keycode
keycodeP :: Parser Keycode
keycodeP :: Parser Keycode
keycodeP = [(Text, Keycode)] -> Parser Keycode
forall a. [(Text, a)] -> Parser a
fromNamed (MultiMap Keycode Text -> MultiMap Text Keycode
forall k v. (CanMM k v, CanMM v k) => MultiMap k v -> MultiMap v k
Q.reverse MultiMap Keycode Text
keyNames MultiMap Text Keycode
-> Getting
     (Endo [(Text, Keycode)]) (MultiMap Text Keycode) (Text, Keycode)
-> [(Text, Keycode)]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting
  (Endo [(Text, Keycode)]) (MultiMap Text Keycode) (Text, Keycode)
forall k v. CanMM k v => Fold (MultiMap k v) (k, v)
Fold (MultiMap Text Keycode) (Text, Keycode)
Q.itemed) Parser Keycode -> String -> Parser Keycode
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"keycode"

-- | Parse an integer
numP :: Parser Int
numP :: Parser Int
numP = Parser Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

-- | Parse text with escaped characters between double quotes.
textP :: Parser Text
textP :: ParsecT Void Text Identity Text
textP = do
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"'
  String
s <- Parser Char -> Parser Char -> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"')
  Text -> ParsecT Void Text Identity Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParsecT Void Text Identity Text)
-> (String -> Text) -> String -> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> ParsecT Void Text Identity Text)
-> String -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String
s

-- | Parse a variable reference
derefP :: Parser Text
derefP :: ParsecT Void Text Identity Text
derefP = Parser Char -> Parser Char
forall a. Parser a -> Parser a
prefix (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@') Parser Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
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 Text
word

--------------------------------------------------------------------------------
-- $cmb
--
-- Parsers built up from the basic KExpr's

-- | Consume an entire file of expressions and comments
configP :: Parser [KExpr]
configP :: Parsec Void Text [KExpr]
configP = ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text [KExpr] -> Parsec Void Text [KExpr]
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
*> Parsec Void Text [KExpr]
exprsP Parsec Void Text [KExpr]
-> ParsecT Void Text Identity () -> Parsec Void Text [KExpr]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

-- | Parse 0 or more KExpr's
exprsP :: Parser [KExpr]
exprsP :: Parsec Void Text [KExpr]
exprsP = Parsec Void Text [KExpr] -> Parsec Void Text [KExpr]
forall a. Parser a -> Parser a
lexeme (Parsec Void Text [KExpr] -> Parsec Void Text [KExpr])
-> (ParsecT Void Text Identity KExpr -> Parsec Void Text [KExpr])
-> ParsecT Void Text Identity KExpr
-> Parsec Void Text [KExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity KExpr -> Parsec Void Text [KExpr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity KExpr -> Parsec Void Text [KExpr])
-> ParsecT Void Text Identity KExpr -> Parsec Void Text [KExpr]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity KExpr
exprP

-- | Parse 1 KExpr
exprP :: Parser KExpr
exprP :: ParsecT Void Text Identity KExpr
exprP = ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
forall a. Parser a -> Parser a
paren (ParsecT Void Text Identity KExpr
 -> ParsecT Void Text Identity KExpr)
-> ([ParsecT Void Text Identity KExpr]
    -> ParsecT Void Text Identity KExpr)
-> [ParsecT Void Text Identity KExpr]
-> ParsecT Void Text Identity KExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity KExpr]
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text Identity KExpr]
 -> ParsecT Void Text Identity KExpr)
-> [ParsecT Void Text Identity KExpr]
-> ParsecT Void Text Identity KExpr
forall a b. (a -> b) -> a -> b
$
  [ ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> ParsecT Void Text Identity ()
symbol Text
"defcfg")   ParsecT Void Text Identity ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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
*> (DefSettings -> KExpr
KDefCfg   (DefSettings -> KExpr)
-> ParsecT Void Text Identity DefSettings
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity DefSettings
defcfgP)
  , ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> ParsecT Void Text Identity ()
symbol Text
"defsrc")   ParsecT Void Text Identity ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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
*> (DefSrc -> KExpr
KDefSrc   (DefSrc -> KExpr)
-> ParsecT Void Text Identity DefSrc
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity DefSrc
defsrcP)
  , ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> ParsecT Void Text Identity ()
symbol Text
"deflayer") ParsecT Void Text Identity ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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
*> (DefLayer -> KExpr
KDefLayer (DefLayer -> KExpr)
-> ParsecT Void Text Identity DefLayer
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity DefLayer
deflayerP)
  , ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> ParsecT Void Text Identity ()
symbol Text
"defalias") ParsecT Void Text Identity ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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
*> ([(Text, DefButton)] -> KExpr
KDefAlias ([(Text, DefButton)] -> KExpr)
-> ParsecT Void Text Identity [(Text, DefButton)]
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [(Text, DefButton)]
defaliasP)
  ]

--------------------------------------------------------------------------------
-- $but
--
-- All the various ways to refer to buttons

-- | Different ways to refer to shifted versions of keycodes
shiftedNames :: [(Text, DefButton)]
shiftedNames :: [(Text, DefButton)]
shiftedNames = let f :: (a, Keycode) -> (a, DefButton)
f = (Keycode -> DefButton) -> (a, Keycode) -> (a, DefButton)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Keycode -> DefButton) -> (a, Keycode) -> (a, DefButton))
-> (Keycode -> DefButton) -> (a, Keycode) -> (a, DefButton)
forall a b. (a -> b) -> a -> b
$ \Keycode
kc -> DefButton -> DefButton -> DefButton
KAround (Keycode -> DefButton
KEmit Keycode
KeyLeftShift) (Keycode -> DefButton
KEmit Keycode
kc) in
                 ((Text, Keycode) -> (Text, DefButton))
-> [(Text, Keycode)] -> [(Text, DefButton)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Keycode) -> (Text, DefButton)
forall {a}. (a, Keycode) -> (a, DefButton)
f ([(Text, Keycode)] -> [(Text, DefButton)])
-> [(Text, Keycode)] -> [(Text, DefButton)]
forall a b. (a -> b) -> a -> b
$ [(Text, Keycode)]
cps [(Text, Keycode)] -> [(Text, Keycode)] -> [(Text, Keycode)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Keycode)]
num [(Text, Keycode)] -> [(Text, Keycode)] -> [(Text, Keycode)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Keycode)]
oth [(Text, Keycode)] -> [(Text, Keycode)] -> [(Text, Keycode)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Keycode)]
lng
  where
    cps :: [(Text, Keycode)]
cps = [Text] -> DefSrc -> [(Text, Keycode)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A'..Char
'Z'])
          [ Keycode
KeyA, Keycode
KeyB, Keycode
KeyC, Keycode
KeyD, Keycode
KeyE, Keycode
KeyF, Keycode
KeyG, Keycode
KeyH, Keycode
KeyI, Keycode
KeyJ, Keycode
KeyK, Keycode
KeyL, Keycode
KeyM,
            Keycode
KeyN, Keycode
KeyO, Keycode
KeyP, Keycode
KeyQ, Keycode
KeyR, Keycode
KeyS, Keycode
KeyT, Keycode
KeyU, Keycode
KeyV, Keycode
KeyW, Keycode
KeyX, Keycode
KeyY, Keycode
KeyZ ]
    num :: [(Text, Keycode)]
num = [Text] -> DefSrc -> [(Text, Keycode)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton String
"!@#$%^&*")
          [ Keycode
Key1, Keycode
Key2, Keycode
Key3, Keycode
Key4, Keycode
Key5, Keycode
Key6, Keycode
Key7, Keycode
Key8 ]
    oth :: [(Text, Keycode)]
oth = [Text] -> DefSrc -> [(Text, Keycode)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton String
"<>:~\"|{}+?")
          [ Keycode
KeyComma, Keycode
KeyDot, Keycode
KeySemicolon, Keycode
KeyGrave, Keycode
KeyApostrophe, Keycode
KeyBackslash
          , Keycode
KeyLeftBrace, Keycode
KeyRightBrace, Keycode
KeyEqual, Keycode
KeySlash]
    lng :: [(Text, Keycode)]
lng = [ (Text
"quot", Keycode
KeyApostrophe), (Text
"pipe", Keycode
KeyBackslash), (Text
"cln", Keycode
KeySemicolon)
          , (Text
"tild", Keycode
KeyGrave) , (Text
"udrs", Keycode
KeyMinus)]

-- | Names for various buttons
buttonNames :: [(Text, DefButton)]
buttonNames :: [(Text, DefButton)]
buttonNames = [(Text, DefButton)]
shiftedNames [(Text, DefButton)] -> [(Text, DefButton)] -> [(Text, DefButton)]
forall a. Semigroup a => a -> a -> a
<> [(Text, DefButton)]
escp [(Text, DefButton)] -> [(Text, DefButton)] -> [(Text, DefButton)]
forall a. Semigroup a => a -> a -> a
<> [(Text, DefButton)]
util
  where
    emitS :: Keycode -> DefButton
emitS Keycode
c = DefButton -> DefButton -> DefButton
KAround (Keycode -> DefButton
KEmit Keycode
KeyLeftShift) (Keycode -> DefButton
KEmit Keycode
c)
    -- Escaped versions for reserved characters
    escp :: [(Text, DefButton)]
escp = [ (Text
"\\(", Keycode -> DefButton
emitS Keycode
Key9), (Text
"\\)", Keycode -> DefButton
emitS Keycode
Key0)
           , (Text
"\\_", Keycode -> DefButton
emitS Keycode
KeyMinus), (Text
"\\\\", Keycode -> DefButton
KEmit Keycode
KeyBackslash)]
    -- Extra names for useful buttons
    util :: [(Text, DefButton)]
util = [ (Text
"_", DefButton
KTrans), (Text
"XX", DefButton
KBlock)
           , (Text
"lprn", Keycode -> DefButton
emitS Keycode
Key9), (Text
"rprn", Keycode -> DefButton
emitS Keycode
Key0)]



-- | Parse "X-b" style modded-sequences
moddedP :: Parser DefButton
moddedP :: Parser DefButton
moddedP = DefButton -> DefButton -> DefButton
KAround (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
prfx ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  where mods :: [(Tokens Text, Keycode)]
mods = [ (Tokens Text
"S-", Keycode
KeyLeftShift), (Tokens Text
"C-", Keycode
KeyLeftCtrl)
               , (Tokens Text
"A-", Keycode
KeyLeftAlt),   (Tokens Text
"M-", Keycode
KeyLeftMeta)
               , (Tokens Text
"RS-", Keycode
KeyRightShift), (Tokens Text
"RC-", Keycode
KeyRightCtrl)
               , (Tokens Text
"RA-", Keycode
KeyRightAlt),   (Tokens Text
"RM-", Keycode
KeyRightMeta)]
        prfx :: Parser DefButton
prfx = [Parser DefButton] -> Parser DefButton
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser DefButton] -> Parser DefButton)
-> [Parser DefButton] -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ ((Tokens Text, Keycode) -> Parser DefButton)
-> [(Tokens Text, Keycode)] -> [Parser DefButton]
forall a b. (a -> b) -> [a] -> [b]
map (\(Tokens Text
t, Keycode
p) -> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a. Parser a -> Parser a
prefix (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
t) ParsecT Void Text Identity (Tokens Text)
-> DefButton -> Parser DefButton
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Keycode -> DefButton
KEmit Keycode
p) [(Tokens Text, Keycode)]
mods

-- | Parse Pxxx as pauses (useful in macros)
pauseP :: Parser DefButton
pauseP :: Parser DefButton
pauseP = Milliseconds -> DefButton
KPause (Milliseconds -> DefButton)
-> (Int -> Milliseconds) -> Int -> DefButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Milliseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DefButton) -> Parser Int -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'P' Parser Char -> Parser Int -> Parser Int
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
*> Parser Int
numP)

-- | #()-syntax tap-macro
rmTapMacroP :: Parser DefButton
rmTapMacroP :: Parser DefButton
rmTapMacroP =
  Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' Parser Char -> Parser DefButton -> Parser DefButton
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
*> Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
paren ([DefButton] -> Maybe Int -> DefButton
KTapMacro ([DefButton] -> Maybe Int -> DefButton)
-> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity (Maybe Int -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser DefButton
buttonP
                               ParsecT Void Text Identity (Maybe Int -> DefButton)
-> ParsecT Void Text Identity (Maybe Int) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Int -> Parser Int
forall a. Text -> Parser a -> Parser a
keywordP Text
"delay" Parser Int
numP))

-- | Compose-key sequence
composeSeqP :: Parser [DefButton]
composeSeqP :: ParsecT Void Text Identity [DefButton]
composeSeqP = do
  -- Lookup 1 character in the compose-seq list
  Char
c <- Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle Parser Char -> String -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"special character"
  Text
s <- case ((Text, Char, Text) -> Bool)
-> [(Text, Char, Text)] -> Maybe (Text, Char, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Text
_, Char
c', Text
_) -> Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) [(Text, Char, Text)]
ssComposed of
         Maybe (Text, Char, Text)
Nothing -> String -> ParsecT Void Text Identity Text
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unrecognized compose-char"
         Just (Text, Char, Text)
b  -> Text -> ParsecT Void Text Identity Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ (Text, Char, Text)
b(Text, Char, Text) -> Getting Text (Text, Char, Text) Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text (Text, Char, Text) Text
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Text, Char, Text) (Text, Char, Text) Text Text
_1

  -- If matching, parse a button-sequence from the stored text
  case ParsecT Void Text Identity [DefButton]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [DefButton]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser DefButton
buttonP) String
"" Text
s of
    Left  ParseErrorBundle Text Void
_ -> String -> ParsecT Void Text Identity [DefButton]
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse compose sequence"
    Right [DefButton]
b -> [DefButton] -> ParsecT Void Text Identity [DefButton]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DefButton]
b

-- | Parse a dead-key sequence as a `+` followed by some symbol
deadkeySeqP :: Parser [DefButton]
deadkeySeqP :: ParsecT Void Text Identity [DefButton]
deadkeySeqP = do
  Char
_ <- Parser Char -> Parser Char
forall a. Parser a -> Parser a
prefix (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+')
  Char
c <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"~'^`\"," :: String))
  case Parser DefButton
-> String -> Text -> Either (ParseErrorBundle Text Void) DefButton
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser DefButton
buttonP String
"" (Char -> Text
T.singleton Char
c) of
    Left  ParseErrorBundle Text Void
_ -> String -> ParsecT Void Text Identity [DefButton]
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse deadkey sequence"
    Right DefButton
b -> [DefButton] -> ParsecT Void Text Identity [DefButton]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DefButton
b]

-- | Parse any button
buttonP :: Parser DefButton
buttonP :: Parser DefButton
buttonP = (Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> Parser DefButton)
-> ([Parser DefButton] -> Parser DefButton)
-> [Parser DefButton]
-> Parser DefButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser DefButton] -> Parser DefButton
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser DefButton] -> Parser DefButton)
-> ([Parser DefButton] -> [Parser DefButton])
-> [Parser DefButton]
-> Parser DefButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser DefButton -> Parser DefButton)
-> [Parser DefButton] -> [Parser DefButton]
forall a b. (a -> b) -> [a] -> [b]
map Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser DefButton] -> Parser DefButton)
-> [Parser DefButton] -> Parser DefButton
forall a b. (a -> b) -> a -> b
$
  ((Text, Parser DefButton) -> Parser DefButton)
-> [(Text, Parser DefButton)] -> [Parser DefButton]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Parser DefButton -> Parser DefButton)
-> (Text, Parser DefButton) -> Parser DefButton
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement) [(Text, Parser DefButton)]
keywordButtons [Parser DefButton] -> [Parser DefButton] -> [Parser DefButton]
forall a. [a] -> [a] -> [a]
++ [Parser DefButton]
noKeywordButtons
  ) Parser DefButton -> String -> Parser DefButton
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"button"

-- | Parsers for buttons that have a keyword at the start; the format is
-- @(keyword, how to parse the token)@
keywordButtons :: [(Text, Parser DefButton)]
keywordButtons :: [(Text, Parser DefButton)]
keywordButtons =
  [ (Text
"around"         , DefButton -> DefButton -> DefButton
KAround      (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP     ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"press-only"     , Keycode -> DefButton
KPressOnly   (Keycode -> DefButton) -> Parser Keycode -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Keycode
keycodeP)
  , (Text
"release-only"   , Keycode -> DefButton
KReleaseOnly (Keycode -> DefButton) -> Parser Keycode -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Keycode
keycodeP)
  , (Text
"multi-tap"      , [(Int, DefButton)] -> DefButton -> DefButton
KMultiTap    ([(Int, DefButton)] -> DefButton -> DefButton)
-> ParsecT Void Text Identity [(Int, DefButton)]
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [(Int, DefButton)]
timed       ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"tap-hold"       , Int -> DefButton -> DefButton -> DefButton
KTapHold     (Int -> DefButton -> DefButton -> DefButton)
-> Parser Int
-> ParsecT Void Text Identity (DefButton -> DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"tap-hold-next"
    , Int -> DefButton -> DefButton -> Maybe DefButton -> DefButton
KTapHoldNext (Int -> DefButton -> DefButton -> Maybe DefButton -> DefButton)
-> Parser Int
-> ParsecT
     Void
     Text
     Identity
     (DefButton -> DefButton -> Maybe DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT
  Void
  Text
  Identity
  (DefButton -> DefButton -> Maybe DefButton -> DefButton)
-> Parser DefButton
-> ParsecT
     Void Text Identity (DefButton -> Maybe DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP ParsecT
  Void Text Identity (DefButton -> Maybe DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (Maybe DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
                   ParsecT Void Text Identity (Maybe DefButton -> DefButton)
-> ParsecT Void Text Identity (Maybe DefButton) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton -> ParsecT Void Text Identity (Maybe DefButton)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
keywordP Text
"timeout-button" Parser DefButton
buttonP))
  , (Text
"tap-next-release"
    , DefButton -> DefButton -> DefButton
KTapNextRelease (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"tap-hold-next-release"
    , Int -> DefButton -> DefButton -> Maybe DefButton -> DefButton
KTapHoldNextRelease (Int -> DefButton -> DefButton -> Maybe DefButton -> DefButton)
-> Parser Int
-> ParsecT
     Void
     Text
     Identity
     (DefButton -> DefButton -> Maybe DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT
  Void
  Text
  Identity
  (DefButton -> DefButton -> Maybe DefButton -> DefButton)
-> Parser DefButton
-> ParsecT
     Void Text Identity (DefButton -> Maybe DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP ParsecT
  Void Text Identity (DefButton -> Maybe DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (Maybe DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
                          ParsecT Void Text Identity (Maybe DefButton -> DefButton)
-> ParsecT Void Text Identity (Maybe DefButton) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton -> ParsecT Void Text Identity (Maybe DefButton)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
keywordP Text
"timeout-button" Parser DefButton
buttonP))
  , (Text
"tap-next-press"
    , DefButton -> DefButton -> DefButton
KTapNextPress (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"tap-next"       , DefButton -> DefButton -> DefButton
KTapNext     (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP     ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"layer-toggle"   , Text -> DefButton
KLayerToggle (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"momentary-layer" , Text -> DefButton
KLayerToggle (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"layer-switch"    , Text -> DefButton
KLayerSwitch (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"permanent-layer" , Text -> DefButton
KLayerSwitch (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"layer-add"      , Text -> DefButton
KLayerAdd    (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"layer-rem"      , Text -> DefButton
KLayerRem    (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"layer-delay"    , Int -> Text -> DefButton
KLayerDelay  (Int -> Text -> DefButton)
-> Parser Int -> ParsecT Void Text Identity (Text -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"layer-next"     , Text -> DefButton
KLayerNext   (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word)
  , (Text
"around-next"    , DefButton -> DefButton
KAroundNext  (DefButton -> DefButton) -> Parser DefButton -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP)
  , (Text
"before-after-next", DefButton -> DefButton -> DefButton
KBeforeAfterNext (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefButton
buttonP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"around-next-timeout", Int -> DefButton -> DefButton -> DefButton
KAroundNextTimeout (Int -> DefButton -> DefButton -> DefButton)
-> Parser Int
-> ParsecT Void Text Identity (DefButton -> DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (DefButton -> DefButton -> DefButton)
-> Parser DefButton
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  , (Text
"tap-macro"
    , [DefButton] -> Maybe Int -> DefButton
KTapMacro ([DefButton] -> Maybe Int -> DefButton)
-> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity (Maybe Int -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity [DefButton]
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser DefButton
buttonP) ParsecT Void Text Identity (Maybe Int -> DefButton)
-> ParsecT Void Text Identity (Maybe Int) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Int -> Parser Int
forall a. Text -> Parser a -> Parser a
keywordP Text
"delay" Parser Int
numP))
  , (Text
"tap-macro-release"
    , [DefButton] -> Maybe Int -> DefButton
KTapMacroRelease ([DefButton] -> Maybe Int -> DefButton)
-> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity (Maybe Int -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity [DefButton]
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser DefButton
buttonP) ParsecT Void Text Identity (Maybe Int -> DefButton)
-> ParsecT Void Text Identity (Maybe Int) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Int -> Parser Int
forall a. Text -> Parser a -> Parser a
keywordP Text
"delay" Parser Int
numP))
  , (Text
"cmd-button"     , Text -> Maybe Text -> DefButton
KCommand     (Text -> Maybe Text -> DefButton)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
textP ParsecT Void Text Identity (Maybe Text -> DefButton)
-> ParsecT Void Text Identity (Maybe Text) -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
textP))
  , (Text
"pause"          , Milliseconds -> DefButton
KPause (Milliseconds -> DefButton)
-> (Int -> Milliseconds) -> Int -> DefButton
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Milliseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DefButton) -> Parser Int -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
numP)
  , (Text
"sticky-key"     , Int -> DefButton -> DefButton
KStickyKey   (Int -> DefButton -> DefButton)
-> Parser Int
-> ParsecT Void Text Identity (DefButton -> DefButton)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (DefButton -> DefButton)
-> Parser DefButton -> Parser DefButton
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP)
  ]
 where
  timed :: Parser [(Int, DefButton)]
  timed :: ParsecT Void Text Identity [(Int, DefButton)]
timed = ParsecT Void Text Identity (Int, DefButton)
-> ParsecT Void Text Identity [(Int, DefButton)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((,) (Int -> DefButton -> (Int, DefButton))
-> Parser Int
-> ParsecT Void Text Identity (DefButton -> (Int, DefButton))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (DefButton -> (Int, DefButton))
-> Parser DefButton -> ParsecT Void Text Identity (Int, DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme Parser DefButton
buttonP)

-- | Parsers for buttons that do __not__ have a keyword at the start
noKeywordButtons :: [Parser DefButton]
noKeywordButtons :: [Parser DefButton]
noKeywordButtons =
  [ [DefButton] -> DefButton
KComposeSeq ([DefButton] -> DefButton)
-> ParsecT Void Text Identity [DefButton] -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [DefButton]
deadkeySeqP
  , Text -> DefButton
KRef  (Text -> DefButton)
-> ParsecT Void Text Identity Text -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
derefP
  , Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ [(Text, DefButton)] -> Parser DefButton
forall a. [(Text, a)] -> Parser a
fromNamed [(Text, DefButton)]
buttonNames
  , Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser DefButton
moddedP
  , Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser DefButton
rmTapMacroP
  , Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser DefButton
pauseP
  , Keycode -> DefButton
KEmit (Keycode -> DefButton) -> Parser Keycode -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Keycode
keycodeP
  , [DefButton] -> DefButton
KComposeSeq ([DefButton] -> DefButton)
-> ParsecT Void Text Identity [DefButton] -> Parser DefButton
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [DefButton]
composeSeqP
  ]

--------------------------------------------------------------------------------
-- $defcfg

-- | Parse an input token
itokenP :: Parser IToken
itokenP :: Parser IToken
itokenP = [Parser IToken] -> Parser IToken
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser IToken] -> Parser IToken)
-> [Parser IToken] -> Parser IToken
forall a b. (a -> b) -> a -> b
$ ((Text, Parser IToken) -> Parser IToken)
-> [(Text, Parser IToken)] -> [Parser IToken]
forall a b. (a -> b) -> [a] -> [b]
map (Parser IToken -> Parser IToken
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser IToken -> Parser IToken)
-> ((Text, Parser IToken) -> Parser IToken)
-> (Text, Parser IToken)
-> Parser IToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Parser IToken -> Parser IToken)
-> (Text, Parser IToken) -> Parser IToken
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Parser IToken -> Parser IToken
forall a. Text -> Parser a -> Parser a
statement) [(Text, Parser IToken)]
itokens

-- | Input tokens to parse; the format is @(keyword, how to parse the token)@
itokens :: [(Text, Parser IToken)]
itokens :: [(Text, Parser IToken)]
itokens =
  [ (Text
"device-file"   , String -> IToken
KDeviceSource (String -> IToken)
-> ParsecT Void Text Identity String -> Parser IToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> String
T.unpack (Text -> String)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
textP))
  , (Text
"low-level-hook", IToken -> Parser IToken
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IToken
KLowLevelHookSource)
  , (Text
"iokit-name"    , Maybe Text -> IToken
KIOKitSource (Maybe Text -> IToken)
-> ParsecT Void Text Identity (Maybe Text) -> Parser IToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
textP)]

-- | Parse an output token
otokenP :: Parser OToken
otokenP :: Parser OToken
otokenP = [Parser OToken] -> Parser OToken
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser OToken] -> Parser OToken)
-> [Parser OToken] -> Parser OToken
forall a b. (a -> b) -> a -> b
$ ((Text, Parser OToken) -> Parser OToken)
-> [(Text, Parser OToken)] -> [Parser OToken]
forall a b. (a -> b) -> [a] -> [b]
map (Parser OToken -> Parser OToken
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser OToken -> Parser OToken)
-> ((Text, Parser OToken) -> Parser OToken)
-> (Text, Parser OToken)
-> Parser OToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Parser OToken -> Parser OToken)
-> (Text, Parser OToken) -> Parser OToken
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Parser OToken -> Parser OToken
forall a. Text -> Parser a -> Parser a
statement) [(Text, Parser OToken)]
otokens

-- | Output tokens to parse; the format is @(keyword, how to parse the token)@
otokens :: [(Text, Parser OToken)]
otokens :: [(Text, Parser OToken)]
otokens =
  [ (Text
"uinput-sink"    , Text -> Maybe Text -> OToken
KUinputSink (Text -> Maybe Text -> OToken)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text -> OToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
textP ParsecT Void Text Identity (Maybe Text -> OToken)
-> ParsecT Void Text Identity (Maybe Text) -> Parser OToken
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
textP)
  , (Text
"send-event-sink", Maybe (Int, Int) -> OToken
KSendEventSink (Maybe (Int, Int) -> OToken)
-> ParsecT Void Text Identity (Maybe (Int, Int)) -> Parser OToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Int, Int)
-> ParsecT Void Text Identity (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,) (Int -> Int -> (Int, Int))
-> Parser Int -> ParsecT Void Text Identity (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int -> Parser Int
forall a. Parser a -> Parser a
lexeme Parser Int
numP ParsecT Void Text Identity (Int -> (Int, Int))
-> Parser Int -> ParsecT Void Text Identity (Int, Int)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
numP))
  , (Text
"kext"           , OToken -> Parser OToken
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OToken
KKextSink)]

-- | Parse the DefCfg token
defcfgP :: Parser DefSettings
defcfgP :: ParsecT Void Text Identity DefSettings
defcfgP = ParsecT Void Text Identity DefSetting
-> ParsecT Void Text Identity DefSettings
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity DefSetting
-> ParsecT Void Text Identity DefSetting
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity DefSetting
settingP)

-- | All possible configuration options that can be passed in the defcfg block
settingP :: Parser DefSetting
settingP :: ParsecT Void Text Identity DefSetting
settingP = let f :: Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
f Text
s ParsecT Void Text Identity b
p = Text -> ParsecT Void Text Identity ()
symbol Text
s ParsecT Void Text Identity ()
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
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 b
p in
  (ParsecT Void Text Identity DefSetting
-> ParsecT Void Text Identity DefSetting
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity DefSetting
 -> ParsecT Void Text Identity DefSetting)
-> ([ParsecT Void Text Identity DefSetting]
    -> ParsecT Void Text Identity DefSetting)
-> [ParsecT Void Text Identity DefSetting]
-> ParsecT Void Text Identity DefSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity DefSetting]
-> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text Identity DefSetting]
 -> ParsecT Void Text Identity DefSetting)
-> ([ParsecT Void Text Identity DefSetting]
    -> [ParsecT Void Text Identity DefSetting])
-> [ParsecT Void Text Identity DefSetting]
-> ParsecT Void Text Identity DefSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsecT Void Text Identity DefSetting
 -> ParsecT Void Text Identity DefSetting)
-> [ParsecT Void Text Identity DefSetting]
-> [ParsecT Void Text Identity DefSetting]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT Void Text Identity DefSetting
-> ParsecT Void Text Identity DefSetting
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([ParsecT Void Text Identity DefSetting]
 -> ParsecT Void Text Identity DefSetting)
-> [ParsecT Void Text Identity DefSetting]
-> ParsecT Void Text Identity DefSetting
forall a b. (a -> b) -> a -> b
$
    [ IToken -> DefSetting
SIToken      (IToken -> DefSetting)
-> Parser IToken -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser IToken -> Parser IToken
forall a. Text -> Parser a -> Parser a
f Text
"input"         Parser IToken
itokenP
    , OToken -> DefSetting
SOToken      (OToken -> DefSetting)
-> Parser OToken -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser OToken -> Parser OToken
forall a. Text -> Parser a -> Parser a
f Text
"output"        Parser OToken
otokenP
    , DefButton -> DefSetting
SCmpSeq      (DefButton -> DefSetting)
-> Parser DefButton -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
f Text
"cmp-seq"       Parser DefButton
buttonP
    , Text -> DefSetting
SInitStr     (Text -> DefSetting)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Text -> Parser a -> Parser a
f Text
"init"          ParsecT Void Text Identity Text
textP
    , Bool -> DefSetting
SFallThrough (Bool -> DefSetting)
-> Parser Bool -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Bool -> Parser Bool
forall a. Text -> Parser a -> Parser a
f Text
"fallthrough"   Parser Bool
bool
    , Bool -> DefSetting
SAllowCmd    (Bool -> DefSetting)
-> Parser Bool -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Bool -> Parser Bool
forall a. Text -> Parser a -> Parser a
f Text
"allow-cmd"     Parser Bool
bool
    , Int -> DefSetting
SCmpSeqDelay (Int -> DefSetting)
-> Parser Int -> ParsecT Void Text Identity DefSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Int -> Parser Int
forall a. Text -> Parser a -> Parser a
f Text
"cmp-seq-delay" Parser Int
numP
    ])

--------------------------------------------------------------------------------
-- $defalias

-- | Parse a collection of names and buttons
defaliasP :: Parser DefAlias
defaliasP :: ParsecT Void Text Identity [(Text, DefButton)]
defaliasP = ParsecT Void Text Identity (Text, DefButton)
-> ParsecT Void Text Identity [(Text, DefButton)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity (Text, DefButton)
 -> ParsecT Void Text Identity [(Text, DefButton)])
-> ParsecT Void Text Identity (Text, DefButton)
-> ParsecT Void Text Identity [(Text, DefButton)]
forall a b. (a -> b) -> a -> b
$ (,) (Text -> DefButton -> (Text, DefButton))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (DefButton -> (Text, DefButton))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word ParsecT Void Text Identity (DefButton -> (Text, DefButton))
-> Parser DefButton -> ParsecT Void Text Identity (Text, DefButton)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP

--------------------------------------------------------------------------------
-- $defsrc

defsrcP :: Parser DefSrc
defsrcP :: ParsecT Void Text Identity DefSrc
defsrcP = Parser Keycode -> ParsecT Void Text Identity DefSrc
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Keycode -> ParsecT Void Text Identity DefSrc)
-> Parser Keycode -> ParsecT Void Text Identity DefSrc
forall a b. (a -> b) -> a -> b
$ Parser Keycode -> Parser Keycode
forall a. Parser a -> Parser a
lexeme Parser Keycode
keycodeP


--------------------------------------------------------------------------------
-- $deflayer
deflayerP :: Parser DefLayer
deflayerP :: ParsecT Void Text Identity DefLayer
deflayerP = Text -> [DefButton] -> DefLayer
DefLayer (Text -> [DefButton] -> DefLayer)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([DefButton] -> DefLayer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Text
word ParsecT Void Text Identity ([DefButton] -> DefLayer)
-> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity DefLayer
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser DefButton -> Parser DefButton
forall a. Parser a -> Parser a
lexeme Parser DefButton
buttonP)