Skip to content
Permalink
Browse files

;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
  • Loading branch information...
simonmichael committed Sep 28, 2019
1 parent fd8c693 commit 9967ead4c520e6996f2615c9b5d612ddbf53642d
Showing with 105 additions and 89 deletions.
  1. +38 −22 hledger-lib/Hledger/Data/Journal.hs
  2. +66 −66 hledger-lib/Hledger/Read/Common.hs
  3. +1 −1 hledger/Hledger/Cli/Commands/Stats.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}

-- | 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
dbg8 "journalInferCommmodityStyles using amounts" $
journalAmounts j
of
Left e -> Left e
Right cs -> Right j{jinferredcommodities = cs}

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

]

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

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

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

0 comments on commit 9967ead

Please sign in to comment.
You can’t perform that action at this time.