diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 29fdb156b..91010046c 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -67,7 +67,6 @@ module Hledger.Data.Amount ( amountLooksZero, divideAmount, multiplyAmount, - amountTotalPriceToUnitPrice, -- ** rendering AmountDisplayOpts(..), noColour, @@ -125,7 +124,6 @@ module Hledger.Data.Amount ( maIsZero, maIsNonZero, mixedAmountLooksZero, - mixedAmountTotalPriceToUnitPrice, -- ** rendering styleMixedAmount, mixedAmountUnstyled, @@ -171,7 +169,7 @@ import Test.Tasty (testGroup) import Test.Tasty.HUnit ((@?=), assertBool, testCase) import Hledger.Data.Types -import Hledger.Utils (colorB) +import Hledger.Utils (colorB, numDigitsInt) import Hledger.Utils.Text (textQuoteIfNeeded) import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) @@ -312,22 +310,6 @@ amountCost a@Amount{aquantity=q, aprice=mp} = Just (UnitPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * q} Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq} --- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice. --- Has no effect on amounts without one. --- Also increases the unit price's display precision to show one extra decimal place, --- to help keep transaction amounts balancing. --- Does Decimal division, might be some rounding/irrational number issues. -amountTotalPriceToUnitPrice :: Amount -> Amount -amountTotalPriceToUnitPrice - a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps})} - = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp}}} - where - -- Increase the precision by 1, capping at the max bound. - pp = case asprecision ps of - NaturalPrecision -> NaturalPrecision - Precision p -> Precision $ if p == maxBound then maxBound else p + 1 -amountTotalPriceToUnitPrice a = a - -- | Apply a function to an amount's quantity (and its total price, if it has one). transformAmount :: (Quantity -> Quantity) -> Amount -> Amount transformAmount f a@Amount{aquantity=q,aprice=p} = a{aquantity=f q, aprice=f' <$> p} @@ -950,8 +932,8 @@ elisionDisplay mmax sep n lastAmt | otherwise = Nothing where fullString = T.pack $ show n ++ " more.." - -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number - fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n) + -- sep from the separator, 7 from " more..", numDigits n from number + fullLength = sep + 7 + numDigitsInt n str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".." | otherwise = fullString @@ -985,12 +967,6 @@ mixedAmountStripPrices (Mixed ma) = canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles) --- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. --- Has no effect on amounts without one. --- Does Decimal division, might be some rounding/irrational number issues. -mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount -mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice - ------------------------------------------------------------------------------- -- tests diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index a2f787624..7dbd70904 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -926,26 +926,12 @@ canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=m journalInferMarketPricesFromTransactions :: Journal -> Journal journalInferMarketPricesFromTransactions j = j{jinferredmarketprices = - dbg4 "jinferredmarketprices" $ - mapMaybe postingInferredmarketPrice $ journalPostings j + dbg4 "jinferredmarketprices" . + map priceDirectiveToMarketPrice . + concatMap postingPriceDirectivesFromCost $ + journalPostings j } --- | Make a market price equivalent to this posting's amount's unit --- price, if any. If the posting amount is multicommodity, only the --- first commodity amount is considered. -postingInferredmarketPrice :: Posting -> Maybe MarketPrice -postingInferredmarketPrice p@Posting{pamount} = - -- convert any total prices to unit prices - case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of - Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ -> - Just MarketPrice { - mpdate = postingDate p - ,mpfrom = fromcomm - ,mpto = tocomm - ,mprate = rate - } - _ -> Nothing - -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts. journalToCost :: ConversionOp -> Journal -> Journal diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 823c58b22..1b453e3ed 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -66,6 +66,7 @@ module Hledger.Data.Posting ( postingApplyValuation, postingToCost, postingAddInferredEquityPostings, + postingPriceDirectivesFromCost, tests_Posting ) where @@ -73,7 +74,7 @@ where import Data.Default (def) import Data.Foldable (asum) import qualified Data.Map as M -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.List (foldl', sort, union) import qualified Data.Set as S import Data.Text (Text) @@ -456,6 +457,12 @@ postingAddInferredEquityPostings equityAcct p = taggedPosting : concatMap conver priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts) priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p +-- | Make a market price equivalent to this posting's amount's unit +-- price, if any. +postingPriceDirectivesFromCost :: Posting -> [PriceDirective] +postingPriceDirectivesFromCost p@Posting{pamount} = + mapMaybe (amountPriceDirectiveFromCost $ postingDate p) $ amountsRaw pamount + -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a} diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index f6ff9040d..c43884d0f 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -24,6 +24,7 @@ module Hledger.Data.Valuation ( ,mixedAmountGainAtDate ,marketPriceReverse ,priceDirectiveToMarketPrice + ,amountPriceDirectiveFromCost -- ,priceLookup ,tests_Valuation ) @@ -96,6 +97,22 @@ priceDirectiveToMarketPrice PriceDirective{..} = , mprate = aquantity pdamount } +-- | Make one or more `MarketPrice` from an 'Amount' and its price directives. +amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective +amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=fromq} = case aprice amt of + Just (UnitPrice pa) -> Just $ pd{pdamount=pa} + Just (TotalPrice pa) | fromq /= 0 -> Just $ pd{pdamount=fromq `divideAmountExtraPrecision` pa} + _ -> Nothing + where + pd = PriceDirective{pddate = d, pdcommodity = fromcomm, pdamount = nullamt} + + divideAmountExtraPrecision n a = (n `divideAmount` a) { astyle = style' } + where + style' = (astyle a) { asprecision = precision' } + precision' = case asprecision (astyle a) of + NaturalPrecision -> NaturalPrecision + Precision p -> Precision $ (numDigitsInt $ truncate n) + p + ------------------------------------------------------------------------------ -- Converting things to value diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 95c93b720..a80abc3ee 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -234,6 +234,22 @@ sequence' ms = do mapM' :: Monad f => (a -> f b) -> [a] -> f [b] mapM' f = sequence' . map f +-- | Find the number of digits of an 'Int'. +numDigitsInt :: Integral a => Int -> a +numDigitsInt n + | n == minBound = 19 -- negate minBound is out of the range of Int + | n < 0 = go (negate n) + | otherwise = go n + where + go a | a < 10 = 1 + | a < 100 = 2 + | a < 1000 = 3 + | a < 10000 = 4 + | a >= 10000000000000000 = 16 + go (a `quot` 10000000000000000) + | a >= 100000000 = 8 + go (a `quot` 100000000) + | otherwise = 4 + go (a `quot` 10000) +{-# INLINE numDigitsInt #-} + -- | Simpler alias for errorWithoutStackTrace error' :: String -> a error' = errorWithoutStackTrace diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index c9f5a5c9a..132a4446f 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -8,11 +8,9 @@ module Hledger.Cli.Commands.Prices ( where import qualified Data.Map as M -import Data.Maybe import Data.List import qualified Data.Text as T import qualified Data.Text.IO as T -import Data.Time import Hledger import Hledger.Cli.CliOptions import System.Console.CmdArgs.Explicit @@ -37,10 +35,10 @@ prices opts j = do mprices = jpricedirectives j cprices = map (stylePriceDirectiveExceptPrecision styles) $ - concatMap postingsPriceDirectivesFromCosts ps + concatMap postingPriceDirectivesFromCost ps rcprices = map (stylePriceDirectiveExceptPrecision styles) $ - concatMap (postingsPriceDirectivesFromCosts . postingTransformAmount (mapMixedAmount invertPrice)) + concatMap (postingPriceDirectivesFromCost . postingTransformAmount (mapMixedAmount invertPrice)) ps allprices = mprices @@ -58,15 +56,6 @@ prices opts j = do showPriceDirective :: PriceDirective -> T.Text showPriceDirective mp = T.unwords ["P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp] -divideAmount' :: Quantity -> Amount -> Amount -divideAmount' n a = a' where - a' = (n `divideAmount` a) { astyle = style' } - style' = (astyle a) { asprecision = precision' } - extPrecision = (1+) . floor . logBase 10 $ (realToFrac n :: Double) - precision' = case asprecision (astyle a) of - NaturalPrecision -> NaturalPrecision - Precision p -> Precision $ extPrecision + p - -- XXX -- | Invert an amount's price for --invert-cost, somehow ? Unclear. @@ -84,19 +73,6 @@ invertPrice a = where nonZeroSignum x = if x < 0 then -1 else 1 -postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective] -postingsPriceDirectivesFromCosts p = mapMaybe (amountPriceDirectiveFromCost date) . amountsRaw $ pamount p - where date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p - -amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective -amountPriceDirectiveFromCost d a = - case aprice a of - Just (UnitPrice pa) -> Just - PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = pa } - Just (TotalPrice pa) | aquantity a /= 0 -> Just - PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa } - _ -> Nothing - -- | 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. diff --git a/hledger/test/prices.test b/hledger/test/prices.test index cbd34f32d..99794e134 100644 --- a/hledger/test/prices.test +++ b/hledger/test/prices.test @@ -32,10 +32,15 @@ P 2016/2/1 EUR $1.05 2016/1/3 spend expenses 20 EUR @@ $21.45 assets:bank + +2016/1/4 spend + expenses -20 EUR @@ $21.45 + assets:bank $ hledger prices -f- --infer-market-prices P 2016-01-01 EUR $1.06 P 2016-01-02 EUR $1.07 P 2016-01-03 EUR $1.0725 +P 2016-01-04 EUR $1.0725 P 2016-02-01 EUR $1.05 # 3. inverted prices can be calculated