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

lib, journal: parseQuery, modifyTransactions are now total (#1312)

Browse Source 
modifyTransactions now also requires a reference date, for parsing queries.
Relative dates are now permitted in auto posting rules.
This commit is contained in:
Simon Michael 2020-08-05 13:41:13 -07:00
parent 7751d6947c
commit 242c05fc9a
7 changed files with 128 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
hledger-lib/Hledger/Data/Journal.hs
View File

@ -590,10 +590,15 @@ journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts}
journalUntieTransactions :: Transaction -> Transaction journalUntieTransactions :: Transaction -> Transaction
journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps}
-- | Apply any transaction modifier rules in the journal -- | Apply any transaction modifier rules in the journal (adding automated
-- (adding automated postings to transactions, eg). -- postings to transactions, eg). Or if a modifier rule fails to parse,
journalModifyTransactions :: Journal -> Journal -- return the error message. A reference date is provided to help interpret
journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (jtxns j) } -- relative dates in transaction modifier queries.
journalModifyTransactions :: Day -> Journal -> Either String Journal
journalModifyTransactions d j =
case modifyTransactions d (jtxnmodifiers j) (jtxns j) of
Right ts -> Right j{jtxns=ts}
Left err -> Left err
-- | Check any balance assertions in the journal and return an error message -- | Check any balance assertions in the journal and return an error message
-- if any of them fail (or if the transaction balancing they require fails). -- if any of them fail (or if the transaction balancing they require fails).

65
hledger-lib/Hledger/Data/TransactionModifier.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
@ -25,7 +26,6 @@ import Hledger.Data.Amount
import Hledger.Data.Transaction import Hledger.Data.Transaction
import Hledger.Query import Hledger.Query
import Hledger.Data.Posting (commentJoin, commentAddTag) import Hledger.Data.Posting (commentJoin, commentAddTag)
import Hledger.Utils.UTF8IOCompat (error')
import Hledger.Utils.Debug import Hledger.Utils.Debug
-- $setup -- $setup
@ -35,25 +35,32 @@ import Hledger.Utils.Debug
-- >>> import Hledger.Data.Journal -- >>> import Hledger.Data.Journal
-- | Apply all the given transaction modifiers, in turn, to each transaction. -- | Apply all the given transaction modifiers, in turn, to each transaction.
modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction] -- Or if any of them fails to be parsed, return the first error. A reference
modifyTransactions tmods = map applymods -- date is provided to help interpret relative dates in transaction modifier
-- queries.
modifyTransactions :: Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
modifyTransactions d tmods ts = do
fs <- mapM (transactionModifierToFunction d) tmods -- convert modifiers to functions, or return a parse error
let
modifytxn t = t''
where where
applymods t = taggedt' t' = foldr (flip (.)) id fs t -- apply each function in turn
where t'' = if t' == t -- and add some tags if it was changed
t' = foldr (flip (.) . transactionModifierToFunction) id tmods t then t'
taggedt' else t'{tcomment=tcomment t' `commentAddTag` ("modified",""), ttags=("modified","") : ttags t'}
-- PERF: compares txns to see if any modifier had an effect, inefficient ? Right $ map modifytxn ts
| t' /= t = t'{tcomment = tcomment t' `commentAddTag` ("modified","")
,ttags = ("modified","") : ttags t'
}
| otherwise = t'
-- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function, -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function
-- which applies the modification(s) specified by the TransactionModifier. -- which applies the modification(s) specified by the TransactionModifier.
-- Currently this means adding automated postings when certain other postings are present. -- Or, returns the error message there is a problem parsing the TransactionModifier's query.
-- A reference date is provided to help interpret relative dates in the query.
--
-- The postings of the transformed transaction will reference it in the usual -- The postings of the transformed transaction will reference it in the usual
-- way (ie, 'txnTieKnot' is called). -- way (ie, 'txnTieKnot' is called).
-- --
-- Currently the only kind of modification possible is adding automated
-- postings when certain other postings are present.
--
-- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
-- 0000-01-01 -- 0000-01-01
-- ping $1.00 -- ping $1.00
@ -69,30 +76,14 @@ modifyTransactions tmods = map applymods
-- pong $6.00 ; generated-posting: = ping -- pong $6.00 ; generated-posting: = ping
-- <BLANKLINE> -- <BLANKLINE>
-- --
transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction) transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction)
transactionModifierToFunction mt = transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do
\t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt
where let
q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date") fs = map (tmPostingRuleToFunction tmquerytxt) tmpostingrules
mods = map (tmPostingRuleToFunction (tmquerytxt mt)) $ tmpostingrules mt
generatePostings ps = [p' | p <- ps generatePostings ps = [p' | p <- ps
, p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]] , p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]]
Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}
-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt',
-- and return it as a function requiring the current date.
--
-- >>> tmParseQuery (TransactionModifier "" []) undefined
-- Any
-- >>> tmParseQuery (TransactionModifier "ping" []) undefined
-- Acct "ping"
-- >>> tmParseQuery (TransactionModifier "date:2016" []) undefined
-- Date (DateSpan 2016)
-- >>> tmParseQuery (TransactionModifier "date:today" []) (read "2017-01-01")
-- Date (DateSpan 2017-01-01)
-- >>> tmParseQuery (TransactionModifier "date:today" []) (read "2017-01-01")
-- Date (DateSpan 2017-01-01)
tmParseQuery :: TransactionModifier -> (Day -> Query)
tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt)
-- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function,
-- which will be used to make a new posting based on the old one (an "automated posting"). -- which will be used to make a new posting based on the old one (an "automated posting").

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

