slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

;lib: valuation: improve --debug=2 output

Browse Source
This commit is contained in:
Simon Michael 2021-01-07 08:57:56 -08:00
parent 1ad919bc6d
commit 4952ac22a1
1 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -45,6 +45,7 @@ import Hledger.Data.Amount
import Hledger.Data.Dates (nulldate) import Hledger.Data.Dates (nulldate)
import Hledger.Data.Commodity (showCommoditySymbol) import Hledger.Data.Commodity (showCommoditySymbol)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Text.Printf (printf)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
@ -208,7 +209,7 @@ 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 = "seeking " ++ pshowedge' "" from to ++ " price" let msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)
in case in case
(traceAt 2 (msg++" using forward prices") $ (traceAt 2 (msg++" using forward prices") $
pricesShortestPath from to forwardprices) pricesShortestPath from to forwardprices)
@ -273,20 +274,25 @@ data PriceGraph = PriceGraph {
-- USD->EUR price and one EUR->USD price. -- USD->EUR price and one EUR->USD price.
pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path
pricesShortestPath start end edges = pricesShortestPath start end edges =
dbg2 ("shortest "++pshowedge' "" start end++" price path") $ -- 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 ""))) $
find [([],edges)] find [([],edges)]
where where
-- Find the first and shortest complete path using a breadth-first search. -- Find the first and shortest complete path using a breadth-first search.
find :: [(Path,[Edge])] -> Maybe Path find :: [(Path,[Edge])] -> Maybe Path
find paths = find paths =
case concatMap extend paths of case concatMap extend paths of
[] -> Nothing [] -> Nothing
_ | iteration > maxiterations -> _ | pathlength > maxpathlength ->
trace ("gave up searching for a price chain after "++show maxiterations++" iterations, please report a bug") trace ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")
Nothing Nothing
where where
iteration = 1 + maybe 0 (length . fst) (headMay paths) pathlength = 2 + maybe 0 (length . fst) (headMay paths)
maxiterations = 1000 maxpathlength = 1000
paths' -> paths' ->
case completepaths of case completepaths of
p:_ -> Just p -- the left-most complete path at this length p:_ -> Just p -- the left-most complete path at this length
@ -317,7 +323,7 @@ pshowpath label = \case
p@(e:_) -> prefix label $ pshownode (mpfrom e) ++ ">" ++ intercalate ">" (map (pshownode . mpto) p) p@(e:_) -> prefix label $ pshownode (mpfrom e) ++ ">" ++ intercalate ">" (map (pshownode . mpto) p)
-- pshowedges label = prefix label . intercalate ", " . map (pshowedge "") -- pshowedges label = prefix label . intercalate ", " . map (pshowedge "")
-- pshowedge label MarketPrice{..} = pshowedge' label mpfrom mpto -- pshowedge label MarketPrice{..} = pshowedge' label mpfrom mpto
pshowedge' label from to = prefix label $ pshownode from ++ ">" ++ pshownode to -- pshowedge' label from to = prefix label $ pshownode from ++ ">" ++ pshownode to
pshownode = T.unpack . showCommoditySymbol pshownode = T.unpack . showCommoditySymbol
prefix l = if null l then (""++) else ((l++": ")++) prefix l = if null l then (""++) else ((l++": ")++)