From 9967ead4c520e6996f2615c9b5d612ddbf53642d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 27 Sep 2019 15:09:39 -1000 Subject: [PATCH] ;lib: let commodityStylesFromAmounts & co. return an error (#793, #1091) And if they did, the stats command would now throw an error. Changed: journalApplyCommodityStyles journalInferCommodityStyles commodityStylesFromAmounts --- hledger-lib/Hledger/Data/Journal.hs | 58 +++++++----- hledger-lib/Hledger/Read/Common.hs | 130 +++++++++++++------------- hledger/Hledger/Cli/Commands/Stats.hs | 2 +- 3 files changed, 103 insertions(+), 87 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 3bbdccd0b..4ba7779d5 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -905,18 +905,21 @@ checkBalanceAssignmentUnassignableAccountB p = do -- | Choose and apply a consistent display format to the posting -- amounts in each commodity. Each commodity's format is specified by -- a commodity format directive, or otherwise inferred from posting --- amounts as in hledger < 0.28. -journalApplyCommodityStyles :: Journal -> Journal -journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = j'' - where - j' = journalInferCommodityStyles j - 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} - fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba} - fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a} +-- amounts as in hledger < 0.28. 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'' + 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} + fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba} + fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a} -- | Get all the amount styles defined in this journal, either declared by -- a commodity directive or inferred from amounts, as a map from symbol to style. @@ -931,16 +934,29 @@ journalCommodityStyles j = declaredstyles <> inferredstyles -- | Collect and save inferred amount styles for each commodity based on -- the posting amounts in that commodity (excluding price amounts), ie: -- "the format of the first amount, adjusted to the highest precision of all amounts". -journalInferCommodityStyles :: Journal -> Journal +-- Can return an error message eg if inconsistent number formats are found. +journalInferCommodityStyles :: Journal -> Either String Journal journalInferCommodityStyles j = - j{jinferredcommodities = + case commodityStylesFromAmounts $ - dbg8 "journalInferCommmodityStyles using amounts" $ journalAmounts j} + dbg8 "journalInferCommmodityStyles using amounts" $ + journalAmounts j + of + Left e -> Left e + Right cs -> Right j{jinferredcommodities = cs} --- | Given a list of amounts in parse order, build a map from their commodity names --- to standard commodity display formats. -commodityStylesFromAmounts :: [Amount] -> M.Map CommoditySymbol AmountStyle -commodityStylesFromAmounts amts = M.fromList commstyles +-- | Given a list of parsed amounts, in parse order, build a map from +-- their commodity names to standard commodity display formats. Can +-- return an error message eg if inconsistent number formats are +-- found. +-- +-- Though, these amounts may have come from multiple files, so we +-- shouldn't assume they use consistent number formats. +-- And currently we don't enforce that even within a single file. +-- +commodityStylesFromAmounts :: [Amount] -> Either String (M.Map CommoditySymbol AmountStyle) +commodityStylesFromAmounts amts = + Right $ M.fromList commstyles where commamts = groupSort [(acommodity as, as) | as <- amts] commstyles = [(c, canonicalStyleFrom $ map astyle as) | (c,as) <- commamts] @@ -1377,9 +1393,9 @@ tests_Journal = tests "Journal" [ `is` -- The commodity style should have period as decimal mark -- and comma as digit group mark. - M.fromList [ + Right (M.fromList [ ("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3]))) - ] + ]) ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 667018490..429f5b9d1 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -239,6 +239,7 @@ parseAndFinaliseJournal parser iopts f txt = do , jincludefilestack = [f] } eep <- liftIO $ runExceptT $ runParserT (evalStateT parser initJournal) f txt + -- TODO: urgh.. clean this up somehow case eep of Left finalParseError -> throwError $ finalErrorBundlePretty $ attachSource f txt finalParseError @@ -247,51 +248,54 @@ parseAndFinaliseJournal parser iopts f txt = do Left e -> throwError $ customErrorBundlePretty e Right pj -> - -- If we are using automated transactions, we finalize twice: - -- once before and once after. However, if we are running it - -- twice, we don't check assertions the first time (they might - -- be false pending modifiers) and we don't reorder the second - -- time. If we are only running once, we reorder and follow - -- the options for checking assertions. - -- + + -- Infer and apply canonical styles for each commodity (or fail). -- TODO: since #903's refactoring for hledger 1.12, -- journalApplyCommodityStyles here is seeing the -- transactions before they get reversesd to normal order. - -- And this can trigger a bug in commodityStylesFromAmounts - -- (#1091). - -- - let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj + case journalApplyCommodityStyles pj of + Left e -> throwError e + Right pj' -> + -- Finalise the parsed journal. + let fj = + if auto_ iopts && (not . null . jtxnmodifiers) pj + then + -- When automatic postings are active, we finalise twice: + -- once before and once after. However, if we are running it + -- twice, we don't check assertions the first time (they might + -- be false pending modifiers) and we don't reorder the second + -- time. If we are only running once, we reorder and follow + -- the options for checking assertions. + -- + -- first pass, doing most of the work + ( + (journalModifyTransactions <$>) $ -- add auto postings after balancing ? #893b fails + journalBalanceTransactions False $ + -- journalModifyTransactions <$> -- add auto postings before balancing ? probably #893a, #928, #938 fail + journalReverse $ + journalAddFile (f, txt) $ + pj') + -- second pass, checking balance assertions + >>= (\j -> + journalBalanceTransactions (not $ ignore_assertions_ iopts) $ + journalSetLastReadTime t $ + j) - -- transaction modifiers are active - then - -- first pass, doing most of the work - ( - (journalModifyTransactions <$>) $ -- add auto postings after balancing ? #893b fails - journalBalanceTransactions False $ - -- journalModifyTransactions <$> -- add auto postings before balancing ? probably #893a, #928, #938 fail - journalReverse $ - journalAddFile (f, txt) $ - journalApplyCommodityStyles pj) - -- second pass, checking balance assertions - >>= (\j -> - journalBalanceTransactions (not $ ignore_assertions_ iopts) $ - journalSetLastReadTime t $ - j) - - -- transaction modifiers are not active - else journalBalanceTransactions (not $ ignore_assertions_ iopts) $ - journalReverse $ - journalAddFile (f, txt) $ - journalApplyCommodityStyles $ - journalSetLastReadTime t $ - pj - in - case fj of - Right j -> return j - Left e -> throwError e + else + -- automatic postings are not active + journalBalanceTransactions (not $ ignore_assertions_ iopts) $ + journalReverse $ + journalAddFile (f, txt) $ + journalSetLastReadTime t $ + pj' + in + case fj of + Left e -> throwError e + Right j -> return j -- Like parseAndFinaliseJournal but takes a (non-Erroring) JournalParser. --- Used for timeclock/timedot. XXX let them use parseAndFinaliseJournal instead +-- Used for timeclock/timedot. +-- TODO: get rid of this, use parseAndFinaliseJournal instead parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts -> FilePath -> Text -> ExceptT String IO Journal parseAndFinaliseJournal' parser iopts f txt = do @@ -301,35 +305,31 @@ parseAndFinaliseJournal' parser iopts f txt = do { jparsedefaultyear = Just y , jincludefilestack = [f] } ep <- liftIO $ runParserT (evalStateT parser initJournal) f txt + -- see notes above case ep of Left e -> throwError $ customErrorBundlePretty e - Right pj -> - -- If we are using automated transactions, we finalize twice: - -- once before and once after. However, if we are running it - -- twice, we don't check assertions the first time (they might - -- be false pending modifiers) and we don't reorder the second - -- time. If we are only running once, we reorder and follow the - -- options for checking assertions. - let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj - then journalModifyTransactions <$> - (journalBalanceTransactions False $ - journalReverse $ - journalApplyCommodityStyles pj) >>= - (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $ - journalAddFile (f, txt) $ - journalSetLastReadTime t $ - j) - else journalBalanceTransactions (not $ ignore_assertions_ iopts) $ - journalReverse $ - journalAddFile (f, txt) $ - journalApplyCommodityStyles $ - journalSetLastReadTime t $ - pj - in - case fj of - Right j -> return j - Left e -> throwError e + case journalApplyCommodityStyles pj of + Left e -> throwError e + Right pj' -> + let fj = if auto_ iopts && (not . null . jtxnmodifiers) pj + then journalModifyTransactions <$> + (journalBalanceTransactions False $ + journalReverse $ + pj') >>= + (\j -> journalBalanceTransactions (not $ ignore_assertions_ iopts) $ + journalAddFile (f, txt) $ + journalSetLastReadTime t $ + j) + else journalBalanceTransactions (not $ ignore_assertions_ iopts) $ + journalReverse $ + journalAddFile (f, txt) $ + journalSetLastReadTime t $ + pj' + in + case fj of + Left e -> throwError e + Right j -> return j setYear :: Year -> JournalParser m () setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index 75d500748..d61672eef 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -81,7 +81,7 @@ showLedgerStats l today span = path = journalFilePath j ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j as = nub $ map paccount $ concatMap tpostings ts - cs = Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts + cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts lastdate | null ts = Nothing | otherwise = Just $ tdate $ last ts lastelapsed = fmap (diffDays today) lastdate