module Yu.Core.View.Query.Parsec
(
runQp
) where
import Data.Time
import Text.Parsec
import Yu.Core.Model (ResT (..))
import qualified Yu.Import.Text as T
data QueryParser = QPTake Int
| QPDrop Int
| QPBefor UTCTime Bool
| QPAfter UTCTime Bool
| QPTag Bool String
| QPType Bool String
| QPOr [QueryParser]
| QPAnd [QueryParser]
deriving (Show)
qpEmpty :: Parsec String () [QueryParser]
qpEmpty = do
string ";"
return []
qpType :: Parsec String () [QueryParser]
qpType = do
t <- string "type=" *> oneOf ['t','f'] <* char '='
typ <- many letter <* char ';'
return [QPType (t=='t') typ]
qpTake :: Parsec String () [QueryParser]
qpTake = do
len <- string "take=" *> many (oneOf ['0'..'9']) <* char ';'
return [QPTake (read len)]
qpDrop :: Parsec String () [QueryParser]
qpDrop = do
len <- string "drop=" *> many (oneOf ['0'..'9']) <* char ';'
return [QPDrop (read len)]
qpBefor :: Parsec String () [QueryParser]
qpBefor = do
date <- parseTimeM True defaultTimeLocale "%F+%T" =<<
(string "befor=" *> many (noneOf "@") <* char '@')
b <- true <|> false <* char ';'
return [QPBefor date b]
true :: Parsec String () Bool
true = string "true" >> return True
false :: Parsec String () Bool
false = string "false" >> return False
qpAfter :: Parsec String () [QueryParser]
qpAfter = do
date <- parseTimeM True defaultTimeLocale "%F+%T" =<<
(string "after=" *> many (noneOf "@") <* char '@')
b <- true <|> false <* char ';'
return [QPAfter date b]
qpTag :: Parsec String () [QueryParser]
qpTag = do
t <- string "tag=" *> oneOf ['t','f'] <* char '='
tag <- many (noneOf ";") <* char ';'
return [QPTag (t=='t') tag]
qpAnd :: Parsec String () [QueryParser]
qpAnd = do
sub <- char '[' *> many qps <* char ']'
return [QPAnd $ concat sub]
qpOr :: Parsec String () [QueryParser]
qpOr = do
sub <- char '{' *> many qps <* char '}'
return [QPOr $ concat sub]
qp :: Parsec String () [QueryParser]
qp = concat <$> many qps
qps :: Parsec String () [QueryParser]
qps = foldl (<|>) qpEmpty $ try <$>
[qpTake,qpDrop,qpBefor,qpAfter,qpTag,qpOr,qpAnd
, qpType
]
toFilter :: [QueryParser] -> ([ResT] -> [ResT])
toFilter [] = id
toFilter (QPTake i:xs) = take i . toFilter xs
toFilter (QPDrop i:xs) = drop i . toFilter xs
toFilter (QPBefor i b:xs) = filter (timeFilter i (>) b) . toFilter xs
toFilter (QPAfter i b:xs) = filter (timeFilter i (<) b) . toFilter xs
toFilter (QPTag t i:xs) = filter ((==t) . tagFilter i) . toFilter xs
toFilter (QPType t i:xs) = filter ((==t) . typFilter i) . toFilter xs
toFilter (QPOr s:xs) = concat . map sg . toFilter xs
where funcs = (\y -> toFilter [y]) <$> s
sg y = take 1 $ concatMap (\f -> f [y]) funcs
toFilter (QPAnd s:xs) = toFilter s . toFilter xs
typFilter :: String -> ResT -> Bool
typFilter t ResT{..} = rType == T.pack t
tagFilter :: String -> ResT -> Bool
tagFilter t ResT{..} = T.pack t `elem` rTags
timeFilter :: UTCTime -> (UTCTime -> UTCTime -> Bool) -> Bool -> ResT -> Bool
timeFilter t o b ResT{..} = t `o` resTime
where resTime = if b then rCTime else rUTime
runQp :: String -> Either ParseError ([ResT]->[ResT])
runQp str = toFilter <$> runP qp () "QueryPaserError" str