lib: global commodity display styles can be set in InputOpts or Journal, overriding all others

This commit is contained in:
Simon Michael 2020-11-09 11:28:11 -08:00
parent 0eddbe7a4b
commit bfb5c6ee2a
3 changed files with 25 additions and 17 deletions

View File

@ -183,6 +183,7 @@ instance Semigroup Journal where
,jincludefilestack = jincludefilestack j2 ,jincludefilestack = jincludefilestack j2
,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2 ,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2
,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2 ,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2
,jglobalcommoditystyles = jglobalcommoditystyles j1 <> jglobalcommoditystyles j2
,jcommodities = jcommodities j1 <> jcommodities j2 ,jcommodities = jcommodities j1 <> jcommodities j2
,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2 ,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2
,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2 ,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2
@ -210,6 +211,7 @@ nulljournal = Journal {
,jincludefilestack = [] ,jincludefilestack = []
,jdeclaredaccounts = [] ,jdeclaredaccounts = []
,jdeclaredaccounttypes = M.empty ,jdeclaredaccounttypes = M.empty
,jglobalcommoditystyles = M.empty
,jcommodities = M.empty ,jcommodities = M.empty
,jinferredcommodities = M.empty ,jinferredcommodities = M.empty
,jpricedirectives = [] ,jpricedirectives = []
@ -940,10 +942,8 @@ checkBalanceAssignmentUnassignableAccountB p = do
-- --
-- | Choose and apply a consistent display style to the posting -- | Choose and apply a consistent display style to the posting
-- amounts in each commodity. Each commodity's style is specified by a -- amounts in each commodity (see journalCommodityStyles).
-- commodity (or D) directive, or otherwise inferred from posting -- Can return an error message eg if inconsistent number formats are found.
-- amounts. Can return an error message eg if inconsistent number
-- formats are found.
journalApplyCommodityStyles :: Journal -> Either String Journal journalApplyCommodityStyles :: Journal -> Either String Journal
journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
case journalInferCommodityStyles j of case journalInferCommodityStyles j of
@ -960,18 +960,20 @@ journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba} fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}
fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a} fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
-- | Get the canonical amount styles for this journal, whether -- | Get the canonical amount styles for this journal, whether (in order of precedence):
-- declared by commodity directives, by the last default commodity (D) -- set globally in InputOpts,
-- directive, or inferred from posting amounts, as a map from symbol -- declared by commodity directives,
-- to style. Styles declared by directives take precedence (and -- declared by a default commodity (D) directive,
-- commodity takes precedence over D). Styles from directives are -- or inferred from posting amounts,
-- guaranteed to specify the decimal mark character. -- as a map from symbol to style.
-- Styles from directives are assumed to specify the decimal mark.
journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle
journalCommodityStyles j = journalCommodityStyles j =
-- XXX could be some redundancy here, cf journalStyleInfluencingAmounts -- XXX could be some redundancy here, cf journalStyleInfluencingAmounts
commoditystyles <> defaultcommoditystyle <> inferredstyles globalstyles <> declaredstyles <> defaultcommoditystyle <> inferredstyles
where where
commoditystyles = M.mapMaybe cformat $ jcommodities j globalstyles = jglobalcommoditystyles j
declaredstyles = M.mapMaybe cformat $ jcommodities j
defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j] defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j]
inferredstyles = jinferredcommodities j inferredstyles = jinferredcommodities j

View File

@ -455,6 +455,7 @@ data Journal = Journal {
-- principal data -- principal data
,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation) ,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation)
,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts) ,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)
,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle -- ^ per-commodity display styles declared globally, eg by command line option or import command
,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives ,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed, should be eg jusedstyles ,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed, should be eg jusedstyles
,jpricedirectives :: [PriceDirective] -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation) ,jpricedirectives :: [PriceDirective] -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation)

View File

@ -194,6 +194,7 @@ data InputOpts = InputOpts {
,new_save_ :: Bool -- ^ save latest new transactions state for next time ,new_save_ :: Bool -- ^ save latest new transactions state for next time
,pivot_ :: String -- ^ use the given field's value as the account name ,pivot_ :: String -- ^ use the given field's value as the account name
,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed
,commoditystyles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ optional commodity display styles affecting all files
} deriving (Show) } deriving (Show)
instance Default InputOpts where def = definputopts instance Default InputOpts where def = definputopts
@ -209,6 +210,7 @@ definputopts = InputOpts
, new_save_ = True , new_save_ = True
, pivot_ = "" , pivot_ = ""
, auto_ = False , auto_ = False
, commoditystyles_ = Nothing
} }
rawOptsToInputOpts :: RawOpts -> InputOpts rawOptsToInputOpts :: RawOpts -> InputOpts
@ -223,6 +225,7 @@ rawOptsToInputOpts rawopts = InputOpts{
,new_save_ = True ,new_save_ = True
,pivot_ = stringopt "pivot" rawopts ,pivot_ = stringopt "pivot" rawopts
,auto_ = boolopt "auto" rawopts ,auto_ = boolopt "auto" rawopts
,commoditystyles_ = Nothing
} }
--- ** parsing utilities --- ** parsing utilities
@ -306,26 +309,28 @@ parseAndFinaliseJournal' parser iopts f txt = do
-- - infer transaction-implied market prices from transaction prices -- - infer transaction-implied market prices from transaction prices
-- --
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
journalFinalise iopts f txt pj = do journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_} f txt pj = do
t <- liftIO getClockTime t <- liftIO getClockTime
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
-- Set any global commodity styles that have been provided via InputOpts
let pj' = pj{jglobalcommoditystyles=fromMaybe M.empty commoditystyles_}
-- Infer and apply canonical styles for each commodity (or throw an error). -- Infer and apply canonical styles for each commodity (or throw an error).
-- 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,
-- journalApplyCommodityStyles here is seeing the -- journalApplyCommodityStyles here is seeing the
-- transactions before they get reversesd to normal order.) -- transactions before they get reversesd to normal order.)
case journalApplyCommodityStyles pj of case journalApplyCommodityStyles pj' of
Left e -> throwError e Left e -> throwError e
Right pj' -> either throwError return $ Right pj' -> either throwError return $
pj' pj'
& journalAddFile (f, txt) -- save the file path and content & journalAddFile (f, txt) -- save the file path and content
& journalSetLastReadTime t -- save the last read time & journalSetLastReadTime t -- save the last read time
& journalReverse -- convert all lists to parse order & journalReverse -- convert all lists to parse order
& (if not (auto_ iopts) || null (jtxnmodifiers pj) & (if not auto_ || null (jtxnmodifiers pj)
then then
-- Auto postings are not active. -- Auto postings are not active.
-- Balance all transactions and maybe check balance assertions. -- Balance all transactions and maybe check balance assertions.
journalBalanceTransactions (not $ ignore_assertions_ iopts) journalBalanceTransactions (not ignore_assertions_)
else \j -> do -- Either monad else \j -> do -- Either monad
-- Auto postings are active. -- Auto postings are active.
-- Balance all transactions without checking balance assertions, -- Balance all transactions without checking balance assertions,
@ -339,7 +344,7 @@ journalFinalise iopts f txt pj = 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.
journalBalanceTransactions (not $ ignore_assertions_ iopts) j''' journalBalanceTransactions (not ignore_assertions_) j'''
) )
& fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions & fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions