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:
parent
e80debe4c9
commit
735beb96a7
@ -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
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user