@ -177,18 +177,24 @@ data QueryOpt = QueryOptInAcctOnly AccountName -- ^ show an account register fo
-- 4. then all terms are AND'd together -- 4. then all terms are AND'd together
-- --
-- >>> parseQuery nulldate "expenses:dining out" -- >>> parseQuery nulldate "expenses:dining out"
-- (Or ([Acct "expenses:dining",Acct "out"]),[]) -- Right (Or ([Acct "expenses:dining",Acct "out"]),[])
--
-- >>> parseQuery nulldate "\"expenses:dining out\"" -- >>> parseQuery nulldate "\"expenses:dining out\""
-- (Acct "expenses:dining out",[]) -- Right (Acct "expenses:dining out",[])
parseQuery :: Day -> T.Text -> (Query,[QueryOpt]) --
parseQuery d s = (q, opts) -- >>> isLeft $ parseQuery nulldate "\"\""
where -- True
terms = words'' prefixes s --
(pats, opts) = partitionEithers $ map (parseQueryTerm d) terms parseQuery :: Day -> T.Text -> Either String (Query,[QueryOpt])
parseQuery d s = do
let termstrs = words'' prefixes s
eterms <- sequence $ map (parseQueryTerm d) termstrs
let (pats, opts) = partitionEithers eterms
(descpats, pats') = partition queryIsDesc pats (descpats, pats') = partition queryIsDesc pats
(acctpats, pats'') = partition queryIsAcct pats' (acctpats, pats'') = partition queryIsAcct pats'
(statuspats, otherpats) = partition queryIsStatus pats'' (statuspats, otherpats) = partition queryIsStatus pats''
q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats
Right (q, opts)
-- XXX -- XXX
-- | Quote-and-prefix-aware version of words - don't split on spaces which -- | Quote-and-prefix-aware version of words - don't split on spaces which
@ -252,39 +258,40 @@ defaultprefix = "acct"
-- query = undefined -- query = undefined
-- | Parse a single query term as either a query or a query option, -- | Parse a single query term as either a query or a query option,
-- or raise an error if it has invalid syntax. -- or return an error message if parsing fails.
parseQueryTerm :: Day -> T.Text -> Either Query QueryOpt parseQueryTerm :: Day -> T.Text -> Either String (Either Query QueryOpt)
parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ QueryOptInAcctOnly s parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ Right $ QueryOptInAcctOnly s
parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ QueryOptInAcct s parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ Right $ QueryOptInAcct s
parseQueryTerm d (T.stripPrefix "not:" -> Just s) = parseQueryTerm d (T.stripPrefix "not:" -> Just s) =
case parseQueryTerm d s of case parseQueryTerm d s of
Left m -> Left $ Not m Right (Left m) -> Right $ Left $ Not m
Right _ -> Left Any -- not:somequeryoption will be ignored Right (Right _) -> Right $ Left Any -- not:somequeryoption will be ignored
parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left $ Code $ T.unpack s Left err -> Left err
parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left $ Desc $ T.unpack s parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Right $ Left $ Code $ T.unpack s
parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left $ Tag "payee" $ Just $ T.unpack s parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Right $ Left $ Desc $ T.unpack s
parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left $ Tag "note" $ Just $ T.unpack s parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Right $ Left $ Tag "payee" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left $ Acct $ T.unpack s parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Right $ Left $ Tag "note" $ Just $ T.unpack s
parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Right $ Left $ Acct $ T.unpack s
parseQueryTerm d (T.stripPrefix "date2:" -> Just s) = parseQueryTerm d (T.stripPrefix "date2:" -> Just s) =
case parsePeriodExpr d s of Left e -> error' $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e case parsePeriodExpr d s of Left e -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Left $ Date2 span Right (_,span) -> Right $ Left $ Date2 span
parseQueryTerm d (T.stripPrefix "date:" -> Just s) = parseQueryTerm d (T.stripPrefix "date:" -> Just s) =
case parsePeriodExpr d s of Left e -> error' $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e case parsePeriodExpr d s of Left e -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e
Right (_,span) -> Left $ Date span Right (_,span) -> Right $ Left $ Date span
parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
case parseStatus s of Left e -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e case parseStatus s of Left e -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
Right st -> Left $ StatusQ st Right st -> Right $ Left $ StatusQ st
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Left $ Real $ parseBool s || T.null s parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right $ Left $ Real $ parseBool s || T.null s
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right $ Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Left $ Empty $ parseBool s parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Right $ Left $ Empty $ parseBool s
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
| n >= 0 = Left $ Depth n | n >= 0 = Right $ Left $ Depth n
| otherwise = error' "depth: should have a positive number" | otherwise = Left "depth: should have a positive number"
where n = readDef 0 (T.unpack s) where n = readDef 0 (T.unpack s)
parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left $ Sym (T.unpack s) -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Right $ Left $ Sym (T.unpack s) -- support cur: as an alias
parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left $ Tag n v where (n,v) = parseTag s parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Right $ Left $ Tag n v where (n,v) = parseTag s
parseQueryTerm _ "" = Left $ Any parseQueryTerm _ "" = Right $ Left $ Any
parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s
-- | 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
@ -683,12 +690,12 @@ tests_Query = tests "Query" [
(simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b") (simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b")
,test "parseQuery" $ do ,test "parseQuery" $ do
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= (And [Acct "expenses:autres d\233penses", Desc "b"], []) (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct "expenses:autres d\233penses", Desc "b"], [])
parseQuery nulldate "inacct:a desc:\"b b\"" @?= (Desc "b b", [QueryOptInAcct "a"]) parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
parseQuery nulldate "desc:'x x'" @?= (Desc "x x", []) parseQuery nulldate "desc:'x x'" @?= Right (Desc "x x", [])
parseQuery nulldate "'a a' 'b" @?= (Or [Acct "a a",Acct "'b"], []) parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct "a a",Acct "'b"], [])
parseQuery nulldate "\"" @?= (Acct "\"", []) parseQuery nulldate "\"" @?= Right (Acct "\"", [])
,test "words''" $ do ,test "words''" $ do
(words'' [] "a b") @?= ["a","b"] (words'' [] "a b") @?= ["a","b"]
@ -707,25 +714,25 @@ tests_Query = tests "Query" [
filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear
,test "parseQueryTerm" $ do ,test "parseQueryTerm" $ do
parseQueryTerm nulldate "a" @?= (Left $ Acct "a") parseQueryTerm nulldate "a" @?= Right (Left $ Acct "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= (Left $ Acct "expenses:autres d\233penses") parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct "expenses:autres d\233penses")
parseQueryTerm nulldate "not:desc:a b" @?= (Left $ Not $ Desc "a b") parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc "a b")
parseQueryTerm nulldate "status:1" @?= (Left $ StatusQ Cleared) parseQueryTerm nulldate "status:1" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:*" @?= (Left $ StatusQ Cleared) parseQueryTerm nulldate "status:*" @?= Right (Left $ StatusQ Cleared)
parseQueryTerm nulldate "status:!" @?= (Left $ StatusQ Pending) parseQueryTerm nulldate "status:!" @?= Right (Left $ StatusQ Pending)
parseQueryTerm nulldate "status:0" @?= (Left $ StatusQ Unmarked) parseQueryTerm nulldate "status:0" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "status:" @?= (Left $ StatusQ Unmarked) parseQueryTerm nulldate "status:" @?= Right (Left $ StatusQ Unmarked)
parseQueryTerm nulldate "payee:x" @?= (Left $ Tag "payee" (Just "x")) parseQueryTerm nulldate "payee:x" @?= Right (Left $ Tag "payee" (Just "x"))
parseQueryTerm nulldate "note:x" @?= (Left $ Tag "note" (Just "x")) parseQueryTerm nulldate "note:x" @?= Right (Left $ Tag "note" (Just "x"))
parseQueryTerm nulldate "real:1" @?= (Left $ Real True) parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True)
parseQueryTerm nulldate "date:2008" @?= (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01"))
parseQueryTerm nulldate "date:from 2012/5/17" @?= (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01"))
parseQueryTerm nulldate "inacct:a" @?= (Right $ QueryOptInAcct "a") parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a")
parseQueryTerm nulldate "tag:a" @?= (Left $ Tag "a" Nothing) parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag "a" Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= (Left $ Tag "a" (Just "some value")) parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag "a" (Just "some value"))
parseQueryTerm nulldate "amt:<0" @?= (Left $ Amt Lt 0) parseQueryTerm nulldate "amt:<0" @?= Right (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1) parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1)
,test "parseAmountQueryTerm" $ do ,test "parseAmountQueryTerm" $ do
parseAmountQueryTerm "<0" @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false parseAmountQueryTerm "<0" @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false

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

