slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

dev:parseBooleanQuery: refactor

Browse Source
This commit is contained in:
Simon Michael 2024-04-07 22:48:25 -10:00
parent 1d3e6b5543
commit 06ef6de242
1 changed files with 48 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
hledger-lib/Hledger/Query.hs
View File

@ -201,11 +201,11 @@ parseQueryList :: Day -> [T.Text] -> Either String (Query, [QueryOpt])
parseQueryList d termstrs = do parseQueryList d termstrs = do
eterms <- mapM (parseQueryTerm d) termstrs eterms <- mapM (parseQueryTerm d) termstrs
let (pats, optss) = unzip eterms let (pats, optss) = unzip eterms
q = combineQueryList pats q = combineQueriesByType pats
Right (q, concat optss) Right (q, concat optss)
combineQueryList :: [Query] -> Query combineQueriesByType :: [Query] -> Query
combineQueryList pats = q combineQueriesByType pats = q
where where
(descpats, pats') = partition queryIsDesc pats (descpats, pats') = partition queryIsDesc pats
(acctpats, pats'') = partition queryIsAcct pats' (acctpats, pats'') = partition queryIsAcct pats'
@ -337,65 +337,83 @@ parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
-- --
-- >>> parseBooleanQuery nulldate "expenses:dining AND desc:a OR desc:b" -- >>> parseBooleanQuery nulldate "expenses:dining AND desc:a OR desc:b"
-- Right (Or [And [Acct (RegexpCI "expenses:dining"),Desc (RegexpCI "a")],Desc (RegexpCI "b")],[]) -- Right (Or [And [Acct (RegexpCI "expenses:dining"),Desc (RegexpCI "a")],Desc (RegexpCI "b")],[])
--
parseBooleanQuery :: Day -> T.Text -> Either String (Query,[QueryOpt]) parseBooleanQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])
parseBooleanQuery d t = either (Left . ("failed to parse query:" <>) . customErrorBundlePretty) Right $ parsewith spacedQueriesP t parseBooleanQuery d t =
either (Left . ("failed to parse query:" <>) . customErrorBundlePretty) Right $
parsewith spacedExprsP t
where where
spacedQueriesP :: SimpleTextParser (Query, [QueryOpt]) -- Our "boolean queries" are compound query expressions built with a hierarchy of combinators.
spacedQueriesP = nArityOp combineQueryList <$> orQueriesP `sepBy` skipNonNewlineSpaces1 -- At the top level we have one or more query expressions separated by space.
-- These are combined in the default way according to their types (see combineQueriesByType).
spacedExprsP :: SimpleTextParser (Query, [QueryOpt])
spacedExprsP = combineWith combineQueriesByType <$> orExprsP `sepBy` skipNonNewlineSpaces1
where where
nArityOp :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt]) combineWith :: ([Query] -> Query) -> [(Query, [QueryOpt])] -> (Query, [QueryOpt])
nArityOp f res = combineWith f res =
let (qs, qoptss) = unzip res let (qs, qoptss) = unzip res
qoptss' = concat qoptss qoptss' = concat qoptss
in case qs of in case qs of
[] -> (Any, qoptss') [] -> (Any, qoptss')
(q:[]) -> (simplifyQuery q, qoptss') (q:[]) -> (simplifyQuery q, qoptss')
_ -> (simplifyQuery $ f qs, qoptss') _ -> (simplifyQuery $ f qs, qoptss')
orQueriesP :: SimpleTextParser (Query, [QueryOpt]) -- Containing query expressions separated by "or".
orQueriesP = nArityOp Or <$> andQueriesP `sepBy` (try $ skipNonNewlineSpaces >> string' "or" >> skipNonNewlineSpaces1) orExprsP :: SimpleTextParser (Query, [QueryOpt])
orExprsP = combineWith Or <$> andExprsP `sepBy` (try $ skipNonNewlineSpaces >> string' "or" >> skipNonNewlineSpaces1)
where where
andQueriesP :: SimpleTextParser (Query, [QueryOpt]) -- Containing query expressions separated by "and".
andQueriesP = nArityOp And <$> notQueryP `sepBy` (try $ skipNonNewlineSpaces >> string' "and" >> skipNonNewlineSpaces1) andExprsP :: SimpleTextParser (Query, [QueryOpt])
andExprsP = combineWith And <$> maybeNotExprP `sepBy` (try $ skipNonNewlineSpaces >> string' "and" >> skipNonNewlineSpaces1)
where where
notQueryP :: SimpleTextParser (Query, [QueryOpt]) -- Containing query expressions optionally preceded by "not".
notQueryP = (maybe id (\_ (q, qopts) -> (Not q, qopts)) <$> maybeNotExprP :: SimpleTextParser (Query, [QueryOpt])
optional (try $ string' "not" >> notFollowedBy (char ':') >> skipNonNewlineSpaces1)) <*> parQueryP maybeNotExprP = (maybe id (\_ (q, qopts) -> (Not q, qopts)) <$>
optional (try $ string' "not" >> notFollowedBy (char ':') >> skipNonNewlineSpaces1)) <*> termOrParenthesisedExprP
where where
parQueryP :: SimpleTextParser (Query, [QueryOpt]) -- Each of which is a parenthesised query expression or a single query term.
parQueryP = termOrParenthesisedExprP :: SimpleTextParser (Query, [QueryOpt])
between (char '(' >> skipNonNewlineSpaces) (try $ skipNonNewlineSpaces >> char ')') spacedQueriesP termOrParenthesisedExprP =
between (char '(' >> skipNonNewlineSpaces) (try $ skipNonNewlineSpaces >> char ')') spacedExprsP
<|> queryTermP <|> queryTermP
where where
-- A simple query term: foo, acct:foo, desc:foo, payee:foo etc.
queryTermP :: SimpleTextParser (Query, [QueryOpt]) queryTermP :: SimpleTextParser (Query, [QueryOpt])
queryTermP = do queryTermP = do
prefix <- optional queryPrefixP prefix <- optional queryPrefixP
queryRegex <- regexP arg <- queryArgP
case parseQueryTerm d (fromMaybe "" prefix <> queryRegex) of case parseQueryTerm d (fromMaybe "" prefix <> arg) of
Right q -> return q Right q -> return q
Left err -> error' err Left err -> error' err
where where
-- One of the query prefixes: acct:, desc:, payee: etc (plus zero or more not: prefixes).
queryPrefixP :: SimpleTextParser T.Text queryPrefixP :: SimpleTextParser T.Text
queryPrefixP = (string "not:" <> (fromMaybe "" <$> optional queryPrefixP)) queryPrefixP =
<|> choice' (string <$> queryprefixes) (string "not:" <> (fromMaybe "" <$> optional queryPrefixP))
<?> "query prefix" <|> choice' (string <$> queryprefixes)
<?> "query prefix"
regexP :: SimpleTextParser T.Text -- A query term's argument, the part after the prefix:
regexP = choice' -- any text enclosed in single quotes or double quotes,
-- or any text up to the next space, closing parenthesis, or end of line,
-- if it is not one of the keywords "not", "and", "or".
queryArgP :: SimpleTextParser T.Text
queryArgP = choice'
[ stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])), [ stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])),
stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])), stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])),
T.pack <$> (notFollowedBy keywordSpaceP >> (many $ noneOf (") \n\r" :: [Char]))) ] T.pack <$> (notFollowedBy keywordP >> (many $ noneOf (") \n\r" :: [Char]))) ]
where where
keywordSpaceP :: SimpleTextParser T.Text -- Any of the combinator keywords used above (not/and/or), terminated by a space.
keywordSpaceP = choice' (string' <$> ["not ", "and ", "or "]) keywordP :: SimpleTextParser T.Text
keywordP = choice' (string' <$> ["not ", "and ", "or "])
-- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an -- | Parse the argument of an amt query term ([OP][SIGN]NUM), to an
-- OrdPlus and a Quantity, or if parsing fails, an error message. OP -- OrdPlus and a Quantity, or if parsing fails, an error message. OP