diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 7adf80114..e4fc82a4c 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -723,9 +723,9 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ -- 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 + case modifyTransactions (journalCommodityStyles j) 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). @@ -1066,20 +1066,12 @@ checkBalanceAssignmentUnassignableAccountB p = do -- amounts in each commodity (see journalCommodityStyles). -- Can return an error message eg if inconsistent number formats are found. journalApplyCommodityStyles :: Journal -> Either String Journal -journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = - case journalInferCommodityStyles j of - Left e -> Left e - Right j' -> Right j'' +journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles + where + fixjournal j@Journal{jpricedirectives=pds} = + journalMapPostings (postingApplyCommodityStyles styles) j{jpricedirectives=map fixpricedirective pds} where - styles = journalCommodityStyles j' - j'' = j'{jtxns=map fixtransaction ts - ,jpricedirectives=map fixpricedirective pds - } - fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} - fixposting p = p{pamount=styleMixedAmount styles $ pamount p - ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} - -- balance assertion amounts are always displayed (by print) at full precision, per docs - fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} + styles = journalCommodityStyles j fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a} -- | Get the canonical amount styles for this journal, whether (in order of precedence): diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 1802b66e5..257633dc9 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -38,6 +38,7 @@ module Hledger.Data.Posting ( relatedPostings, postingStripPrices, postingApplyAliases, + postingApplyCommodityStyles, -- * date operations postingDate, postingDate2, @@ -298,6 +299,14 @@ postingApplyAliases aliases p@Posting{paccount} = err = "problem while applying account aliases:\n" ++ pshow aliases ++ "\n to account name: "++T.unpack paccount++"\n "++e +-- | Choose and apply a consistent display style to the posting +-- amounts in each commodity (see journalCommodityStyles). +postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting +postingApplyCommodityStyles styles p = p{pamount=styleMixedAmount styles $ pamount p + ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} + where + fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} + -- | Rewrite an account name using all matching aliases from the given list, in sequence. -- Each alias sees the result of applying the previous aliases. -- Or, return any error arising from a bad regular expression in the aliases. diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index b4c2b06ff..b6dbe1ec6 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -13,6 +13,7 @@ module Hledger.Data.TransactionModifier ( where import Control.Applicative ((<|>), liftA2) +import qualified Data.Map as M import Data.Maybe (catMaybes) import qualified Data.Text as T import Data.Time.Calendar (Day) @@ -22,7 +23,7 @@ import Hledger.Data.Amount import Hledger.Data.Transaction (txnTieKnot) import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting, parseQuery, queryIsAmt, queryIsSym, simplifyQuery) -import Hledger.Data.Posting (commentJoin, commentAddTag) +import Hledger.Data.Posting (commentJoin, commentAddTag, postingApplyCommodityStyles) import Hledger.Utils (dbg6, wrap) -- $setup @@ -35,9 +36,9 @@ import Hledger.Utils (dbg6, wrap) -- 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 +modifyTransactions :: M.Map CommoditySymbol AmountStyle -> Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction] +modifyTransactions styles d tmods ts = do + fs <- mapM (transactionModifierToFunction styles d) tmods -- convert modifiers to functions, or return a parse error let modifytxn t = t'' where @@ -61,7 +62,7 @@ modifyTransactions d tmods ts = do -- >>> import qualified Data.Text.IO as T -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False --- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate +-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction mempty nulldate -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2] -- 0000-01-01 -- ping $1.00 @@ -77,11 +78,11 @@ modifyTransactions d tmods ts = do -- pong $3.00 ; generated-posting: = ping -- -- -transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction) -transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do +transactionModifierToFunction :: M.Map CommoditySymbol AmountStyle -> Day -> TransactionModifier -> Either String (Transaction -> Transaction) +transactionModifierToFunction styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt let - fs = map (tmPostingRuleToFunction q tmquerytxt) tmpostingrules + fs = map (tmPostingRuleToFunction styles q tmquerytxt) tmpostingrules generatePostings ps = concatMap (\p -> p : map ($p) (if q `matchesPosting` p then fs else [])) ps Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} @@ -93,9 +94,9 @@ transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingr -- and a hidden _generated-posting: tag which does not. -- The TransactionModifier's query text is also provided, and saved -- as the tags' value. -tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting) -tmPostingRuleToFunction query querytxt tmpr = - \p -> renderPostingCommentDates $ pr +tmPostingRuleToFunction :: M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting) +tmPostingRuleToFunction styles query querytxt tmpr = + \p -> postingApplyCommodityStyles styles . renderPostingCommentDates $ pr { pdate = pdate pr <|> pdate p , pdate2 = pdate2 pr <|> pdate2 p , pamount = amount' p diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index d7ac740b1..fee013939 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -362,8 +362,6 @@ journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj' = do -- (Note adding auto postings after balancing means #893b fails; -- adding them before balancing probably means #893a, #928, #938 fail.) >>= journalModifyTransactions d - -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) - >>= journalApplyCommodityStyles -- then check balance assertions. >>= journalBalanceTransactions balancingopts_ diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs index 6a5e3c55a..42a489f44 100644 --- a/hledger-web/Hledger/Web/Test.hs +++ b/hledger-web/Hledger/Web/Test.hs @@ -88,7 +88,7 @@ hledgerWebTest = do Right rs -> rs copts = defcliopts{reportspec_=rspec, file_=[""]} -- non-empty, see file_ note above wopts = defwebopts{cliopts_=copts} - j <- fmap (journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail + j <- fmap (either error id . journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail ["~ monthly" ," assets 10" ," income" diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 78f94aeba..36b7f86a0 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -41,7 +41,7 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j@Journal{jtxns=ts} = d -- rewrite matched transactions d <- getCurrentDay let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j - let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL: + let j' = j{jtxns=either error' id $ modifyTransactions mempty d modifiers ts} -- PARTIAL: -- run the print command, showing all transactions, or show diffs printOrDiff rawopts opts{reportspec_=rspec{_rsQuery=Any}} j j' diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index c3b4a3fa2..924f1863b 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -75,7 +75,7 @@ withJournalDo opts cmd = do -- to let the add command work. journalpaths <- journalFilePathFromOpts opts files <- readJournalFiles (inputopts_ opts) journalpaths - let transformed = journalTransform opts <$> files + let transformed = journalTransform opts =<< files either error' cmd transformed -- PARTIAL: -- | Apply some extra post-parse transformations to the journal, if @@ -86,12 +86,14 @@ withJournalDo opts cmd = do -- - pivoting account names (--pivot) -- - anonymising (--anonymise). -- -journalTransform :: CliOpts -> Journal -> Journal +-- This will return an error message if the query in any auto posting rule fails +-- to parse, or the generated transactions are not balanced. +journalTransform :: CliOpts -> Journal -> Either String Journal journalTransform opts = - anonymiseByOpts opts + fmap (anonymiseByOpts opts) -- - converting amounts to market value (--value) -- . journalApplyValue ropts - . pivotByOpts opts + . fmap (pivotByOpts opts) . journalAddForecast opts -- | Apply the pivot transformation on a journal, if option is present. @@ -113,26 +115,28 @@ anonymiseByOpts opts = -- -- 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. +-- to parse, or the generated transactions are not balanced, this function will +-- return an error message. -- -- The start & end date for generated periodic transactions are determined in -- a somewhat complicated way; see the hledger manual -> Periodic transactions. -- -journalAddForecast :: CliOpts -> Journal -> Journal +journalAddForecast :: CliOpts -> Journal -> Either String Journal journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = case forecast_ ropts of - Nothing -> j - Just _ -> either error id $ do -- PARTIAL: + Nothing -> return j + Just _ -> do forecasttxns <- addAutoTxns =<< mapM (balanceTransaction (balancingopts_ iopts)) - [ txnTieKnot t | pt <- jperiodictxns j - , t <- runPeriodicTransaction pt forecastspan - , spanContainsDate forecastspan (tdate t) - ] + [ txnTieKnot $ transactionTransformPostings (postingApplyCommodityStyles styles) t + | pt <- jperiodictxns j + , t <- runPeriodicTransaction pt forecastspan + , spanContainsDate forecastspan (tdate t) + ] journalBalanceTransactions (balancingopts_ iopts) j{ jtxns = concat [jtxns j, forecasttxns] } - >>= journalApplyCommodityStyles where today = _rsDay rspec ropts = _rsReportOpts rspec + styles = journalCommodityStyles j -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)." mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates @@ -147,7 +151,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ ropts) (DateSpan (Just forecastbeginDefault) (Just forecastendDefault)) - addAutoTxns = if auto_ iopts then modifyTransactions today (jtxnmodifiers j) else return + addAutoTxns = if auto_ iopts then modifyTransactions styles today (jtxnmodifiers j) else return -- | Write some output to stdout or to a file selected by --output-file. -- If the file exists it will be overwritten. @@ -196,7 +200,7 @@ journalReload :: CliOpts -> IO (Either String Journal) journalReload opts = do journalpaths <- dbg6 "reloading files" <$> journalFilePathFromOpts opts files <- readJournalFiles (inputopts_ opts) journalpaths - return $ journalTransform opts <$> files + return $ journalTransform opts =<< files -- | Has the specified file changed since the journal was last read ? -- Typically this is one of the journal's journalFilePaths. These are