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

lib,cli,ui: Change to consistent naming scheme for Hledger.Utils.Regex.

Browse Source
This commit is contained in:
Stephen Morgan 2020-09-01 11:36:34 +10:00
parent b91b391d08
commit 07dd30c1e5
12 changed files with 109 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -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

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

@ -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

2
hledger-lib/Hledger/Read/Common.hs
View File

@ -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

6
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -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

2
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -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

125
hledger-lib/Hledger/Utils/Regex.hs
View File

@ -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' ++))

2
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -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

8
hledger-ui/Hledger/UI/Main.hs
View File

@ -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 $

2
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -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

10
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -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 ?

4
hledger/Hledger/Cli/Commands/Files.hs
View File

@ -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

4
hledger/Hledger/Cli/Commands/Tags.hs
View File

@ -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)
]