From 07dd30c1e55bd31748ad54e48e3aff3fe28a0f72 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 1 Sep 2020 11:36:34 +1000 Subject: [PATCH] lib,cli,ui: Change to consistent naming scheme for Hledger.Utils.Regex. --- hledger-lib/Hledger/Data/Posting.hs | 2 +- hledger-lib/Hledger/Query.hs | 49 +++++---- hledger-lib/Hledger/Read/Common.hs | 2 +- hledger-lib/Hledger/Read/CsvReader.hs | 6 +- hledger-lib/Hledger/Read/JournalReader.hs | 2 +- hledger-lib/Hledger/Utils/Regex.hs | 125 ++++++++++------------ hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/Main.hs | 8 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 10 +- hledger/Hledger/Cli/Commands/Files.hs | 4 +- hledger/Hledger/Cli/Commands/Tags.hs | 4 +- 12 files changed, 109 insertions(+), 107 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 64f8a6ec4..db03c9745 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -315,7 +315,7 @@ aliasReplace (BasicAlias old new) a Right $ new <> T.drop (T.length old) a | otherwise = Right a aliasReplace (RegexAlias re repl) a = - fmap T.pack $ regexReplaceMemo_ re repl $ T.unpack a -- XXX + fmap T.pack . regexReplace re repl $ T.unpack a -- XXX -- | Apply a specified valuation to this posting's amount, using the -- provided price oracle, commodity styles, reference dates, and diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index c4ef59b7e..98c91b24b 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -18,6 +18,9 @@ module Hledger.Query ( -- * Query and QueryOpt Query(..), QueryOpt(..), + payeeTag, + noteTag, + generatedTransactionTag, -- * parsing parseQuery, simplifyQuery, @@ -58,7 +61,7 @@ module Hledger.Query ( ) where -import Control.Applicative ((<|>), liftA2, many, optional) +import Control.Applicative ((<|>), many, optional) import Data.Either (partitionEithers) import Data.List (partition) import Data.Maybe (fromMaybe, isJust, mapMaybe) @@ -107,11 +110,15 @@ data Query = Any -- ^ always match -- | Construct a payee tag payeeTag :: Maybe String -> Either RegexError Query -payeeTag = liftA2 Tag (toRegexCI_ "payee") . maybe (pure Nothing) (fmap Just . toRegexCI_) +payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI) -- | Construct a note tag noteTag :: Maybe String -> Either RegexError Query -noteTag = liftA2 Tag (toRegexCI_ "note") . maybe (pure Nothing) (fmap Just . toRegexCI_) +noteTag = fmap (Tag (toRegexCI' "note")) . maybe (pure Nothing) (fmap Just . toRegexCI) + +-- | Construct a generated-transaction tag +generatedTransactionTag :: Query +generatedTransactionTag = Tag (toRegexCI' "generated-transaction") Nothing -- | A more expressive Ord, used for amt: queries. The Abs* variants -- compare with the absolute value of a number, ignoring sign. @@ -254,11 +261,11 @@ parseQueryTerm d (T.stripPrefix "not:" -> Just s) = Right (Left m) -> Right $ Left $ Not m Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored Left err -> Left err -parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI_ (T.unpack s) -parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI_ (T.unpack s) +parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left . Code <$> toRegexCI (T.unpack s) +parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left . Desc <$> toRegexCI (T.unpack s) parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left <$> payeeTag (Just $ T.unpack s) parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left <$> noteTag (Just $ T.unpack s) -parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI_ (T.unpack s) +parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left . Acct <$> toRegexCI (T.unpack s) parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e Right (_,span) -> Right $ Left $ Date2 span @@ -276,7 +283,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) | otherwise = Left "depth: should have a positive number" where n = readDef 0 (T.unpack s) -parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI_ ('^' : T.unpack s ++ "$") -- support cur: as an alias +parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ('^' : T.unpack s ++ "$") -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s @@ -327,8 +334,8 @@ parseAmountQueryTerm amtarg = parseTag :: T.Text -> Either RegexError Query parseTag s = do - tag <- toRegexCI_ . T.unpack $ if T.null v then s else n - body <- if T.null v then pure Nothing else Just <$> toRegexCI_ (tail $ T.unpack v) + tag <- toRegexCI . T.unpack $ if T.null v then s else n + body <- if T.null v then pure Nothing else Just <$> toRegexCI (tail $ T.unpack v) return $ Tag tag body where (n,v) = T.break (=='=') s @@ -551,7 +558,7 @@ matchesAccount (None) _ = False matchesAccount (Not m) a = not $ matchesAccount m a matchesAccount (Or ms) a = any (`matchesAccount` a) ms matchesAccount (And ms) a = all (`matchesAccount` a) ms -matchesAccount (Acct r) a = match r (T.unpack a) -- XXX pack +matchesAccount (Acct r) a = regexMatch r $ T.unpack a -- XXX pack matchesAccount (Depth d) a = accountNameLevel a <= d matchesAccount (Tag _ _) _ = False matchesAccount _ _ = True @@ -561,7 +568,7 @@ matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as matchesCommodity :: Query -> CommoditySymbol -> Bool -matchesCommodity (Sym r) = match r . T.unpack +matchesCommodity (Sym r) = regexMatch r . T.unpack matchesCommodity _ = const True -- | Does the match expression match this (simple) amount ? @@ -600,10 +607,10 @@ matchesPosting (Any) _ = True matchesPosting (None) _ = False matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs -matchesPosting (Code r) p = match r $ maybe "" (T.unpack . tcode) $ ptransaction p -matchesPosting (Desc r) p = match r $ maybe "" (T.unpack . tdescription) $ ptransaction p +matchesPosting (Code r) p = regexMatch r $ maybe "" (T.unpack . tcode) $ ptransaction p +matchesPosting (Desc r) p = regexMatch r $ maybe "" (T.unpack . tdescription) $ ptransaction p matchesPosting (Acct r) p = matches p || matches (originalPosting p) - where matches p = match r . T.unpack $ paccount p -- XXX pack + where matches p = regexMatch r . T.unpack $ paccount p -- XXX pack matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s @@ -617,8 +624,8 @@ matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt matchesPosting (Empty _) _ = True matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as matchesPosting (Tag n v) p = case (reString n, v) of - ("payee", Just v) -> maybe False (match v . T.unpack . transactionPayee) $ ptransaction p - ("note", Just v) -> maybe False (match v . T.unpack . transactionNote) $ ptransaction p + ("payee", Just v) -> maybe False (regexMatch v . T.unpack . transactionPayee) $ ptransaction p + ("note", Just v) -> maybe False (regexMatch v . T.unpack . transactionNote) $ ptransaction p (_, v) -> matchesTags n v $ postingAllTags p -- | Does the match expression match this transaction ? @@ -628,8 +635,8 @@ matchesTransaction (Any) _ = True matchesTransaction (None) _ = False matchesTransaction (Or qs) t = any (`matchesTransaction` t) qs matchesTransaction (And qs) t = all (`matchesTransaction` t) qs -matchesTransaction (Code r) t = match r $ T.unpack $ tcode t -matchesTransaction (Desc r) t = match r $ T.unpack $ tdescription t +matchesTransaction (Code r) t = regexMatch r $ T.unpack $ tcode t +matchesTransaction (Desc r) t = regexMatch r $ T.unpack $ tdescription t matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t @@ -640,15 +647,15 @@ matchesTransaction (Empty _) _ = True matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Tag n v) t = case (reString n, v) of - ("payee", Just v) -> match v . T.unpack . transactionPayee $ t - ("note", Just v) -> match v . T.unpack . transactionNote $ t + ("payee", Just v) -> regexMatch v . T.unpack . transactionPayee $ t + ("note", Just v) -> regexMatch v . T.unpack . transactionNote $ t (_, v) -> matchesTags n v $ transactionAllTags t -- | Does the query match the name and optionally the value of any of these tags ? matchesTags :: Regexp -> Maybe Regexp -> [Tag] -> Bool matchesTags namepat valuepat = not . null . filter (matches namepat valuepat) where - matches npat vpat (n,v) = match npat (T.unpack n) && maybe (const True) match vpat (T.unpack v) + matches npat vpat (n,v) = regexMatch npat (T.unpack n) && maybe (const True) regexMatch vpat (T.unpack v) -- | Does the query match this market price ? matchesPriceDirective :: Query -> PriceDirective -> Bool diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 4ff896627..bd7751926 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -144,7 +144,7 @@ import Text.Megaparsec.Custom finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) import Hledger.Data -import Hledger.Utils hiding (match) +import Hledger.Utils --- ** doctest setup -- $setup diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index eb5f36c1c..612ffc058 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -661,7 +661,7 @@ regexp end = do -- notFollowedBy matchoperatorp c <- lift nonspace cs <- anySingle `manyTill` end - case toRegexCI_ . strip $ c:cs of + case toRegexCI . strip $ c:cs of Left x -> Fail.fail $ "CSV parser: " ++ x Right x -> return x @@ -1181,7 +1181,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments where -- does this individual matcher match the current csv record ? matcherMatches :: Matcher -> Bool - matcherMatches (RecordMatcher _ pat) = match pat' wholecsvline + matcherMatches (RecordMatcher _ pat) = regexMatch pat' wholecsvline where pat' = dbg7 "regex" pat -- A synthetic whole CSV record to match against. Note, this can be @@ -1191,7 +1191,7 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments -- - and the field separator is always comma -- which means that a field containing a comma will look like two fields. wholecsvline = dbg7 "wholecsvline" $ intercalate "," record - matcherMatches (FieldMatcher _ csvfieldref pat) = match pat csvfieldvalue + matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue where -- the value of the referenced CSV field to match against. csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 3d2749d5c..509069f8f 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -529,7 +529,7 @@ regexaliasp = do char '=' skipNonNewlineSpaces repl <- anySingle `manyTill` eolof - case toRegexCI_ re of + case toRegexCI re of Right r -> return $! RegexAlias r repl Left e -> customFailure $! parseErrorAtRegion off1 off2 e diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index 5482b7107..f57934ad2 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -29,14 +29,12 @@ functions have memoised variants (*Memo), which also trade space for time. Currently two APIs are provided: -- The old partial one which will call error on any problem (eg with malformed - regexps). This comes from hledger's origin as a command-line tool. +- The old partial one (with ' suffixes') which will call error on any problem + (eg with malformed regexps). This comes from hledger's origin as a + command-line tool. -- The new total one (with _ suffixes) which will return an error message. This - is better for long-running apps like hledger-web. - -We are gradually replacing usage of the old API in hledger. Probably at some -point the suffixless names will be reclaimed for the new API. +- The new total one which will return an error message. This is better for + long-running apps like hledger-web. Current limitations: @@ -47,31 +45,18 @@ Current limitations: module Hledger.Utils.Regex ( -- * Regexp type and constructors Regexp(reString) - ,toRegex_ - ,toRegexCI_ + ,toRegex + ,toRegexCI ,toRegex' ,toRegexCI' -- * type aliases ,Replacement ,RegexError - -- * partial regex operations (may call error) --- ,regexMatches --- ,regexMatchesCI --- ,regexReplaceCI --- ,regexReplaceCIMemo --- ,regexReplaceByCI -- * total regex operations - ,match + ,regexMatch ,regexReplace - ,regexReplaceMemo_ --- ,replaceAllBy --- ,regexMatches_ --- ,regexMatchesCI_ --- ,regexReplace_ --- ,regexReplaceCI_ --- ,regexReplaceMemo_ --- ,regexReplaceCIMemo_ - ,replaceAllBy + ,regexReplaceUnmemo + ,regexReplaceAllBy ) where @@ -139,12 +124,12 @@ instance RegexContext Regexp String String where matchM = matchM . reCompiled -- Convert a Regexp string to a compiled Regex, or return an error message. -toRegex_ :: String -> Either RegexError Regexp -toRegex_ = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s) +toRegex :: String -> Either RegexError Regexp +toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s) --- Like toRegex_, but make a case-insensitive Regex. -toRegexCI_ :: String -> Either RegexError Regexp -toRegexCI_ = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s) +-- Like toRegex, but make a case-insensitive Regex. +toRegexCI :: String -> Either RegexError Regexp +toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s) -- | Make a nice error message for a regexp error. mkRegexErr :: String -> Maybe a -> Either RegexError a @@ -153,11 +138,11 @@ mkRegexErr s = maybe (Left errmsg) Right -- Convert a Regexp string to a compiled Regex, throw an error toRegex' :: String -> Regexp -toRegex' = either error' id . toRegex_ +toRegex' = either error' id . toRegex -- Like toRegex', but make a case-insensitive Regex. toRegexCI' :: String -> Regexp -toRegexCI' = either error' id . toRegexCI_ +toRegexCI' = either error' id . toRegexCI -- | A replacement pattern. May include numeric backreferences (\N). type Replacement = String @@ -167,44 +152,30 @@ type RegexError = String -- helpers -regexReplace :: Regexp -> Replacement -> String -> String -regexReplace re repl s = foldl (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) - where - replaceMatch :: Replacement -> String -> MatchText String -> String - replaceMatch replpat s matchgroups = pre ++ repl ++ post - where - ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match - (pre, post') = splitAt off s - post = drop len post' - repl = replaceAllBy backrefRegex (lookupMatchGroup matchgroups) replpat - where - lookupMatchGroup :: MatchText String -> String -> String - lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = - case read s of n | n `elem` indices grps -> fst (grps ! n) - -- PARTIAL: - _ -> error' $ "no match group exists for backreference \"\\"++s++"\"" - lookupMatchGroup _ s = error' $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" - backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not error happen +-- | Test whether a Regexp matches a String. This is an alias for `matchTest` for consistent +-- naming. +regexMatch :: Regexp -> String -> Bool +regexMatch = matchTest -------------------------------------------------------------------------------- -- new total functions --- | A memoising version of regexReplace_. Caches the result for each +-- | A memoising version of regexReplace. Caches the result for each -- search pattern, replacement pattern, target string tuple. -regexReplaceMemo_ :: Regexp -> Replacement -> String -> Either RegexError String -regexReplaceMemo_ re repl = memo (replaceRegexUnmemo_ re repl) +regexReplace :: Regexp -> Replacement -> String -> Either RegexError String +regexReplace re repl = memo $ regexReplaceUnmemo re repl -- helpers: -- Replace this regular expression with this replacement pattern in this -- string, or return an error message. -replaceRegexUnmemo_ :: Regexp -> Replacement -> String -> Either RegexError String -replaceRegexUnmemo_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) +regexReplaceUnmemo :: Regexp -> Replacement -> String -> Either RegexError String +regexReplaceUnmemo re repl s = foldM (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) where -- Replace one match within the string with the replacement text -- appropriate for this match. Or return an error message. - replaceMatch_ :: Replacement -> String -> MatchText String -> Either RegexError String - replaceMatch_ replpat s matchgroups = + replaceMatch :: Replacement -> String -> MatchText String -> Either RegexError String + replaceMatch replpat s matchgroups = erepl >>= \repl -> Right $ pre ++ repl ++ post where ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match @@ -213,25 +184,46 @@ replaceRegexUnmemo_ re repl s = foldM (replaceMatch_ repl) s (reverse $ match (r -- The replacement text: the replacement pattern with all -- numeric backreferences replaced by the appropriate groups -- from this match. Or an error message. - erepl = replaceAllByM backrefRegex (lookupMatchGroup_ matchgroups) replpat + erepl = regexReplaceAllByM backrefRegex (lookupMatchGroup matchgroups) replpat where -- Given some match groups and a numeric backreference, -- return the referenced group text, or an error message. - lookupMatchGroup_ :: MatchText String -> String -> Either RegexError String - lookupMatchGroup_ grps ('\\':s@(_:_)) | all isDigit s = + lookupMatchGroup :: MatchText String -> String -> Either RegexError String + lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = case read s of n | n `elem` indices grps -> Right $ fst (grps ! n) _ -> Left $ "no match group exists for backreference \"\\"++s++"\"" - lookupMatchGroup_ _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" + lookupMatchGroup _ s = Left $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not happen +-- regexReplace' :: Regexp -> Replacement -> String -> String +-- regexReplace' re repl s = +-- foldl (replaceMatch repl) s (reverse $ match (reCompiled re) s :: [MatchText String]) +-- where +-- replaceMatch :: Replacement -> String -> MatchText String -> String +-- replaceMatch replpat s matchgroups = pre ++ repl ++ post +-- where +-- ((_,(off,len)):_) = elems matchgroups -- groups should have 0-based indexes, and there should always be at least one, since this is a match +-- (pre, post') = splitAt off s +-- post = drop len post' +-- repl = regexReplaceAllBy backrefRegex (lookupMatchGroup matchgroups) replpat +-- where +-- lookupMatchGroup :: MatchText String -> String -> String +-- lookupMatchGroup grps ('\\':s@(_:_)) | all isDigit s = +-- case read s of n | n `elem` indices grps -> fst (grps ! n) +-- -- PARTIAL: +-- _ -> error' $ "no match group exists for backreference \"\\"++s++"\"" +-- lookupMatchGroup _ s = error' $ "lookupMatchGroup called on non-numeric-backreference \""++s++"\", shouldn't happen" +-- backrefRegex = toRegex' "\\\\[0-9]+" -- PARTIAL: should not error happen + + -- helpers -- adapted from http://stackoverflow.com/questions/9071682/replacement-substition-with-haskell-regex-libraries: -- Replace all occurrences of a regexp in a string, transforming each match -- with the given pure function. -replaceAllBy :: Regexp -> (String -> String) -> String -> String -replaceAllBy re transform s = prependdone rest +regexReplaceAllBy :: Regexp -> (String -> String) -> String -> String +regexReplaceAllBy re transform s = prependdone rest where (_, rest, prependdone) = foldl' go (0, s, id) matches where @@ -246,9 +238,9 @@ replaceAllBy re transform s = prependdone rest -- with the given monadic function. Eg if the monad is Either, a Left result -- from the transform function short-circuits and is returned as the overall -- result. -replaceAllByM :: forall m. Monad m => Regexp -> (String -> m String) -> String -> m String -replaceAllByM re transform s = - foldM go (0, s, id) matches >>= \(_, rest, prependdone) -> pure $ prependdone rest +regexReplaceAllByM :: forall m. Monad m => Regexp -> (String -> m String) -> String -> m String +regexReplaceAllByM re transform s = + foldM go (0, s, id) matches >>= \(_, rest, prependdone) -> pure $ prependdone rest where matches = getAllMatches $ match (reCompiled re) s :: [(Int, Int)] -- offset and length go :: (Int,String,String->String) -> (Int,Int) -> m (Int,String,String->String) @@ -256,4 +248,3 @@ replaceAllByM re transform s = let (prematch, matchandrest) = splitAt (off - pos) todo (matched, rest) = splitAt len matchandrest in transform matched >>= \matched' -> pure (off + len, rest, prepend . (prematch++) . (matched' ++)) - diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 2e144f422..414831611 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -90,7 +90,7 @@ asInit d reset ui@UIState{ excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction And [ Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) - ,Not (Tag (toRegexCI' "generated-transaction") Nothing) + ,Not generatedTransactionTag ] -- run the report diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 612631d9d..7c6ba4bc4 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -120,9 +120,11 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop -- to that as usual. Just apat -> (rsSetAccount acct False registerScreen, [ascr']) where - acct = headDef - (error' $ "--register "++apat++" did not match any account") -- PARTIAL: - $ filter (match (toRegexCI' apat) . T.unpack) $ journalAccountNames j + acct = headDef (error' $ "--register "++apat++" did not match any account") -- PARTIAL: + . filterAccts $ journalAccountNames j + filterAccts = case toRegexCI apat of + Right re -> filter (regexMatch re . T.unpack) + Left _ -> const [] -- Initialising the accounts screen is awkward, requiring -- another temporary UIState value.. ascr' = aScreen $ diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 5893f32a2..8424fef35 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -76,7 +76,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction And [ Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) - ,Not (Tag (toRegexCI' "generated-transaction") Nothing) + ,Not generatedTransactionTag ] (_label,items) = accountTransactionsReport ropts' j q thisacctq diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 5be44e257..73d50d005 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -79,9 +79,11 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL: let (apat:queryargs) = args' - apatregex = toRegex' apat -- PARTIAL: do better - acct = headDef (error' $ show apat++" did not match any account") $ -- PARTIAL: - filter (match apatregex . T.unpack) $ journalAccountNames j + acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL: + . filterAccts $ journalAccountNames j + filterAccts = case toRegexCI apat of + Right re -> filter (regexMatch re . T.unpack) + Left _ -> const [] -- gather report options inclusive = True -- tree_ ropts thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct @@ -100,7 +102,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do excludeforecastq False = -- not:date:tomorrow- not:tag:generated-transaction And [ Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) - ,Not (Tag (toRegex' "generated-transaction") Nothing) + ,Not generatedTransactionTag ] -- run the report -- TODO: need to also pass the queries so we can choose which date to render - move them into the report ? diff --git a/hledger/Hledger/Cli/Commands/Files.hs b/hledger/Hledger/Cli/Commands/Files.hs index 1d80f28f8..49e8757c6 100644 --- a/hledger/Hledger/Cli/Commands/Files.hs +++ b/hledger/Hledger/Cli/Commands/Files.hs @@ -33,8 +33,8 @@ filesmode = hledgerCommandMode files :: CliOpts -> Journal -> IO () files CliOpts{rawopts_=rawopts} j = do let args = listofstringopt "args" rawopts - regex <- mapM (either fail pure . toRegex_) $ headMay args - let files = maybe id (filter . match) regex + regex <- mapM (either fail pure . toRegex) $ headMay args + let files = maybe id (filter . regexMatch) regex $ map fst $ jfiles j mapM_ putStrLn files diff --git a/hledger/Hledger/Cli/Commands/Tags.hs b/hledger/Hledger/Cli/Commands/Tags.hs index c6e395226..82410706f 100755 --- a/hledger/Hledger/Cli/Commands/Tags.hs +++ b/hledger/Hledger/Cli/Commands/Tags.hs @@ -30,7 +30,7 @@ tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do d <- getCurrentDay let args = listofstringopt "args" rawopts - mtagpat <- mapM (either Fail.fail pure . toRegexCI_) $ headMay args + mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args let queryargs = drop 1 args values = boolopt "values" rawopts @@ -42,7 +42,7 @@ tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do (if parsed then id else nubSort) [ r | (t,v) <- concatMap transactionAllTags txns - , maybe True (`match` T.unpack t) mtagpat + , maybe True (`regexMatch` T.unpack t) mtagpat , let r = if values then v else t , not (values && T.null v && not empty) ]