{-|
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
  ( parseTokens
  , loadTokens
  )
where

import KMonad.Prelude hiding (try, bool)

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

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


import qualified Data.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 PErrors [KExpr]
parseTokens :: Text -> Either PErrors [KExpr]
parseTokens t :: 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 "" Text
t  of
  Left  e :: ParseErrorBundle Text Void
e -> PErrors -> Either PErrors [KExpr]
forall a b. a -> Either a b
Left (PErrors -> Either PErrors [KExpr])
-> PErrors -> Either PErrors [KExpr]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> PErrors
PErrors ParseErrorBundle Text Void
e
  Right x :: [KExpr]
x -> [KExpr] -> Either PErrors [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 :: String -> RIO e [KExpr]
loadTokens pth :: String
pth = Text -> Either PErrors [KExpr]
parseTokens (Text -> Either PErrors [KExpr])
-> RIO e Text -> RIO e (Either PErrors [KExpr])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO e Text
forall (m :: * -> *). MonadIO m => String -> m Text
readFileUtf8 String
pth RIO e (Either PErrors [KExpr])
-> (Either PErrors [KExpr] -> RIO e [KExpr]) -> RIO e [KExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left e :: PErrors
e   -> PErrors -> RIO e [KExpr]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM PErrors
e
  Right xs :: [KExpr]
xs -> [KExpr] -> RIO e [KExpr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [KExpr]
xs


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

-- | Consume whitespace
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space
  Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
  (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment  ";;")
  (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment "#|" "|#")

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

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

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

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 (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 c :: Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> 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 :: Parser a -> Parser a
terminated p :: Parser a
p = 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 -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char -> Parser ()
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 :: Parser a -> Parser a
prefix p :: Parser a
p = 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 -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
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 :: [(Text, a)] -> Parser a
fromNamed = [Parser a] -> Parser a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser a] -> Parser a)
-> ([(Text, a)] -> [Parser a]) -> [(Text, a)] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> Parser a) -> [(Text, a)] -> [Parser a]
forall a b. (a -> b) -> [a] -> [b]
map (Text, a) -> Parser a
forall b. (Text, b) -> ParsecT Void Text Identity b
mkOne ([(Text, a)] -> [Parser a])
-> ([(Text, a)] -> [(Text, a)]) -> [(Text, a)] -> [Parser 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 :: [(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
$ \a :: Text
a b :: 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
        EQ -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
        x :: Ordering
x  -> Ordering
x

    -- | Make a parser that matches a terminated symbol or fails
    mkOne :: (Text, b) -> ParsecT Void Text Identity b
mkOne (s :: Text
s, x :: b
x) = ParsecT Void Text Identity Text -> ParsecT Void Text Identity 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 Text
Tokens Text
s) ParsecT Void Text Identity Text
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x

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

-- | Run a parser between 2 sets of parentheses starting with a symbol
statement :: Text -> Parser a -> Parser a
statement :: Text -> Parser a -> Parser a
statement s :: 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 -> Parser ()
symbol Text
s Parser () -> Parser a -> Parser a
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 -> Parser ()
symbol "true" Parser () -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
   Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
symbol "false" Parser () -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

--------------------------------------------------------------------------------
-- $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)
Q.itemed) Parser Keycode -> String -> Parser Keycode
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "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 "s
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 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 Token Text
'\"')
  Text -> ParsecT Void Text Identity Text
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 Token Text
'@') Parser Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
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 = Parser ()
sc Parser () -> Parsec Void Text [KExpr] -> Parsec Void Text [KExpr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text [KExpr]
exprsP Parsec Void Text [KExpr] -> Parser () -> Parsec Void Text [KExpr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
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
$
  [ Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
symbol "defcfg")   Parser ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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)
  , Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
symbol "defsrc")   Parser ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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)
  , Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
symbol "deflayer") Parser ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
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)
  , Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
symbol "defalias") Parser ()
-> ParsecT Void Text Identity KExpr
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DefAlias -> KExpr
KDefAlias (DefAlias -> KExpr)
-> ParsecT Void Text Identity DefAlias
-> ParsecT Void Text Identity KExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity DefAlias
defaliasP)
  ]

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

-- | Different ways to refer to shifted versions of keycodes
shiftedNames :: [(Text, DefButton)]
shiftedNames :: DefAlias
shiftedNames = let f :: (d, Keycode) -> (d, DefButton)
f = (Keycode -> DefButton) -> (d, Keycode) -> (d, DefButton)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Keycode -> DefButton) -> (d, Keycode) -> (d, DefButton))
-> (Keycode -> DefButton) -> (d, Keycode) -> (d, DefButton)
forall a b. (a -> b) -> a -> b
$ \kc :: Keycode
kc -> DefButton -> DefButton -> DefButton
KAround (Keycode -> DefButton
KEmit Keycode
KeyLeftShift) (Keycode -> DefButton
KEmit Keycode
kc) in
                 ((Text, Keycode) -> (Text, DefButton))
-> [(Text, Keycode)] -> DefAlias
forall a b. (a -> b) -> [a] -> [b]
map (Text, Keycode) -> (Text, DefButton)
forall d. (d, Keycode) -> (d, DefButton)
f ([(Text, Keycode)] -> DefAlias) -> [(Text, Keycode)] -> DefAlias
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
  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 ['A'..'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 "!@#$%^&*")
          [ 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 "<>:~\"|{}+?")
          [ Keycode
KeyComma, Keycode
KeyDot, Keycode
KeySemicolon, Keycode
KeyGrave, Keycode
KeyApostrophe, Keycode
KeyBackslash
          , Keycode
KeyLeftBrace, Keycode
KeyRightBrace, Keycode
KeyEqual, Keycode
KeySlash]

-- | Names for various buttons
buttonNames :: [(Text, DefButton)]
buttonNames :: DefAlias
buttonNames = DefAlias
shiftedNames DefAlias -> DefAlias -> DefAlias
forall a. Semigroup a => a -> a -> a
<> DefAlias
escp DefAlias -> DefAlias -> DefAlias
forall a. Semigroup a => a -> a -> a
<> DefAlias
util
  where
    emitS :: Keycode -> DefButton
emitS c :: Keycode
c = DefButton -> DefButton -> DefButton
KAround (Keycode -> DefButton
KEmit Keycode
KeyLeftShift) (Keycode -> DefButton
KEmit Keycode
c)
    -- Escaped versions for reserved characters
    escp :: DefAlias
escp = [ ("\\(", Keycode -> DefButton
emitS Keycode
Key9), ("\\)", Keycode -> DefButton
emitS Keycode
Key0)
           , ("\\_", Keycode -> DefButton
emitS Keycode
KeyMinus), ("\\\\", Keycode -> DefButton
KEmit Keycode
KeyBackslash)]
    -- Extra names for useful buttons
    util :: DefAlias
util = [ ("_", DefButton
KTrans), ("XX", DefButton
KBlock)
           , ("lprn", Keycode -> DefButton
emitS Keycode
Key9), ("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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  where mods :: [(Text, Keycode)]
mods = [ ("S-", Keycode
KeyLeftShift), ("C-", Keycode
KeyLeftCtrl)
               , ("A-", Keycode
KeyLeftAlt),   ("M-", Keycode
KeyLeftMeta)
               , ("RS-", Keycode
KeyRightShift), ("RC-", Keycode
KeyRightCtrl)
               , ("RA-", Keycode
KeyRightAlt),   ("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
$ ((Text, Keycode) -> Parser DefButton)
-> [(Text, Keycode)] -> [Parser DefButton]
forall a b. (a -> b) -> [a] -> [b]
map (\(t :: Text
t, p :: Keycode
p) -> ParsecT Void Text Identity Text -> ParsecT Void Text Identity 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 Text
Tokens Text
t) ParsecT Void Text Identity Text
-> Parser DefButton -> Parser DefButton
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> DefButton -> Parser DefButton
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Keycode -> DefButton
KEmit Keycode
p)) [(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 Token Text
'P' Parser Char -> Parser Int -> Parser Int
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 = [DefButton] -> DefButton
KTapMacro ([DefButton] -> DefButton)
-> ParsecT Void Text Identity [DefButton] -> 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 Token Text
'#' Parser Char
-> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity [DefButton]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity [DefButton]
-> ParsecT Void Text Identity [DefButton]
forall a. Parser a -> Parser a
paren (Parser DefButton -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser DefButton
buttonP))

-- | 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
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
<?> "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 (\(_, c' :: Char
c', _) -> (Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)) [(Text, Char, Text)]
ssComposed of
         Nothing -> String -> ParsecT Void Text Identity Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unrecognized compose-char"
         Just b :: (Text, Char, Text)
b  -> Text -> ParsecT Void Text Identity Text
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
_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) "" Text
s of
    Left  _ -> String -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Could not parse compose sequence"
    Right b :: [DefButton]
b -> [DefButton] -> ParsecT Void Text Identity [DefButton]
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 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("~'^`\"" :: 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 "" (Char -> Text
T.singleton Char
c) of
    Left  _ -> String -> ParsecT Void Text Identity [DefButton]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Could not parse deadkey sequence"
    Right b :: DefButton
b -> [DefButton] -> ParsecT Void Text Identity [DefButton]
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 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
forall a. Text -> Parser a -> Parser a
statement "around"         (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "multi-tap"      (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ [(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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-hold"       (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-hold-next"  (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ Int -> DefButton -> DefButton -> DefButton
KTapHoldNext (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-next-release"
    (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-hold-next-release"
    (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ Int -> DefButton -> DefButton -> DefButton
KTapHoldNextRelease (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-next"       (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DefButton
buttonP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-toggle"   (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-switch"   (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-add"      (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-rem"      (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-delay"    (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "layer-next"     (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
word
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "around-next"    (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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 -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "tap-macro"      (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ [DefButton] -> DefButton
KTapMacro    ([DefButton] -> DefButton)
-> ParsecT Void Text Identity [DefButton] -> Parser 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
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "cmd-button"     (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ Text -> DefButton
KCommand     (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
textP
  , Text -> Parser DefButton -> Parser DefButton
forall a. Text -> Parser a -> Parser a
statement "pause"          (Parser DefButton -> Parser DefButton)
-> Parser DefButton -> Parser DefButton
forall a b. (a -> b) -> a -> b
$ 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
  , [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
$ DefAlias -> Parser DefButton
forall a. [(Text, a)] -> Parser a
fromNamed DefAlias
buttonNames
  , Parser DefButton -> Parser DefButton
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 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 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
  ]) Parser DefButton -> String -> Parser DefButton
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "button"

  where
    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 (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)


--------------------------------------------------------------------------------
-- $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])
-> [Parser IToken]
-> Parser IToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser IToken -> Parser IToken)
-> [Parser IToken] -> [Parser IToken]
forall a b. (a -> b) -> [a] -> [b]
map Parser IToken -> Parser IToken
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser IToken] -> Parser IToken)
-> [Parser IToken] -> Parser IToken
forall a b. (a -> b) -> a -> b
$
  [ Text -> Parser IToken -> Parser IToken
forall a. Text -> Parser a -> Parser a
statement "device-file"    (Parser IToken -> Parser IToken) -> Parser IToken -> Parser IToken
forall a b. (a -> b) -> a -> b
$ 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 -> Parser IToken -> Parser IToken
forall a. Text -> Parser a -> Parser a
statement "low-level-hook" (Parser IToken -> Parser IToken) -> Parser IToken -> Parser IToken
forall a b. (a -> b) -> a -> b
$ IToken -> Parser IToken
forall (f :: * -> *) a. Applicative f => a -> f a
pure IToken
KLowLevelHookSource
  , Text -> Parser IToken -> Parser IToken
forall a. Text -> Parser a -> Parser a
statement "iokit-name"     (Parser IToken -> Parser IToken) -> Parser IToken -> Parser IToken
forall a b. (a -> b) -> a -> b
$ 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])
-> [Parser OToken]
-> Parser OToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser OToken -> Parser OToken)
-> [Parser OToken] -> [Parser OToken]
forall a b. (a -> b) -> [a] -> [b]
map Parser OToken -> Parser OToken
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser OToken] -> Parser OToken)
-> [Parser OToken] -> Parser OToken
forall a b. (a -> b) -> a -> b
$
  [ Text -> Parser OToken -> Parser OToken
forall a. Text -> Parser a -> Parser a
statement "uinput-sink"     (Parser OToken -> Parser OToken) -> Parser OToken -> Parser OToken
forall a b. (a -> b) -> a -> b
$ 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 (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 -> Parser OToken -> Parser OToken
forall a. Text -> Parser a -> Parser a
statement "send-event-sink" (Parser OToken -> Parser OToken) -> Parser OToken -> Parser OToken
forall a b. (a -> b) -> a -> b
$ OToken -> Parser OToken
forall (f :: * -> *) a. Applicative f => a -> f a
pure OToken
KSendEventSink
  , Text -> Parser OToken -> Parser OToken
forall a. Text -> Parser a -> Parser a
statement "kext"            (Parser OToken -> Parser OToken) -> Parser OToken -> Parser OToken
forall a b. (a -> b) -> a -> b
$ OToken -> Parser OToken
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 s :: Text
s p :: ParsecT Void Text Identity b
p = Text -> Parser ()
symbol Text
s Parser ()
-> 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 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 "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 "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 "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 "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 "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 "allow-cmd"   Parser Bool
bool
    ])

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

-- | Parse a collection of names and buttons
defaliasP :: Parser DefAlias
defaliasP :: ParsecT Void Text Identity DefAlias
defaliasP = ParsecT Void Text Identity (Text, DefButton)
-> ParsecT Void Text Identity DefAlias
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity (Text, DefButton)
 -> ParsecT Void Text Identity DefAlias)
-> ParsecT Void Text Identity (Text, DefButton)
-> ParsecT Void Text Identity DefAlias
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 (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 (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)