{
module QueryLexer where
import Data.Either
}
%wrapper "posn"
$digit = 0-9
$alpha = [a-zA-Z]
$upper = A-Z
$ident = [a-zA-Z0-9]
$s = [^'"']
tokens :-
$white+ ;
"#".* ;
">" { \p s -> TL p }
"<" { \p s -> TG p }
"<=" { \p s -> TLE p }
">=" { \p s -> TGE p }
"==" { \p s -> TEqual p }
"=" { \p s -> TEqual p }
"!=" { \p s -> TNEqual p }
"/=" { \p s -> TNEqual p }
"(" { \p s -> TParenOpen p }
")" { \p s -> TParenClose p }
"," { \p s -> TComma p }
"*" { \p s -> TProduct p }
":=" { \p s -> TAssign p }
";" { \p s -> TSemiColon p }
extension { \p s -> TExtension p }
extensions { \p s -> TExtension p }
exts { \p s -> TExtension p }
ext { \p s -> TExtension p }
e { \p s -> TExtension p }
languages { \p s -> TLanguage p }
language { \p s -> TLanguage p }
langs { \p s -> TLanguage p }
lang { \p s -> TLanguage p }
l { \p s -> TLanguage p }
projects { \p s -> TProject p }
project { \p s -> TProject p }
proj { \p s -> TProject p }
p { \p s -> TProject p }
filenames { \p s -> TFilename p }
filename { \p s -> TFilename p }
files { \p s -> TFilename p }
file { \p s -> TFilename p }
f { \p s -> TFilename p }
years { \p s -> TYear p }
year { \p s -> TYear p }
y { \p s -> TYear p }
months { \p s -> TMonth p }
month { \p s -> TMonth p }
m { \p s -> TMonth p }
days { \p s -> TDay p }
day { \p s -> TDay p }
da { \p s -> TDay p }
dow { \p s -> TDow p }
doy { \p s -> TDoy p }
ascending { \p s -> TAscending p }
descending { \p s -> TDescending p }
asc { \p s -> TAscending p }
as { \p s -> TAs p }
desc { \p s -> TDescending p }
limit { \p s -> TLimit p }
group { \p s -> TGroup p }
"&" { \p s -> TGroup p }
nogrouping { \p s -> TDontGroup p }
nogroup { \p s -> TDontGroup p }
"!" { \p s -> TDontGroup p }
$digit+ { \p s -> TInteger p (read s) }
$upper$ident* { \p s -> TIdent p s }
\"$s*\" { \p s -> TString p (init (tail s)) }
{
data ConstraintToken = TExtension AlexPosn
| TLanguage AlexPosn
| TProject AlexPosn
| TFilename AlexPosn
| TYear AlexPosn
| TMonth AlexPosn
| TDay AlexPosn
| TDow AlexPosn
| TDoy AlexPosn
| TGroup AlexPosn
| TDontGroup AlexPosn
| TAscending AlexPosn
| TDescending AlexPosn
| TLimit AlexPosn
| TParenOpen AlexPosn
| TParenClose AlexPosn
| TComma AlexPosn
| TProduct AlexPosn
| TEqual AlexPosn
| TNEqual AlexPosn
| TL AlexPosn
| TG AlexPosn
| TLE AlexPosn
| TGE AlexPosn
| TSemiColon AlexPosn
| TAs AlexPosn
| TInteger AlexPosn Int
| TIdent AlexPosn String
| TAssign AlexPosn
| TString AlexPosn String
deriving (Eq, Show)
alexScanTokens' :: String -> Either String [ConstraintToken]
alexScanTokens' str = case go (alexStartPos, '\n', str) of
[] -> Right []
cs -> case last cs of
Left a -> Left a
_ -> Right (rights cs)
where go inp@(pos,_,str) =
case alexScan inp 0 of
AlexEOF -> []
AlexError _ -> [Left $ "Lexical error on " ++ showPos pos
++ if null str then "."
else ". Not a valid token: '" ++ (head . words $ str) ++ "'"]
AlexSkip inp' len -> go inp'
AlexToken inp' len act -> Right (act pos (take len str)): go inp'
showPos (AlexPn _ li co) = unwords ["line", show li, ", column", show co]
showTokenPos (TExtension p) = showPos p
showTokenPos (TLanguage p) = showPos p
showTokenPos (TProject p) = showPos p
showTokenPos (TFilename p) = showPos p
showTokenPos (TYear p) = showPos p
showTokenPos (TMonth p) = showPos p
showTokenPos (TDay p) = showPos p
showTokenPos (TDow p) = showPos p
showTokenPos (TDoy p) = showPos p
showTokenPos (TGroup p) = showPos p
showTokenPos (TDontGroup p) = showPos p
showTokenPos (TAscending p) = showPos p
showTokenPos (TDescending p) = showPos p
showTokenPos (TLimit p) = showPos p
showTokenPos (TParenOpen p) = showPos p
showTokenPos (TParenClose p) = showPos p
showTokenPos (TComma p) = showPos p
showTokenPos (TProduct p) = showPos p
showTokenPos (TEqual p) = showPos p
showTokenPos (TNEqual p) = showPos p
showTokenPos (TL p) = showPos p
showTokenPos (TG p) = showPos p
showTokenPos (TLE p) = showPos p
showTokenPos (TGE p) = showPos p
showTokenPos (TInteger p _) = showPos p
showTokenPos (TString p _) = showPos p
showTokenPos (TAssign p) = showPos p
showTokenPos (TIdent p _) = showPos p
showTokenPos (TSemiColon p) = showPos p
showTokenPos (TAs p) = showPos p
}