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 j =
j{jinferredmarketprices =
dbg4 "jinferredmarketprices" .
dbg4With (("jinferredmarketprices:\n"<>) . showMarketPrices) $
map priceDirectiveToMarketPrice .
concatMap postingPriceDirectivesFromCost $
journalPostings j

View File

@ -37,7 +37,7 @@ import Data.Bifunctor (first)
import Data.Decimal (Decimal, DecimalRaw(..))
import Data.Default (Default(..))
import Data.Functor (($>))
import Data.List (intercalate)
import Data.List (intercalate, sortBy)
--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
--Note: You should use Data.Map.Strict instead of this module if:
--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.
} 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
-- | 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} =
let
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
in
memo $ uncurry3 $ priceLookup makepricegraph
@ -274,14 +276,17 @@ priceLookup makepricegraph d from mto =
Just to ->
-- We have a commodity to convert to. Find the most direct price available,
-- according to the rules described in makePriceGraph.
let msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)
in case
(traceOrLogAt 2 (msg++" using forward prices") $
pricesShortestPath from to forwardprices)
<|>
(traceOrLogAt 2 (msg++" using forward and reverse prices") $
pricesShortestPath from to allprices)
of
let
msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)
prices =
(traceOrLogAt 2 (msg++" using forward prices") $
traceOrLogAt 2 ("forward prices:\n" <> showMarketPrices forwardprices) $
pricesShortestPath from to forwardprices)
<|>
(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
Just [] -> Nothing
Just ps -> Just (mpto $ last ps, rate)
@ -332,7 +337,7 @@ data PriceGraph = PriceGraph {
-- ^ The date on which these prices are in effect.
,pgEdges :: [Edge]
-- ^ "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.
,pgEdgesRev :: [Edge]
-- ^ 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
-- directed pair of commodities, eg there can be one USD->EUR and one EUR->USD.
--
,pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol
-- ^ The default valuation commodity for each source commodity.
-- These are used when a valuation commodity is not specified
@ -358,9 +364,8 @@ pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path
pricesShortestPath start end edges =
-- 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
fmap (dbg2With (("price chain:\n"++).pshow)) $
dbg2With ((label++).(maybe "none found" (pshowpath ""))) $
fmap (dbg2With (("price chain:\n"++).showMarketPrices)) $
dbg2With ((label++).(maybe "none" (pshowpath ""))) $
find [([],edges)]
where

View File

@ -112,6 +112,8 @@ multiBalanceReportWith rspec' j priceoracle unelidableaccts = report
-- Queries, report/column dates.
(reportspan, colspans) = reportSpan j rspec'
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.
colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans