module Holumbus.Query.Language.Parser
(
parseQuery
)
where
import Holumbus.Query.Language.Grammar
import Text.ParserCombinators.Parsec
parseQuery :: String -> Either String Query
parseQuery = result . (parse query "")
where
result (Left err) = Left (show err)
result (Right q) = Right q
query :: Parser Query
query = spaces >> andQuery
andQuery :: Parser Query
andQuery = do t <- orQuery
try (andOp' t) <|> return t
where
andOp' r = do andOp
q <- andQuery
return (BinQuery And r q)
orQuery :: Parser Query
orQuery = do t <- notQuery
do orOp
q <- orQuery
return (BinQuery Or t q)
<|> return t
notQuery :: Parser Query
notQuery = do notQuery' <|> contextQuery
where
notQuery' = do notOp
q <- contextQuery
return (Negation q)
contextQuery :: Parser Query
contextQuery = try contextQuery' <|> parQuery
where
contextQuery' = do c <- contexts
spaces
char ':'
spaces
t <- parQuery
return (Specifier c t)
parQuery :: Parser Query
parQuery = parQuery' <|> caseQuery
where
parQuery' = do char '('
spaces
q <- andQuery
spaces
char ')'
return q
caseQuery :: Parser Query
caseQuery = caseQuery' <|> fuzzyQuery
where
caseQuery' = do char '!'
spaces
(phraseQuery CasePhrase <|> wordQuery CaseWord)
fuzzyQuery :: Parser Query
fuzzyQuery = fuzzyQuery' <|> phraseQuery Phrase <|> wordQuery Word
where
fuzzyQuery' = do char '~'
spaces
wordQuery FuzzyWord
wordQuery :: (String -> Query) -> Parser Query
wordQuery c = do w <- word
return (c w)
phraseQuery :: (String -> Query) -> Parser Query
phraseQuery c = do p <- phrase
return (c p)
andOp :: Parser ()
andOp = (try andOp') <|> spaces1
where
andOp' = do spaces
string "AND"
spaces1
return ()
orOp :: Parser ()
orOp = try orOp'
where
orOp' = do spaces
string "OR"
spaces1
return ()
notOp :: Parser ()
notOp = try notOp'
where
notOp' = do spaces
string "NOT"
spaces1
return ()
word :: Parser String
word = many1 wordChar
phrase :: Parser String
phrase = do char '"'
p <- many1 phraseChar
char '"'
return p
wordChar :: Parser Char
wordChar = noneOf "\")( "
phraseChar :: Parser Char
phraseChar = noneOf "\""
contexts :: Parser [String]
contexts = context `sepBy1` (char ',')
context :: Parser String
context = do spaces
c <- (many1 alphaNum)
spaces
return c
spaces1 :: Parser ()
spaces1 = skipMany1 space