imp:valuation: more compact and informative --debug=2 output [#2287]

Market prices are now shown using one line each,
the known prices are listed (forward / forward+reverse),
and the status of --infer-market-prices is shown.
This commit is contained in:
Simon Michael 2024-12-02 22:54:03 -10:00
parent e80debe4c9
commit 735beb96a7
4 changed files with 25 additions and 15 deletions

View File

@ -984,7 +984,7 @@ canonicalStyle a b = a{asprecision=prec, asdecimalmark=decmark, asdigitgroups=mg
journalInferMarketPricesFromTransactions :: Journal -> Journal journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions j = journalInferMarketPricesFromTransactions j =
j{jinferredmarketprices = j{jinferredmarketprices =
dbg4 "jinferredmarketprices" . dbg4With (("jinferredmarketprices:\n"<>) . showMarketPrices) $
map priceDirectiveToMarketPrice . map priceDirectiveToMarketPrice .
concatMap postingPriceDirectivesFromCost $ concatMap postingPriceDirectivesFromCost $
journalPostings j journalPostings j

View File

@ -37,7 +37,7 @@ import Data.Bifunctor (first)
import Data.Decimal (Decimal, DecimalRaw(..)) import Data.Decimal (Decimal, DecimalRaw(..))
import Data.Default (Default(..)) import Data.Default (Default(..))
import Data.Functor (($>)) import Data.Functor (($>))
import Data.List (intercalate) import Data.List (intercalate, sortBy)
--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html --XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
--Note: You should use Data.Map.Strict instead of this module if: --Note: You should use Data.Map.Strict instead of this module if:
--You will eventually need all the values stored. --You will eventually need all the values stored.
@ -586,6 +586,9 @@ data MarketPrice = MarketPrice {
,mprate :: Quantity -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity. ,mprate :: Quantity -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity.
} deriving (Eq,Ord,Generic, Show) } deriving (Eq,Ord,Generic, Show)
showMarketPrice MarketPrice{..} = unwords [show mpdate, T.unpack mpfrom <> ">" <> T.unpack mpto, show mprate]
showMarketPrices = intercalate "\n" . map ((' ':).showMarketPrice) . sortBy (comparing mpdate)
-- additional valuation-related types in Valuation.hs -- additional valuation-related types in Valuation.hs
-- | A journal, containing general ledger transactions; also directives and various other things. -- | A journal, containing general ledger transactions; also directives and various other things.

View File

@ -95,7 +95,9 @@ journalPriceOracle :: Bool -> Journal -> PriceOracle
journalPriceOracle infer Journal{jpricedirectives, jinferredmarketprices} = journalPriceOracle infer Journal{jpricedirectives, jinferredmarketprices} =
let let
declaredprices = map priceDirectiveToMarketPrice jpricedirectives declaredprices = map priceDirectiveToMarketPrice jpricedirectives
inferredprices = if infer then jinferredmarketprices else [] inferredprices =
(if infer then jinferredmarketprices else [])
& traceOrLogAt 2 ("use prices inferred from costs? " <> if infer then "yes" else "no")
makepricegraph = memo $ makePriceGraph declaredprices inferredprices makepricegraph = memo $ makePriceGraph declaredprices inferredprices
in in
memo $ uncurry3 $ priceLookup makepricegraph memo $ uncurry3 $ priceLookup makepricegraph
@ -274,14 +276,17 @@ priceLookup makepricegraph d from mto =
Just to -> Just to ->
-- We have a commodity to convert to. Find the most direct price available, -- We have a commodity to convert to. Find the most direct price available,
-- according to the rules described in makePriceGraph. -- according to the rules described in makePriceGraph.
let msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to) let
in case msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)
(traceOrLogAt 2 (msg++" using forward prices") $ prices =
pricesShortestPath from to forwardprices) (traceOrLogAt 2 (msg++" using forward prices") $
<|> traceOrLogAt 2 ("forward prices:\n" <> showMarketPrices forwardprices) $
(traceOrLogAt 2 (msg++" using forward and reverse prices") $ pricesShortestPath from to forwardprices)
pricesShortestPath from to allprices) <|>
of (traceOrLogAt 2 (msg++" using forward and reverse prices") $
traceOrLogAt 2 ("forward and reverse prices:\n" <> showMarketPrices allprices) $
pricesShortestPath from to $ dbg5 "all forward and reverse prices" allprices)
in case prices of
Nothing -> Nothing Nothing -> Nothing
Just [] -> Nothing Just [] -> Nothing
Just ps -> Just (mpto $ last ps, rate) Just ps -> Just (mpto $ last ps, rate)
@ -332,7 +337,7 @@ data PriceGraph = PriceGraph {
-- ^ The date on which these prices are in effect. -- ^ The date on which these prices are in effect.
,pgEdges :: [Edge] ,pgEdges :: [Edge]
-- ^ "Forward" exchange rates between commodity pairs, either -- ^ "Forward" exchange rates between commodity pairs, either
-- declared by P directives or inferred from transaction prices, -- declared by P directives or (with --infer-market-prices) inferred from costs,
-- forming the edges of a directed graph. -- forming the edges of a directed graph.
,pgEdgesRev :: [Edge] ,pgEdgesRev :: [Edge]
-- ^ The same edges, plus any additional edges that can be -- ^ The same edges, plus any additional edges that can be
@ -340,6 +345,7 @@ data PriceGraph = PriceGraph {
-- --
-- In both of these there will be at most one edge between each -- In both of these there will be at most one edge between each
-- directed pair of commodities, eg there can be one USD->EUR and one EUR->USD. -- directed pair of commodities, eg there can be one USD->EUR and one EUR->USD.
--
,pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol ,pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol
-- ^ The default valuation commodity for each source commodity. -- ^ The default valuation commodity for each source commodity.
-- These are used when a valuation commodity is not specified -- These are used when a valuation commodity is not specified
@ -358,9 +364,8 @@ pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path
pricesShortestPath start end edges = pricesShortestPath start end edges =
-- at --debug=2 +, print the pretty path and also the detailed prices -- at --debug=2 +, print the pretty path and also the detailed prices
let label = printf "shortest path from %s to %s: " (showCommoditySymbol start) (showCommoditySymbol end) in let label = printf "shortest path from %s to %s: " (showCommoditySymbol start) (showCommoditySymbol end) in
fmap (dbg2With (("price chain:\n"++).pshow)) $ fmap (dbg2With (("price chain:\n"++).showMarketPrices)) $
dbg2With ((label++).(maybe "none found" (pshowpath ""))) $ dbg2With ((label++).(maybe "none" (pshowpath ""))) $
find [([],edges)] find [([],edges)]
where where

View File

@ -112,6 +112,8 @@ multiBalanceReportWith rspec' j priceoracle unelidableaccts = report
-- Queries, report/column dates. -- Queries, report/column dates.
(reportspan, colspans) = reportSpan j rspec' (reportspan, colspans) = reportSpan j rspec'
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
-- force evaluation order to show price lookup after date spans in debug output (XXX not working)
-- priceoracle = reportspan `seq` priceoracle0
-- Group postings into their columns. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans