module Taskell.IO.Keyboard.Parser where

import ClassyPrelude

import Data.Attoparsec.Text

import Taskell.Utility.Parser

import Taskell.Events.Actions.Types (ActionType, read)
import Taskell.IO.Keyboard.Types

-- utility functions
commentP :: Parser ()
commentP :: Parser ()
commentP = Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text [Char] -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany ((Char -> Parser Char
char Char
'#' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
';') Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser () -> Parser Text [Char]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar Parser ()
endOfLine)

stripComments :: Parser a -> Parser a
stripComments :: Parser a -> Parser a
stripComments Parser a
p = Parser a -> Parser a
forall a. Parser a -> Parser a
lexeme (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser ()
commentP Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commentP

-- ini parser
keyP :: Parser Binding
keyP :: Parser Binding
keyP = Parser Binding -> Parser Binding
forall a. Parser a -> Parser a
lexeme (Parser Binding -> Parser Binding)
-> Parser Binding -> Parser Binding
forall a b. (a -> b) -> a -> b
$ Text -> Binding
BKey (Text -> Binding) -> Parser Text Text -> Parser Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'<' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
word Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'>')

charP :: Parser Binding
charP :: Parser Binding
charP = Parser Binding -> Parser Binding
forall a. Parser a -> Parser a
lexeme (Parser Binding -> Parser Binding)
-> Parser Binding -> Parser Binding
forall a b. (a -> b) -> a -> b
$ Char -> Binding
BChar (Char -> Binding) -> Parser Char -> Parser Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
anyChar

bindingP :: Parser [Binding]
bindingP :: Parser [Binding]
bindingP = Parser [Binding] -> Parser [Binding]
forall a. Parser a -> Parser a
lexeme (Parser [Binding] -> Parser [Binding])
-> Parser [Binding] -> Parser [Binding]
forall a b. (a -> b) -> a -> b
$ (Parser Binding
keyP Parser Binding -> Parser Binding -> Parser Binding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Binding
charP) Parser Binding -> Parser Char -> Parser [Binding]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
`sepBy` Char -> Parser Char
char Char
','

lineP :: Parser [(Binding, ActionType)]
lineP :: Parser [(Binding, ActionType)]
lineP =
    Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall a. Parser a -> Parser a
stripComments (Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)])
-> Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall a b. (a -> b) -> a -> b
$ do
        ActionType
name <- Text -> ActionType
read (Text -> ActionType) -> Parser Text Text -> Parser Text ActionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
word
        Char
_ <- Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'='
        [Binding]
binds <- Parser [Binding]
bindingP
        [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Binding, ActionType)] -> Parser [(Binding, ActionType)])
-> [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall a b. (a -> b) -> a -> b
$ (, ActionType
name) (Binding -> (Binding, ActionType))
-> [Binding] -> [(Binding, ActionType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binding]
binds

bindingsP :: Parser Bindings
bindingsP :: Parser [(Binding, ActionType)]
bindingsP = Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall a. Parser a -> Parser a
stripComments (Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)])
-> Parser [(Binding, ActionType)] -> Parser [(Binding, ActionType)]
forall a b. (a -> b) -> a -> b
$ [[(Binding, ActionType)]] -> [(Binding, ActionType)]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat ([[(Binding, ActionType)]] -> [(Binding, ActionType)])
-> Parser Text [[(Binding, ActionType)]]
-> Parser [(Binding, ActionType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Binding, ActionType)]
-> Parser Text [[(Binding, ActionType)]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser [(Binding, ActionType)]
lineP

-- run parser
bindings :: Text -> Either Text Bindings
bindings :: Text -> Either Text [(Binding, ActionType)]
bindings Text
ini = ([Char] -> Text)
-> Either [Char] [(Binding, ActionType)]
-> Either Text [(Binding, ActionType)]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> [Char] -> Text
forall a b. a -> b -> a
const Text
"Could not parse keyboard bindings.") (Parser [(Binding, ActionType)]
-> Text -> Either [Char] [(Binding, ActionType)]
forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser [(Binding, ActionType)]
bindingsP Text
ini)