lib, journal: parseQuery, modifyTransactions are now total (#1312)
modifyTransactions now also requires a reference date, for parsing queries. Relative dates are now permitted in auto posting rules.
This commit is contained in:
		
							parent
							
								
									7751d6947c
								
							
						
					
					
						commit
						242c05fc9a
					
				| @ -590,10 +590,15 @@ journalTieTransactions j@Journal{jtxns=ts} = j{jtxns=map txnTieKnot ts} | ||||
| journalUntieTransactions :: Transaction -> Transaction | ||||
| journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} | ||||
| 
 | ||||
| -- | Apply any transaction modifier rules in the journal | ||||
| -- (adding automated postings to transactions, eg). | ||||
| journalModifyTransactions :: Journal -> Journal | ||||
| journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (jtxns j) } | ||||
| -- | Apply any transaction modifier rules in the journal (adding automated | ||||
| -- postings to transactions, eg). Or if a modifier rule fails to parse, | ||||
| -- return the error message. A reference date is provided to help interpret | ||||
| -- 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 | ||||
| -- if any of them fail (or if the transaction balancing they require fails). | ||||
|  | ||||
| @ -1,3 +1,4 @@ | ||||
| {-# LANGUAGE NamedFieldPuns #-} | ||||
| {-# LANGUAGE OverloadedStrings #-} | ||||
| {-# LANGUAGE ViewPatterns #-} | ||||
| {-# LANGUAGE CPP #-} | ||||
| @ -25,7 +26,6 @@ import Hledger.Data.Amount | ||||
| import Hledger.Data.Transaction | ||||
| import Hledger.Query | ||||
| import Hledger.Data.Posting (commentJoin, commentAddTag) | ||||
| import Hledger.Utils.UTF8IOCompat (error') | ||||
| import Hledger.Utils.Debug | ||||
| 
 | ||||
| -- $setup | ||||
| @ -35,25 +35,32 @@ import Hledger.Utils.Debug | ||||
| -- >>> import Hledger.Data.Journal | ||||
| 
 | ||||
| -- | Apply all the given transaction modifiers, in turn, to each transaction. | ||||
| modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction] | ||||
| modifyTransactions tmods = map applymods | ||||
|   where | ||||
|     applymods t = taggedt' | ||||
| -- Or if any of them fails to be parsed, return the first error. A reference | ||||
| -- 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 | ||||
|         t' = foldr (flip (.) . transactionModifierToFunction) id tmods t | ||||
|         taggedt' | ||||
|           -- PERF: compares txns to see if any modifier had an effect, inefficient ? | ||||
|           | t' /= t   = t'{tcomment = tcomment t' `commentAddTag` ("modified","") | ||||
|                           ,ttags    = ("modified","") : ttags t' | ||||
|                           } | ||||
|           | otherwise = t' | ||||
|         t' = foldr (flip (.)) id fs t  -- apply each function in turn | ||||
|         t'' = if t' == t  -- and add some tags if it was changed | ||||
|               then t' | ||||
|               else t'{tcomment=tcomment t' `commentAddTag` ("modified",""), ttags=("modified","") : ttags t'} | ||||
|   Right $ map modifytxn ts | ||||
| 
 | ||||
| -- | 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. | ||||
| -- 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 | ||||
| -- 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]} | ||||
| -- 0000-01-01 | ||||
| --     ping           $1.00 | ||||
| @ -69,30 +76,14 @@ modifyTransactions tmods = map applymods | ||||
| --     pong           $6.00  ; generated-posting: = ping | ||||
| -- <BLANKLINE> | ||||
| -- | ||||
| transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction) | ||||
| transactionModifierToFunction mt = | ||||
|   \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } | ||||
|   where | ||||
|     q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date") | ||||
|     mods = map (tmPostingRuleToFunction (tmquerytxt mt)) $ tmpostingrules mt | ||||
| transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction) | ||||
| transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do | ||||
|   q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt | ||||
|   let | ||||
|     fs = map (tmPostingRuleToFunction tmquerytxt) tmpostingrules | ||||
|     generatePostings ps = [p' | p <- ps | ||||
|                               , p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]] | ||||
| 
 | ||||
| -- | 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) | ||||
|                               , p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]] | ||||
|   Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} | ||||
| 
 | ||||
