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

cln: hlint: Fix hlint warnings in Query.hs.

Browse Source
This commit is contained in:
Stephen Morgan 2021-08-16 16:46:40 +10:00 committed by Simon Michael
parent d13ce0e134
commit aa7a99a437
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,7 +62,7 @@ where
import Control.Applicative ((<|>), many, optional) import Control.Applicative ((<|>), many, optional)
import Data.Default (Default(..)) import Data.Default (Default(..))
import Data.Either (partitionEithers) import Data.Either (fromLeft, partitionEithers)
import Data.List (partition) import Data.List (partition)
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Text (Text) import Data.Text (Text)
@ -211,11 +211,11 @@ words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
p <- singleQuotedPattern <|> doubleQuotedPattern p <- singleQuotedPattern <|> doubleQuotedPattern
return $ prefix <> stripquotes p return $ prefix <> stripquotes p
singleQuotedPattern :: SimpleTextParser T.Text singleQuotedPattern :: SimpleTextParser T.Text
singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char])) >>= return . stripquotes . T.pack singleQuotedPattern = stripquotes . T.pack <$> between (char '\'') (char '\'') (many $ noneOf ("'" :: [Char]))
doubleQuotedPattern :: SimpleTextParser T.Text doubleQuotedPattern :: SimpleTextParser T.Text
doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf ("\"" :: [Char])) >>= return . stripquotes . T.pack doubleQuotedPattern = stripquotes . T.pack <$> between (char '"') (char '"') (many $ noneOf ("\"" :: [Char]))
patterns :: SimpleTextParser T.Text patterns :: SimpleTextParser T.Text
patterns = fmap T.pack $ many (noneOf (" \n\r" :: [Char])) patterns = T.pack <$> many (noneOf (" \n\r" :: [Char]))
-- XXX -- XXX
-- keep synced with patterns below, excluding "not" -- keep synced with patterns below, excluding "not"
@ -341,8 +341,8 @@ parseTag s = do
-- | Parse the value part of a "status:" query, or return an error. -- | Parse the value part of a "status:" query, or return an error.
parseStatus :: T.Text -> Either String Status parseStatus :: T.Text -> Either String Status
parseStatus s | s `elem` ["*","1"] = Right Cleared parseStatus s | s `elem` ["*","1"] = Right Cleared
| s `elem` ["!"] = Right Pending
| s `elem` ["","0"] = Right Unmarked | s `elem` ["","0"] = Right Unmarked
| s == "!" = Right Pending
| otherwise = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)" | otherwise = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)"
-- | Parse the boolean value part of a "status:" query. "1" means true, -- | Parse the boolean value part of a "status:" query. "1" means true,
@ -363,7 +363,7 @@ simplifyQuery q =
simplify (And qs) | same qs = simplify $ head qs simplify (And qs) | same qs = simplify $ head qs
| None `elem` qs = None | None `elem` qs = None
| all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs
| otherwise = And $ concat $ [map simplify dateqs, map simplify otherqs] | otherwise = And $ map simplify dateqs ++ map simplify otherqs
where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs
simplify (Or []) = Any simplify (Or []) = Any
simplify (Or [q]) = simplifyQuery q simplify (Or [q]) = simplifyQuery q
@ -666,11 +666,11 @@ matchesDescription (Tag _ _) _ = False
-- XXX Currently an alias for matchDescription. I'm not sure if more is needed, -- XXX Currently an alias for matchDescription. I'm not sure if more is needed,
-- There's some shenanigan with payee: and "payeeTag" to figure out. -- There's some shenanigan with payee: and "payeeTag" to figure out.
matchesPayeeWIP :: Query -> Payee -> Bool matchesPayeeWIP :: Query -> Payee -> Bool
matchesPayeeWIP q p = matchesDescription q p matchesPayeeWIP = matchesDescription
-- | Does the query match the name and optionally the value of any of these tags ? -- | Does the query match the name and optionally the value of any of these tags ?
matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool
matchesTags namepat valuepat = not . null . filter (matches namepat valuepat) matchesTags namepat valuepat = any (matches namepat valuepat)
where where
matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v matches npat vpat (n,v) = regexMatchText npat n && maybe (const True) regexMatchText vpat v
@ -808,7 +808,7 @@ tests_Query = tests "Query" [
assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]} assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}} ,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
,test "cur:" $ do ,test "cur:" $ do
let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>) let toSym = fromLeft (error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr
assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}} assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}