diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 95fd89fb8..716cf79ff 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -914,12 +914,14 @@ journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = Right j' -> Right j'' where styles = journalCommodityStyles j' - j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds} + 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} + fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision 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. diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 24407e76b..0a952215b 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -6,6 +6,7 @@ module Hledger.Cli.Commands.Prices ( ) where +import qualified Data.Map as M import Data.Maybe import Data.List import qualified Data.Text as T @@ -26,11 +27,12 @@ pricesmode = hledgerCommandMode prices opts j = do d <- getCurrentDay let + styles = journalCommodityStyles j q = queryFromOpts d (reportopts_ opts) ps = filter (matchesPosting q) $ allPostings j mprices = jpricedirectives j - cprices = concatMap postingCosts ps - icprices = concatMap postingCosts . mapAmount invertPrice $ ps + cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps + icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices mapM_ (putStrLn . showPriceDirective) $ sortOn pddate $ @@ -65,8 +67,12 @@ invertPrice a = a { aquantity = aquantity pa * signum (aquantity a), acommodity = acommodity pa, aprice = Just $ TotalPrice pa' } where pa' = pa { aquantity = abs $ aquantity a, acommodity = acommodity a, aprice = Nothing, astyle = astyle a } -amountCost :: Day -> Amount -> Maybe PriceDirective -amountCost d a = +postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective] +postingsPriceDirectivesFromCosts p = mapMaybe (amountPriceDirectiveFromCost date) . amounts $ pamount p where + date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p + +amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective +amountPriceDirectiveFromCost d a = case aprice a of Nothing -> Nothing Just (UnitPrice pa) -> Just @@ -74,9 +80,12 @@ amountCost d a = Just (TotalPrice pa) -> Just PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa } -postingCosts :: Posting -> [PriceDirective] -postingCosts p = mapMaybe (amountCost date) . amounts $ pamount p where - date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p +-- | Given a map of standard amount display styles, apply the +-- appropriate one, if any, to this price directive's amount. +-- But keep the number of decimal places unchanged. +stylePriceDirectiveExceptPrecision :: M.Map CommoditySymbol AmountStyle -> PriceDirective -> PriceDirective +stylePriceDirectiveExceptPrecision styles pd@PriceDirective{pdamount=a} = + pd{pdamount = styleAmountExceptPrecision styles a} allPostings :: Journal -> [Posting] allPostings = concatMap tpostings . jtxns diff --git a/hledger/Hledger/Cli/Commands/Prices.md b/hledger/Hledger/Cli/Commands/Prices.md index fc8ddd286..a5f36f6f4 100644 --- a/hledger/Hledger/Cli/Commands/Prices.md +++ b/hledger/Hledger/Cli/Commands/Prices.md @@ -3,5 +3,6 @@ Print [market price directives](/manual#market-prices) from the journal. With --costs, also print synthetic market prices based on [transaction prices](/manual#transaction-prices). With --inverted-costs, also print inverse prices based on transaction prices. Prices (and postings providing prices) can be filtered by a query. +Price amounts are always displayed with their full precision. _FLAGS_ diff --git a/tests/prices.test b/tests/prices.test index 4411cdf16..18ae5c8b1 100644 --- a/tests/prices.test +++ b/tests/prices.test @@ -1,4 +1,4 @@ -# by default only market prices are reported +# 1. by default only market prices are reported < P 2016/1/1 EUR $1.06 P 2016/2/1 EUR $1.05 @@ -15,7 +15,7 @@ $ hledger prices -f- P 2016-01-01 EUR $1.06 P 2016-02-01 EUR $1.05 -# costs from postings can be included also +# 2. costs from postings can be included also < P 2016/1/1 EUR $1.06 P 2016/2/1 EUR $1.05 @@ -38,7 +38,7 @@ P 2016-01-02 EUR $1.07 P 2016-01-03 EUR $1.0725 P 2016-02-01 EUR $1.05 -# inverted costs from postings can be calculated +# 3. inverted costs from postings can be calculated < P 2016/1/1 EUR $1.06 P 2016/2/1 EUR $1.05 @@ -55,3 +55,28 @@ $ hledger prices -f- --inverted-costs P 2016-01-01 EUR $1.06 P 2016-01-03 EUR $1.0725 P 2016-02-01 EUR $1.05 + +# +< +commodity 1.000,00 A + +P 2019-01-01 X A1000,123 +P 2019-01-02 X A1000,1 + +2019-02-01 + (a) X1 @ A1000,2345 +2019-02-02 + (a) X1 @ A1000,2 + +# 4. Commodity styles are applied, but precision is left unchanged. +$ hledger -f- prices +P 2019-01-01 X 1.000,123 A +P 2019-01-02 X 1.000,1 A + +# 5. Commodity styles aren't yet applied to prices inferred from transaction prices. +$ hledger -f- prices --costs +P 2019-01-01 X 1.000,123 A +P 2019-01-02 X 1.000,1 A +P 2019-02-01 X 1.000,2345 A +P 2019-02-02 X 1.000,2 A +