| -- | 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"). | ||||
|  | ||||
| @ -177,18 +177,24 @@ data QueryOpt = QueryOptInAcctOnly AccountName  -- ^ show an account register fo | ||||
| -- 4. then all terms are AND'd together | ||||
| -- | ||||
| -- >>> parseQuery nulldate "expenses:dining out" | ||||
| -- (Or ([Acct "expenses:dining",Acct "out"]),[]) | ||||
| -- Right (Or ([Acct "expenses:dining",Acct "out"]),[]) | ||||
| -- | ||||
| -- >>> parseQuery nulldate "\"expenses:dining out\"" | ||||
| -- (Acct "expenses:dining out",[]) | ||||
| parseQuery :: Day -> T.Text -> (Query,[QueryOpt]) | ||||
| parseQuery d s = (q, opts) | ||||
|   where | ||||
|     terms = words'' prefixes s | ||||
|     (pats, opts) = partitionEithers $ map (parseQueryTerm d) terms | ||||
|     (descpats, pats') = partition queryIsDesc pats | ||||
|     (acctpats, pats'') = partition queryIsAcct pats' | ||||
|     (statuspats, otherpats) = partition queryIsStatus pats'' | ||||
|     q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats | ||||
| -- Right (Acct "expenses:dining out",[]) | ||||
| -- | ||||
| -- >>> isLeft $ parseQuery nulldate "\"\"" | ||||
| -- True | ||||
| -- | ||||
| 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 | ||||
|       (acctpats, pats'') = partition queryIsAcct pats' | ||||
|       (statuspats, otherpats) = partition queryIsStatus pats'' | ||||
|       q = simplifyQuery $ And $ [Or acctpats, Or descpats, Or statuspats] ++ otherpats | ||||
|   Right (q, opts) | ||||
| 
 | ||||
| -- XXX | ||||
| -- | Quote-and-prefix-aware version of words - don't split on spaces which | ||||
| @ -252,39 +258,40 @@ defaultprefix = "acct" | ||||
| -- query = undefined | ||||
| 
 | ||||
| -- | Parse a single query term as either a query or a query option, | ||||
| -- or raise an error if it has invalid syntax. | ||||
| parseQueryTerm :: Day -> T.Text -> Either Query QueryOpt | ||||
| parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ QueryOptInAcctOnly s | ||||
| parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ QueryOptInAcct s | ||||
| -- or return an error message if parsing fails. | ||||
| parseQueryTerm :: Day -> T.Text -> Either String (Either Query QueryOpt) | ||||
| parseQueryTerm _ (T.stripPrefix "inacctonly:" -> Just s) = Right $ Right $ QueryOptInAcctOnly s | ||||
| parseQueryTerm _ (T.stripPrefix "inacct:" -> Just s) = Right $ Right $ QueryOptInAcct s | ||||
| parseQueryTerm d (T.stripPrefix "not:" -> Just s) = | ||||
|   case parseQueryTerm d s of | ||||
|     Left m -> Left $ Not m | ||||
|     Right _ -> Left Any -- not:somequeryoption will be ignored | ||||
| parseQueryTerm _ (T.stripPrefix "code:" -> Just s) = Left $ Code $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Left $ Desc $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Left $ Tag "payee" $ Just $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "note:" -> Just s) = Left $ Tag "note" $ Just $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "acct:" -> Just s) = Left $ Acct $ T.unpack 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) = Right $ Left $ Code $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "desc:" -> Just s) = Right $ Left $ Desc $ T.unpack s | ||||
| parseQueryTerm _ (T.stripPrefix "payee:" -> Just s) = Right $ Left $ Tag "payee" $ Just $ 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) = | ||||
|         case parsePeriodExpr d s of Left e         -> error' $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e | ||||
|                                     Right (_,span) -> Left $ Date2 span | ||||
|         case parsePeriodExpr d s of Left e         -> Left $ "\"date2:"++T.unpack s++"\" gave a "++showDateParseError e | ||||
|                                     Right (_,span) -> Right $ Left $ Date2 span | ||||
| parseQueryTerm d (T.stripPrefix "date:" -> Just s) = | ||||
|         case parsePeriodExpr d s of Left e         -> error' $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e | ||||
|                                     Right (_,span) -> Left $ Date span | ||||
|         case parsePeriodExpr d s of Left e         -> Left $ "\"date:"++T.unpack s++"\" gave a "++showDateParseError e | ||||
|                                     Right (_,span) -> Right $ Left $ Date span | ||||
| parseQueryTerm _ (T.stripPrefix "status:" -> Just s) = | ||||
|         case parseStatus s of Left e   -> error' $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e | ||||
|                               Right st -> Left $ StatusQ st | ||||
| parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = 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 "empty:" -> Just s) = Left $ Empty $ parseBool s | ||||
|         case parseStatus s of Left e   -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e | ||||
|                               Right st -> Right $ Left $ StatusQ st | ||||
| parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right $ Left $ Real $ parseBool s || T.null 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) = Right $ Left $ Empty $ parseBool s | ||||
| parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) | ||||
|   | n >= 0    = Left $ Depth n | ||||
|   | otherwise = error' "depth: should have a positive number" | ||||
|   | n >= 0    = Right $ Left $ Depth n | ||||
|   | otherwise = Left "depth: should have a positive number" | ||||
|   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 "tag:" -> Just s) = Left $ Tag n v where (n,v) = parseTag s | ||||
| parseQueryTerm _ "" = Left $ Any | ||||
| parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Right $ Left $ Sym (T.unpack s) -- support cur: as an alias | ||||
| parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Right $ Left $ Tag n v where (n,v) = parseTag s | ||||
| parseQueryTerm _ "" = Right $ Left $ Any | ||||
| parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s | ||||
| 
 | ||||
