module Data.BoolExpr.Parser
(
parseBoolExpr
,languageDef
,lexer
,identifier
,whiteSpace
,symbol
)
where
import Control.Monad
import Control.Applicative hiding ((<|>))
import Data.BoolExpr
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as P
parseBoolExpr :: CharParser st a -> CharParser st (BoolExpr a)
parseBoolExpr parseConst = disj
where disj = conj `chainl1` orOp
conj = factor `chainl1` andOp
factor = parens disj <|>
(((symbol "-" >> return BNot) <|> return id) `ap` (BConst `fmap` parseConst))
andOp = BAnd <$ option "" (symbol "AND")
orOp = BOr <$ symbol "OR"
lexer :: P.TokenParser st
lexer = P.makeTokenParser languageDef
parens :: CharParser st a -> CharParser st a
parens = P.parens lexer
symbol :: String -> CharParser st String
symbol = P.symbol lexer
whiteSpace :: CharParser st ()
whiteSpace = P.whiteSpace lexer
identifier :: CharParser st String
identifier = P.identifier lexer
wordLetter :: CharParser st Char
wordLetter = alphaNum <|> oneOf "_:;`,~@.!#$%^&*=+?|\\{}[]<>"
languageDef :: P.LanguageDef st
languageDef = P.LanguageDef
{ P.commentStart = ""
, P.commentEnd = ""
, P.commentLine = ""
, P.nestedComments = True
, P.identStart = wordLetter
, P.identLetter = wordLetter <|> char '-'
, P.opStart = mzero
, P.opLetter = mzero
, P.reservedOpNames= []
, P.reservedNames = ["AND", "OR", "-"]
, P.caseSensitive = True
}