@ -298,6 +298,7 @@ parseAndFinaliseJournal' parser iopts f txt = do
journalFinalise :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal journalFinalise :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal
journalFinalise iopts f txt pj = do journalFinalise iopts f txt pj = do
t <- liftIO getClockTime t <- liftIO getClockTime
d <- liftIO getCurrentDay
-- Infer and apply canonical styles for each commodity (or fail). -- Infer and apply canonical styles for each commodity (or fail).
-- This affects transaction balancing/assertions/assignments, so needs to be done early. -- This affects transaction balancing/assertions/assignments, so needs to be done early.
-- (TODO: since #903's refactoring for hledger 1.12, -- (TODO: since #903's refactoring for hledger 1.12,
@ -322,7 +323,9 @@ journalFinalise iopts f txt pj = do
-- then add the auto postings -- then add the auto postings
-- (Note adding auto postings after balancing means #893b fails; -- (Note adding auto postings after balancing means #893b fails;
-- adding them before balancing probably means #893a, #928, #938 fail.) -- adding them before balancing probably means #893a, #928, #938 fail.)
let j'' = journalModifyTransactions j' case journalModifyTransactions d j' of
Left e -> throwError e
Right j'' -> do
-- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?)
j''' <- journalApplyCommodityStyles j'' j''' <- journalApplyCommodityStyles j''
-- then check balance assertions. -- then check balance assertions.

6
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -461,11 +461,12 @@ journalSelectingAmountFromOpts opts =
_ -> id _ -> id
-- | Convert report options and arguments to a query. -- | Convert report options and arguments to a query.
-- If there is a parsing problem, this function calls error.
queryFromOpts :: Day -> ReportOpts -> Query queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq] queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq]
where where
flagsq = queryFromOptsOnly d ropts flagsq = queryFromOptsOnly d ropts
argsq = fst $ parseQuery d (T.pack $ query_ ropts) argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- TODO:
-- | Convert report options to a query, ignoring any non-flag command line arguments. -- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromOptsOnly :: Day -> ReportOpts -> Query queryFromOptsOnly :: Day -> ReportOpts -> Query
@ -481,8 +482,9 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
consJust f = maybe id ((:) . f) consJust f = maybe id ((:) . f)
-- | Convert report options and arguments to query options. -- | Convert report options and arguments to query options.
-- If there is a parsing problem, this function calls error.
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt] queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d = snd . parseQuery d . T.pack . query_ queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_
-- Report dates. -- Report dates.

3
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -38,8 +38,9 @@ rewritemode = hledgerCommandMode
rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do
-- rewrite matched transactions -- rewrite matched transactions
d <- getCurrentDay
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
let j' = j{jtxns=modifyTransactions modifiers ts} let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts}
-- run the print command, showing all transactions, or show diffs -- run the print command, showing all transactions, or show diffs
printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j' printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'

14
hledger/Hledger/Cli/Utils.hs
View File

@ -108,10 +108,12 @@ anonymiseByOpts opts =
-- | Generate periodic transactions from all periodic transaction rules in the journal. -- | Generate periodic transactions from all periodic transaction rules in the journal.
-- These transactions are added to the in-memory Journal (but not the on-disk file). -- These transactions are added to the in-memory Journal (but not the on-disk file).
-- --
-- They can start no earlier than: the day following the latest normal -- When --auto is active, auto posting rules will be applied to the
-- transaction in the journal (or today if there are none). -- generated transactions. If the query in any auto posting rule fails
-- They end on or before the specified report end date, or 180 days -- to parse, this function will raise an error.
-- from today if unspecified. --
-- The start & end date for generated periodic transactions are determined in
-- a somewhat complicated way; see the hledger manual -> Periodic transactions.
-- --
journalAddForecast :: CliOpts -> Journal -> IO Journal journalAddForecast :: CliOpts -> Journal -> IO Journal
journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
@ -136,7 +138,9 @@ journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
, spanContainsDate forecastspan (tdate t) , spanContainsDate forecastspan (tdate t)
] ]
-- With --auto enabled, transaction modifiers are also applied to forecast txns -- With --auto enabled, transaction modifiers are also applied to forecast txns
forecasttxns' = (if auto_ iopts then modifyTransactions (jtxnmodifiers j) else id) forecasttxns forecasttxns' =
(if auto_ iopts then either error' id . modifyTransactions today (jtxnmodifiers j) else id)
forecasttxns
return $ return $
case forecast_ ropts of case forecast_ ropts of