| -- | 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") | ||||
| 
 | ||||
|   ,test "parseQuery" $ do | ||||
|      (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= (And [Acct "expenses:autres d\233penses", Desc "b"], []) | ||||
|      parseQuery nulldate "inacct:a desc:\"b b\""                     @?= (Desc "b b", [QueryOptInAcct "a"]) | ||||
|      parseQuery nulldate "inacct:a inacct:b"                         @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) | ||||
|      parseQuery nulldate "desc:'x x'"                                @?= (Desc "x x", []) | ||||
|      parseQuery nulldate "'a a' 'b"                                  @?= (Or [Acct "a a",Acct "'b"], []) | ||||
|      parseQuery nulldate "\""                                        @?= (Acct "\"", []) | ||||
|      (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\""                       @?= Right (Desc "b b", [QueryOptInAcct "a"]) | ||||
|      parseQuery nulldate "inacct:a inacct:b"                           @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) | ||||
|      parseQuery nulldate "desc:'x x'"                                  @?= Right (Desc "x x", []) | ||||
|      parseQuery nulldate "'a a' 'b"                                    @?= Right (Or [Acct "a a",Acct "'b"], []) | ||||
|      parseQuery nulldate "\""                                          @?= Right (Acct "\"", []) | ||||
| 
 | ||||
