lib: global commodity display styles can be set in InputOpts or Journal, overriding all others
This commit is contained in:
parent
0eddbe7a4b
commit
bfb5c6ee2a
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user