|   ,test "words''" $ do | ||||
|       (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 | ||||
| 
 | ||||
|   ,test "parseQueryTerm" $ do | ||||
|      parseQueryTerm nulldate "a"                                @?= (Left $ Acct "a") | ||||
|      parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= (Left $ Acct "expenses:autres d\233penses") | ||||
|      parseQueryTerm nulldate "not:desc:a b"                     @?= (Left $ Not $ Desc "a b") | ||||
|      parseQueryTerm nulldate "status:1"                         @?= (Left $ StatusQ Cleared) | ||||
|      parseQueryTerm nulldate "status:*"                         @?= (Left $ StatusQ Cleared) | ||||
|      parseQueryTerm nulldate "status:!"                         @?= (Left $ StatusQ Pending) | ||||
|      parseQueryTerm nulldate "status:0"                         @?= (Left $ StatusQ Unmarked) | ||||
|      parseQueryTerm nulldate "status:"                          @?= (Left $ StatusQ Unmarked) | ||||
|      parseQueryTerm nulldate "payee:x"                          @?= (Left $ Tag "payee" (Just "x")) | ||||
|      parseQueryTerm nulldate "note:x"                           @?= (Left $ Tag "note" (Just "x")) | ||||
|      parseQueryTerm nulldate "real:1"                           @?= (Left $ Real True) | ||||
|      parseQueryTerm nulldate "date:2008"                        @?= (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:20180101-201804"             @?= (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) | ||||
|      parseQueryTerm nulldate "inacct:a"                         @?= (Right $ QueryOptInAcct "a") | ||||
|      parseQueryTerm nulldate "tag:a"                            @?= (Left $ Tag "a" Nothing) | ||||
|      parseQueryTerm nulldate "tag:a=some value"                 @?= (Left $ Tag "a" (Just "some value")) | ||||
|      parseQueryTerm nulldate "amt:<0"                           @?= (Left $ Amt Lt 0) | ||||
|      parseQueryTerm nulldate "amt:>10000.10"                    @?= (Left $ Amt AbsGt 10000.1) | ||||
|      parseQueryTerm nulldate "a"                                @?= Right (Left $ Acct "a") | ||||
|      parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct "expenses:autres d\233penses") | ||||
|      parseQueryTerm nulldate "not:desc:a b"                     @?= Right (Left $ Not $ Desc "a b") | ||||
|      parseQueryTerm nulldate "status:1"                         @?= Right (Left $ StatusQ Cleared) | ||||
|      parseQueryTerm nulldate "status:*"                         @?= Right (Left $ StatusQ Cleared) | ||||
|      parseQueryTerm nulldate "status:!"                         @?= Right (Left $ StatusQ Pending) | ||||
|      parseQueryTerm nulldate "status:0"                         @?= Right (Left $ StatusQ Unmarked) | ||||
|      parseQueryTerm nulldate "status:"                          @?= Right (Left $ StatusQ Unmarked) | ||||
|      parseQueryTerm nulldate "payee:x"                          @?= Right (Left $ Tag "payee" (Just "x")) | ||||
|      parseQueryTerm nulldate "note:x"                           @?= Right (Left $ Tag "note" (Just "x")) | ||||
|      parseQueryTerm nulldate "real:1"                           @?= Right (Left $ Real True) | ||||
|      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"              @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) | ||||
|      parseQueryTerm nulldate "date:20180101-201804"             @?= Right (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) | ||||
|      parseQueryTerm nulldate "inacct:a"                         @?= Right (Right $ QueryOptInAcct "a") | ||||
|      parseQueryTerm nulldate "tag:a"                            @?= Right (Left $ Tag "a" Nothing) | ||||
|      parseQueryTerm nulldate "tag:a=some value"                 @?= Right (Left $ Tag "a" (Just "some value")) | ||||
|      parseQueryTerm nulldate "amt:<0"                           @?= Right (Left $ Amt Lt 0) | ||||
|      parseQueryTerm nulldate "amt:>10000.10"                    @?= Right (Left $ Amt AbsGt 10000.1) | ||||
| 
 | ||||
|   ,test "parseAmountQueryTerm" $ do | ||||
|      parseAmountQueryTerm "<0"        @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false | ||||
|  | ||||
| @ -298,6 +298,7 @@ parseAndFinaliseJournal' parser iopts f txt = do | ||||
| journalFinalise :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal | ||||
| journalFinalise iopts f txt pj = do | ||||
|   t <- liftIO getClockTime | ||||
|   d <- liftIO getCurrentDay | ||||
|   -- Infer and apply canonical styles for each commodity (or fail). | ||||
|   -- This affects transaction balancing/assertions/assignments, so needs to be done early. | ||||
|   -- (TODO: since #903's refactoring for hledger 1.12, | ||||
| @ -322,11 +323,13 @@ journalFinalise iopts f txt pj = do | ||||
|            -- then add the auto postings | ||||
|            -- (Note adding auto postings after balancing means #893b fails; | ||||
|            -- adding them before balancing probably means #893a, #928, #938 fail.) | ||||
|            let j'' = journalModifyTransactions j' | ||||
|            -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) | ||||
|            j''' <- journalApplyCommodityStyles j'' | ||||
|            -- then check balance assertions. | ||||
|            journalBalanceTransactions (not $ ignore_assertions_ iopts) 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 ?) | ||||
|                j''' <- journalApplyCommodityStyles j'' | ||||
|                -- then check balance assertions. | ||||
|                journalBalanceTransactions (not $ ignore_assertions_ iopts) j''' | ||||
|         ) | ||||
|      & fmap journalInferMarketPricesFromTransactions  -- infer market prices from commodity-exchanging transactions | ||||
| 
 | ||||
|  | ||||
| @ -461,11 +461,12 @@ journalSelectingAmountFromOpts opts = | ||||
|     _               -> id | ||||
| 
 | ||||
| -- | Convert report options and arguments to a query. | ||||
| -- If there is a parsing problem, this function calls error. | ||||
| queryFromOpts :: Day -> ReportOpts -> Query | ||||
| queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq] | ||||
|   where | ||||
|     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. | ||||
| queryFromOptsOnly :: Day -> ReportOpts -> Query | ||||
| @ -481,8 +482,9 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq | ||||
|     consJust f = maybe id ((:) . f) | ||||
| 
 | ||||
| -- | Convert report options and arguments to query options. | ||||
| -- If there is a parsing problem, this function calls error. | ||||
| 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. | ||||
| 
 | ||||
|  | ||||
| @ -38,8 +38,9 @@ rewritemode = hledgerCommandMode | ||||
| 
 | ||||
| rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do | ||||
|   -- rewrite matched transactions | ||||
|   d <- getCurrentDay | ||||
|   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 | ||||
|   printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j' | ||||
| 
 | ||||
|  | ||||
| @ -108,10 +108,12 @@ anonymiseByOpts opts = | ||||
| -- | 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). | ||||
| -- | ||||
| -- They can start no earlier than: the day following the latest normal | ||||
| -- transaction in the journal (or today if there are none). | ||||
| -- They end on or before the specified report end date, or 180 days | ||||
| -- from today if unspecified. | ||||
| -- When --auto is active, auto posting rules will be applied to the | ||||
| -- generated transactions. If the query in any auto posting rule fails | ||||
| -- to parse, this function will raise an error. | ||||
| -- | ||||
| -- 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{inputopts_=iopts, reportopts_=ropts} j = do | ||||
| @ -136,7 +138,9 @@ journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do | ||||
|                        , spanContainsDate forecastspan (tdate t) | ||||
|                        ] | ||||
|       -- 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 $ | ||||
|     case forecast_ ropts of | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user