some cleanup of debug trace helpers
This commit is contained in:
Simon Michael
parent
a61d49cca6
commit
70d87613f2
@ -495,7 +495,7 @@ journalCanonicaliseAmounts :: Journal -> Journal
|
||||
journalCanonicaliseAmounts j@Journal{jtxns=ts} = j''
|
||||
where
|
||||
j'' = j'{jtxns=map fixtransaction ts}
|
||||
j' = j{jcommoditystyles = canonicalStyles $ dbgAt 8 "journalAmounts" $ journalAmounts j}
|
||||
j' = j{jcommoditystyles = canonicalStyles $ dbg8 "journalAmounts" $ journalAmounts j}
|
||||
fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
|
||||
fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
|
||||
fixmixedamount (Mixed as) = Mixed $ map fixamount as
|
||||
|
||||
@ -126,9 +126,9 @@ readJournal format rulesfile assrt path s =
|
||||
firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)
|
||||
firstSuccessOrBestError [] [] = return $ Left "no readers found"
|
||||
firstSuccessOrBestError errs (r:rs) = do
|
||||
dbgAtM 1 "trying reader" (rFormat r)
|
||||
dbg1IO "trying reader" (rFormat r)
|
||||
result <- (runExceptT . (rParser r) rulesfile assrt path') s
|
||||
dbgAtM 1 "reader result" $ either id show result
|
||||
dbg1IO "reader result" $ either id show result
|
||||
case result of Right j -> return $ Right j -- success!
|
||||
Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying
|
||||
firstSuccessOrBestError (e:_) [] = return $ Left e -- none left, return first error
|
||||
@ -137,7 +137,7 @@ readJournal format rulesfile assrt path s =
|
||||
-- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?
|
||||
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
|
||||
readersFor (format,path,s) =
|
||||
dbg ("possible readers for "++show (format,path,elideRight 30 s)) $
|
||||
dbg1 ("possible readers for "++show (format,path,elideRight 30 s)) $
|
||||
case format of
|
||||
Just f -> case readerForStorageFormat f of Just r -> [r]
|
||||
Nothing -> []
|
||||
|
||||
@ -101,7 +101,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
let rules = case rules_ of
|
||||
Right (t::CsvRules) -> t
|
||||
Left err -> throwerr $ show err
|
||||
dbgAtM 2 "rules" rules
|
||||
dbg2IO "rules" rules
|
||||
|
||||
-- apply skip directive
|
||||
let skip = maybe 0 oneorerror $ getDirective "skip" rules
|
||||
@ -113,10 +113,10 @@ readJournalFromCsv mrulesfile csvfile csvdata =
|
||||
-- parsec seems to fail if you pass it "-" here
|
||||
let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile
|
||||
records <- (either throwerr id .
|
||||
dbgAt 2 "validateCsv" . validateCsv skip .
|
||||
dbgAt 2 "parseCsv")
|
||||
dbg2 "validateCsv" . validateCsv skip .
|
||||
dbg2 "parseCsv")
|
||||
`fmap` parseCsv parsecfilename csvdata
|
||||
dbgAtM 1 "first 3 csv records" $ take 3 records
|
||||
dbg1IO "first 3 csv records" $ take 3 records
|
||||
|
||||
-- identify header lines
|
||||
-- let (headerlines, datalines) = identifyHeaderLines records
|
||||
|
||||
@ -823,7 +823,7 @@ numberp = do
|
||||
-- ptrace "numberp"
|
||||
sign <- signp
|
||||
parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']
|
||||
dbgAt 8 "numberp parsed" (sign,parts) `seq` return ()
|
||||
dbg8 "numberp parsed" (sign,parts) `seq` return ()
|
||||
|
||||
-- check the number is well-formed and identify the decimal point and digit
|
||||
-- group separator characters used, if any
|
||||
@ -861,7 +861,7 @@ numberp = do
|
||||
frac' = if null frac then "0" else frac
|
||||
quantity = read $ sign++int'++"."++frac' -- this read should never fail
|
||||
|
||||
return $ dbgAt 8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)
|
||||
return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)
|
||||
<?> "numberp"
|
||||
where
|
||||
numeric = isNumber . headDef '_'
|
||||
|
||||
@ -62,19 +62,19 @@ flatShowsExclusiveBalance = True
|
||||
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
|
||||
balanceReport opts q j = (items, total)
|
||||
where
|
||||
-- dbg = const id -- exclude from debug output
|
||||
dbg s = let p = "balanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output
|
||||
-- dbg1 = const id -- exclude from debug output
|
||||
dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in debug output
|
||||
|
||||
accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
|
||||
accts' :: [Account]
|
||||
| queryDepth q == 0 =
|
||||
dbg "accts" $
|
||||
dbg1 "accts" $
|
||||
take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
|
||||
| flat_ opts = dbg "accts" $
|
||||
| flat_ opts = dbg1 "accts" $
|
||||
filterzeros $
|
||||
filterempty $
|
||||
drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
|
||||
| otherwise = dbg "accts" $
|
||||
| otherwise = dbg1 "accts" $
|
||||
filter (not.aboring) $
|
||||
drop 1 $ flattenAccounts $
|
||||
markboring $
|
||||
@ -86,9 +86,9 @@ balanceReport opts q j = (items, total)
|
||||
filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))
|
||||
prunezeros = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)
|
||||
markboring = if no_elide_ opts then id else markBoringParentAccounts
|
||||
items = dbg "items" $ map (balanceReportItem opts q) accts'
|
||||
total | not (flat_ opts) = dbg "total" $ sum [amt | ((_,_,indent),amt) <- items, indent == 0]
|
||||
| otherwise = dbg "total" $
|
||||
items = dbg1 "items" $ map (balanceReportItem opts q) accts'
|
||||
total | not (flat_ opts) = dbg1 "total" $ sum [amt | ((_,_,indent),amt) <- items, indent == 0]
|
||||
| otherwise = dbg1 "total" $
|
||||
if flatShowsExclusiveBalance
|
||||
then sum $ map snd items
|
||||
else sum $ map aebalance $ clipAccountsAndAggregate 1 accts'
|
||||
|
||||
@ -73,41 +73,41 @@ type ClippedAccountName = AccountName
|
||||
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
|
||||
multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow)
|
||||
where
|
||||
symq = dbg "symq" $ filterQuery queryIsSym $ dbg "requested q" q
|
||||
depthq = dbg "depthq" $ filterQuery queryIsDepth q
|
||||
symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q
|
||||
depthq = dbg1 "depthq" $ filterQuery queryIsDepth q
|
||||
depth = queryDepth depthq
|
||||
depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
|
||||
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
|
||||
depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth)
|
||||
datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
|
||||
dateqcons = if date2_ opts then Date2 else Date
|
||||
precedingq = dbg "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]
|
||||
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ opts) q -- span specified by -b/-e/-p options and query args
|
||||
requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j -- if open-ended, close it using the journal's end dates
|
||||
intervalspans = dbg "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it
|
||||
reportspan = dbg "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals
|
||||
precedingq = dbg1 "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]
|
||||
requestedspan = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q -- span specified by -b/-e/-p options and query args
|
||||
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j -- if open-ended, close it using the journal's end dates
|
||||
intervalspans = dbg1 "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it
|
||||
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals
|
||||
(maybe Nothing spanEnd $ lastMay intervalspans)
|
||||
newdatesq = dbg "newdateq" $ dateqcons reportspan
|
||||
reportq = dbg "reportq" $ depthless $ And [datelessq, newdatesq] -- user's query enlarged to whole intervals and with no depth limit
|
||||
newdatesq = dbg1 "newdateq" $ dateqcons reportspan
|
||||
reportq = dbg1 "reportq" $ depthless $ And [datelessq, newdatesq] -- user's query enlarged to whole intervals and with no depth limit
|
||||
|
||||
ps :: [Posting] =
|
||||
dbg "ps" $
|
||||
dbg1 "ps" $
|
||||
journalPostings $
|
||||
filterJournalAmounts symq $ -- remove amount parts excluded by cur:
|
||||
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
||||
journalSelectingAmountFromOpts opts j
|
||||
|
||||
displayspans = dbg "displayspans" $ splitSpan (intervalFromOpts opts) displayspan
|
||||
displayspans = dbg1 "displayspans" $ splitSpan (intervalFromOpts opts) displayspan
|
||||
where
|
||||
displayspan
|
||||
| empty_ opts = dbg "displayspan (-E)" $ reportspan -- all the requested intervals
|
||||
| otherwise = dbg "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
|
||||
matchedspan = dbg "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps
|
||||
| empty_ opts = dbg1 "displayspan (-E)" $ reportspan -- all the requested intervals
|
||||
| otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
|
||||
matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps
|
||||
|
||||
psPerSpan :: [[Posting]] =
|
||||
dbg "psPerSpan" $
|
||||
dbg1 "psPerSpan" $
|
||||
[filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans]
|
||||
|
||||
postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
|
||||
dbg "postedAcctBalChangesPerSpan" $
|
||||
dbg1 "postedAcctBalChangesPerSpan" $
|
||||
map postingAcctBals psPerSpan
|
||||
where
|
||||
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
|
||||
@ -120,36 +120,36 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
|
||||
| tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances
|
||||
| otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit
|
||||
|
||||
postedAccts :: [AccountName] = dbg "postedAccts" $ sort $ accountNamesFromPostings ps
|
||||
postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps
|
||||
|
||||
-- starting balances and accounts from transactions before the report start date
|
||||
startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) startbalanceitems
|
||||
startacctbals = dbg1 "startacctbals" $ map (\((a,_,_),b) -> (a,b)) startbalanceitems
|
||||
where
|
||||
(startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j
|
||||
(startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' precedingq j
|
||||
where
|
||||
opts' | tree_ opts = opts{no_elide_=True}
|
||||
| otherwise = opts{accountlistmode_=ALFlat}
|
||||
startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals
|
||||
startAccts = dbg "startAccts" $ map fst startacctbals
|
||||
startAccts = dbg1 "startAccts" $ map fst startacctbals
|
||||
|
||||
displayedAccts :: [ClippedAccountName] =
|
||||
dbg "displayedAccts" $
|
||||
dbg1 "displayedAccts" $
|
||||
(if tree_ opts then expandAccountNames else id) $
|
||||
nub $ map (clipOrEllipsifyAccountName depth) $
|
||||
if empty_ opts then nub $ sort $ startAccts ++ postedAccts else postedAccts
|
||||
|
||||
acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
|
||||
dbg "acctBalChangesPerSpan" $
|
||||
dbg1 "acctBalChangesPerSpan" $
|
||||
[sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes
|
||||
| postedacctbals <- postedAcctBalChangesPerSpan]
|
||||
where zeroes = [(a, nullmixedamt) | a <- displayedAccts]
|
||||
|
||||
acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =
|
||||
dbg "acctBalChanges" $
|
||||
dbg1 "acctBalChanges" $
|
||||
[(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null...
|
||||
|
||||
items :: [MultiBalanceReportRow] =
|
||||
dbg "items" $
|
||||
dbg1 "items" $
|
||||
[((a, accountLeafName a, accountNameLevel a), displayedBals, rowtot, rowavg)
|
||||
| (a,changes) <- acctBalChanges
|
||||
, let displayedBals = case balancetype_ opts of
|
||||
@ -162,18 +162,18 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
|
||||
]
|
||||
|
||||
totals :: [MixedAmount] =
|
||||
-- dbg "totals" $
|
||||
-- dbg1 "totals" $
|
||||
map sum balsbycol
|
||||
where
|
||||
balsbycol = transpose [bs | ((a,_,_),bs,_,_) <- items, not (tree_ opts) || a `elem` highestlevelaccts]
|
||||
highestlevelaccts =
|
||||
dbg "highestlevelaccts" $
|
||||
dbg1 "highestlevelaccts" $
|
||||
[a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]
|
||||
|
||||
totalsrow :: MultiBalanceTotalsRow =
|
||||
dbg "totalsrow" $
|
||||
dbg1 "totalsrow" $
|
||||
(totals, sum totals, averageMixedAmounts totals)
|
||||
|
||||
dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in this function's debug output
|
||||
-- dbg = const id -- exclude this function from debug output
|
||||
dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in this function's debug output
|
||||
-- dbg1 = const id -- exclude this function from debug output
|
||||
|
||||
|
||||
@ -54,7 +54,7 @@ postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport
|
||||
postingsReport opts q j = (totallabel, items)
|
||||
where
|
||||
-- figure out adjusted queries & spans like multiBalanceReport
|
||||
symq = dbg "symq" $ filterQuery queryIsSym $ dbg "requested q" q
|
||||
symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q
|
||||
depth = queryDepth q
|
||||
depthless = filterQuery (not . queryIsDepth)
|
||||
datelessq = filterQuery (not . queryIsDateOrDate2) q
|
||||
@ -62,23 +62,23 @@ postingsReport opts q j = (totallabel, items)
|
||||
dateq = filterQuery queryIsDateOrDate2 q
|
||||
(dateqcons,pdate) | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = (Date2, postingDate2)
|
||||
| otherwise = (Date, postingDate)
|
||||
requestedspan = dbg "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args
|
||||
requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan ({-date2_ opts-} False) j -- if open-ended, close it using the journal's end dates
|
||||
intervalspans = dbg "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it
|
||||
reportstart = dbg "reportstart" $ maybe Nothing spanStart $ headMay intervalspans
|
||||
reportend = dbg "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans
|
||||
reportspan = dbg "reportspan" $ DateSpan reportstart reportend -- the requested span enlarged to a whole number of intervals
|
||||
beforestartq = dbg "beforestartq" $ dateqcons $ DateSpan Nothing reportstart
|
||||
beforeendq = dbg "beforeendq" $ dateqcons $ DateSpan Nothing reportend
|
||||
reportq = dbg "reportq" $ depthless $ And [datelessq, beforeendq] -- user's query with no start date, end date on an interval boundary and no depth limit
|
||||
requestedspan = dbg1 "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args
|
||||
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan ({-date2_ opts-} False) j -- if open-ended, close it using the journal's end dates
|
||||
intervalspans = dbg1 "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it
|
||||
reportstart = dbg1 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans
|
||||
reportend = dbg1 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans
|
||||
reportspan = dbg1 "reportspan" $ DateSpan reportstart reportend -- the requested span enlarged to a whole number of intervals
|
||||
beforestartq = dbg1 "beforestartq" $ dateqcons $ DateSpan Nothing reportstart
|
||||
beforeendq = dbg1 "beforeendq" $ dateqcons $ DateSpan Nothing reportend
|
||||
reportq = dbg1 "reportq" $ depthless $ And [datelessq, beforeendq] -- user's query with no start date, end date on an interval boundary and no depth limit
|
||||
|
||||
pstoend =
|
||||
dbg "ps4" $ sortBy (comparing pdate) $ -- sort postings by date (or date2)
|
||||
dbg "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
|
||||
dbg "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
|
||||
dbg "ps1" $ filter (reportq `matchesPosting`) $ -- filter postings by the query, including before the report start date, ignoring depth
|
||||
dbg1 "ps4" $ sortBy (comparing pdate) $ -- sort postings by date (or date2)
|
||||
dbg1 "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
|
||||
dbg1 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
|
||||
dbg1 "ps1" $ filter (reportq `matchesPosting`) $ -- filter postings by the query, including before the report start date, ignoring depth
|
||||
journalPostings $ journalSelectingAmountFromOpts opts j
|
||||
(precedingps, reportps) = dbg "precedingps, reportps" $ span (beforestartq `matchesPosting`) pstoend
|
||||
(precedingps, reportps) = dbg1 "precedingps, reportps" $ span (beforestartq `matchesPosting`) pstoend
|
||||
|
||||
showempty = queryEmpty q || average_ opts
|
||||
-- displayexpr = display_ opts -- XXX
|
||||
@ -87,14 +87,14 @@ postingsReport opts q j = (totallabel, items)
|
||||
whichdate = whichDateFromOpts opts
|
||||
itemps | interval == NoInterval = map (,Nothing) reportps
|
||||
| otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps
|
||||
items = dbg "items" $ postingsReportItems itemps (nullposting,Nothing) whichdate depth startbal runningcalc 1
|
||||
items = dbg1 "items" $ postingsReportItems itemps (nullposting,Nothing) whichdate depth startbal runningcalc 1
|
||||
where
|
||||
startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0
|
||||
runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average
|
||||
| otherwise = \_ bal amt -> bal + amt -- running total
|
||||
|
||||
dbg s = let p = "postingsReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output
|
||||
-- dbg = const id -- exclude from debug output
|
||||
dbg1 s = let p = "postingsReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in debug output
|
||||
-- dbg1 = const id -- exclude from debug output
|
||||
|
||||
totallabel = "Total"
|
||||
|
||||
|
||||
@ -86,65 +86,93 @@ debugLevel = case snd $ break (=="--debug") args of
|
||||
where
|
||||
args = unsafePerformIO getArgs
|
||||
|
||||
-- | Print a message and a showable value to the console if the global
|
||||
-- debug level is non-zero. Uses unsafePerformIO.
|
||||
-- | Convenience aliases for tracePrettyAt.
|
||||
-- Pretty-print a message and the showable value to the console, then return it.
|
||||
dbg :: Show a => String -> a -> a
|
||||
dbg = dbg1
|
||||
|
||||
-- always prints
|
||||
dbg0 :: Show a => String -> a -> a
|
||||
dbg0 = dbgAt 0
|
||||
dbg = tracePrettyAt 0
|
||||
|
||||
-- | Pretty-print a message and the showable value to the console when the debug level is >= 1, then return it. Uses unsafePerformIO.
|
||||
dbg1 :: Show a => String -> a -> a
|
||||
dbg1 = dbgAt 1
|
||||
dbg1 = tracePrettyAt 1
|
||||
|
||||
dbg2 :: Show a => String -> a -> a
|
||||
dbg2 = dbgAt 2
|
||||
dbg2 = tracePrettyAt 2
|
||||
|
||||
dbg3 :: Show a => String -> a -> a
|
||||
dbg3 = dbgAt 3
|
||||
dbg3 = tracePrettyAt 3
|
||||
|
||||
dbg4 :: Show a => String -> a -> a
|
||||
dbg4 = dbgAt 4
|
||||
dbg4 = tracePrettyAt 4
|
||||
|
||||
dbg5 :: Show a => String -> a -> a
|
||||
dbg5 = dbgAt 5
|
||||
dbg5 = tracePrettyAt 5
|
||||
|
||||
dbg6 :: Show a => String -> a -> a
|
||||
dbg6 = dbgAt 6
|
||||
dbg6 = tracePrettyAt 6
|
||||
|
||||
dbg7 :: Show a => String -> a -> a
|
||||
dbg7 = dbgAt 7
|
||||
dbg7 = tracePrettyAt 7
|
||||
|
||||
dbg8 :: Show a => String -> a -> a
|
||||
dbg8 = dbgAt 8
|
||||
dbg8 = tracePrettyAt 8
|
||||
|
||||
dbg9 :: Show a => String -> a -> a
|
||||
dbg9 = dbgAt 9
|
||||
dbg9 = tracePrettyAt 9
|
||||
|
||||
-- | Print a message and a showable value to the console if the global
|
||||
-- debug level is at or above the specified level. Uses unsafePerformIO.
|
||||
dbgAt :: Show a => Int -> String -> a -> a
|
||||
dbgAt lvl = dbgppshow lvl
|
||||
-- | Convenience aliases for tracePrettyAtIO.
|
||||
-- Like dbg, but convenient to insert in an IO monad.
|
||||
dbgIO :: Show a => String -> a -> IO ()
|
||||
dbgIO = tracePrettyAtIO 0
|
||||
|
||||
-- Could not deduce (a ~ ())
|
||||
-- from the context (Show a)
|
||||
-- bound by the type signature for
|
||||
-- dbgM :: Show a => String -> a -> IO ()
|
||||
-- at hledger/Hledger/Cli/Main.hs:200:13-42
|
||||
-- ‘a’ is a rigid type variable bound by
|
||||
-- the type signature for dbgM :: Show a => String -> a -> IO ()
|
||||
-- at hledger/Hledger/Cli/Main.hs:200:13
|
||||
-- Expected type: String -> a -> IO ()
|
||||
-- Actual type: String -> a -> IO a
|
||||
-- dbgAtM :: (Monad m, Show a) => Int -> String -> a -> m a
|
||||
-- dbgAtM lvl lbl x = dbgAt lvl lbl x `seq` return x
|
||||
-- XXX temporary:
|
||||
dbgAtM :: Show a => Int -> String -> a -> IO ()
|
||||
dbgAtM = dbgAtIO
|
||||
dbg1IO :: Show a => String -> a -> IO ()
|
||||
dbg1IO = tracePrettyAtIO 1
|
||||
|
||||
dbgAtIO :: Show a => Int -> String -> a -> IO ()
|
||||
dbgAtIO lvl lbl x = dbgAt lvl lbl x `seq` return ()
|
||||
dbg2IO :: Show a => String -> a -> IO ()
|
||||
dbg2IO = tracePrettyAtIO 2
|
||||
|
||||
dbg3IO :: Show a => String -> a -> IO ()
|
||||
dbg3IO = tracePrettyAtIO 3
|
||||
|
||||
dbg4IO :: Show a => String -> a -> IO ()
|
||||
dbg4IO = tracePrettyAtIO 4
|
||||
|
||||
dbg5IO :: Show a => String -> a -> IO ()
|
||||
dbg5IO = tracePrettyAtIO 5
|
||||
|
||||
dbg6IO :: Show a => String -> a -> IO ()
|
||||
dbg6IO = tracePrettyAtIO 6
|
||||
|
||||
dbg7IO :: Show a => String -> a -> IO ()
|
||||
dbg7IO = tracePrettyAtIO 7
|
||||
|
||||
dbg8IO :: Show a => String -> a -> IO ()
|
||||
dbg8IO = tracePrettyAtIO 8
|
||||
|
||||
dbg9IO :: Show a => String -> a -> IO ()
|
||||
dbg9IO = tracePrettyAtIO 9
|
||||
|
||||
-- | Pretty-print a message and a showable value to the console if the debug level is at or above the specified level.
|
||||
-- dbtAt 0 always prints. Otherwise, uses unsafePerformIO.
|
||||
tracePrettyAt :: Show a => Int -> String -> a -> a
|
||||
tracePrettyAt lvl = dbgppshow lvl
|
||||
|
||||
tracePrettyAtIO :: Show a => Int -> String -> a -> IO ()
|
||||
tracePrettyAtIO lvl lbl x = tracePrettyAt lvl lbl x `seq` return ()
|
||||
|
||||
-- XXX
|
||||
-- Could not deduce (a ~ ())
|
||||
-- from the context (Show a)
|
||||
-- bound by the type signature for
|
||||
-- dbgM :: Show a => String -> a -> IO ()
|
||||
-- at hledger/Hledger/Cli/Main.hs:200:13-42
|
||||
-- ‘a’ is a rigid type variable bound by
|
||||
-- the type signature for dbgM :: Show a => String -> a -> IO ()
|
||||
-- at hledger/Hledger/Cli/Main.hs:200:13
|
||||
-- Expected type: String -> a -> IO ()
|
||||
-- Actual type: String -> a -> IO a
|
||||
--
|
||||
-- tracePrettyAtM :: (Monad m, Show a) => Int -> String -> a -> m a
|
||||
-- tracePrettyAtM lvl lbl x = tracePrettyAt lvl lbl x `seq` return x
|
||||
|
||||
-- | print this string to the console before evaluating the expression,
|
||||
-- if the global debug level is non-zero. Uses unsafePerformIO.
|
||||
@ -168,7 +196,7 @@ dbgshow level
|
||||
-- Values are displayed with ppShow, each field/constructor on its own line.
|
||||
dbgppshow :: Show a => Int -> String -> a -> a
|
||||
dbgppshow level
|
||||
| debugLevel < level = flip const
|
||||
| level > 0 && debugLevel < level = flip const
|
||||
| otherwise = \s a -> let p = ppShow a
|
||||
ls = lines p
|
||||
nlorspace | length ls > 1 = "\n"
|
||||
|
||||
@ -49,10 +49,10 @@ accounts :: CliOpts -> Journal -> IO ()
|
||||
accounts CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
let q = queryFromOpts d ropts
|
||||
nodepthq = dbg "nodepthq" $ filterQuery (not . queryIsDepth) q
|
||||
depth = dbg "depth" $ queryDepth $ filterQuery queryIsDepth q
|
||||
ps = dbg "ps" $ journalPostings $ filterJournalPostings nodepthq j
|
||||
as = dbg "as" $ nub $ filter (not . null) $ map (clipAccountName depth) $ sort $ map paccount ps
|
||||
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q
|
||||
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth q
|
||||
ps = dbg1 "ps" $ journalPostings $ filterJournalPostings nodepthq j
|
||||
as = dbg1 "as" $ nub $ filter (not . null) $ map (clipAccountName depth) $ sort $ map paccount ps
|
||||
as' | tree_ ropts = expandAccountNames as
|
||||
| otherwise = as
|
||||
render a | tree_ ropts = replicate (2 * (accountNameLevel a - 1)) ' ' ++ accountLeafName a
|
||||
|
||||
@ -241,11 +241,11 @@ accountWizard EntryState{..} = do
|
||||
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)
|
||||
where
|
||||
canfinish = not (null esPostings) && postingsBalanced esPostings
|
||||
parseAccountOrDotOrNull _ _ "." = dbg $ Just "." -- . always signals end of txn
|
||||
parseAccountOrDotOrNull "" True "" = dbg $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn
|
||||
parseAccountOrDotOrNull def@(_:_) _ "" = dbg $ Just def -- when there's a default, "" means use that
|
||||
parseAccountOrDotOrNull _ _ s = dbg $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname
|
||||
dbg = id -- strace
|
||||
parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn
|
||||
parseAccountOrDotOrNull "" True "" = dbg1 $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn
|
||||
parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that
|
||||
parseAccountOrDotOrNull _ _ s = dbg1 $ either (const Nothing) validateAccount $ runParser (accountnamep <* eof) (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname
|
||||
dbg1 = id -- strace
|
||||
validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing
|
||||
| otherwise = Just s
|
||||
|
||||
|
||||
@ -434,7 +434,7 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal
|
||||
++ (if row_total_ opts then [" Total"] else [])
|
||||
++ (if average_ opts then ["Average"] else [])
|
||||
items' | empty_ opts = items
|
||||
| otherwise = items -- dbg "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg "1" items
|
||||
| otherwise = items -- dbg1 "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg1 "1" items
|
||||
accts = map renderacct items'
|
||||
renderacct ((a,a',i),_,_,_)
|
||||
| tree_ opts = replicate ((i-1)*2) ' ' ++ a'
|
||||
|
||||
@ -199,15 +199,15 @@ main = do
|
||||
isNullCommand = null rawcmd
|
||||
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args
|
||||
argsaftercmd = drop 1 argsaftercmd'
|
||||
dbgM :: Show a => String -> a -> IO ()
|
||||
dbgM = dbgAtM 2
|
||||
dbgIO :: Show a => String -> a -> IO ()
|
||||
dbgIO = tracePrettyAtIO 2
|
||||
|
||||
dbgM "running" prognameandversion
|
||||
dbgM "raw args" args
|
||||
dbgM "raw args rearranged for cmdargs" args'
|
||||
dbgM "raw command is probably" rawcmd
|
||||
dbgM "raw args before command" argsbeforecmd
|
||||
dbgM "raw args after command" argsaftercmd
|
||||
dbgIO "running" prognameandversion
|
||||
dbgIO "raw args" args
|
||||
dbgIO "raw args rearranged for cmdargs" args'
|
||||
dbgIO "raw command is probably" rawcmd
|
||||
dbgIO "raw args before command" argsbeforecmd
|
||||
dbgIO "raw args after command" argsaftercmd
|
||||
|
||||
-- Search PATH for add-ons, excluding any that match built-in names.
|
||||
-- The precise addon names (including file extension) are used for command
|
||||
@ -231,27 +231,27 @@ main = do
|
||||
generalHelp = putStr $ showModeHelp $ mainmode addonDisplayNames
|
||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
|
||||
f `orShowHelp` mode = if hasHelp args then putStr (showModeHelp mode) else f
|
||||
dbgM "processed opts" opts
|
||||
dbgM "command matched" cmd
|
||||
dbgM "isNullCommand" isNullCommand
|
||||
dbgM "isInternalCommand" isInternalCommand
|
||||
dbgM "isExternalCommand" isExternalCommand
|
||||
dbgM "isBadCommand" isBadCommand
|
||||
dbgIO "processed opts" opts
|
||||
dbgIO "command matched" cmd
|
||||
dbgIO "isNullCommand" isNullCommand
|
||||
dbgIO "isInternalCommand" isInternalCommand
|
||||
dbgIO "isExternalCommand" isExternalCommand
|
||||
dbgIO "isBadCommand" isBadCommand
|
||||
d <- getCurrentDay
|
||||
dbgM "date span from opts" (dateSpanFromOpts d $ reportopts_ opts)
|
||||
dbgM "interval from opts" (intervalFromOpts $ reportopts_ opts)
|
||||
dbgM "query from opts & args" (queryFromOpts d $ reportopts_ opts)
|
||||
dbgIO "date span from opts" (dateSpanFromOpts d $ reportopts_ opts)
|
||||
dbgIO "interval from opts" (intervalFromOpts $ reportopts_ opts)
|
||||
dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts)
|
||||
let
|
||||
runHledgerCommand
|
||||
-- high priority flags and situations. --help should be highest priority.
|
||||
| hasHelp argsbeforecmd = dbgM "" "--help before command, showing general help" >> generalHelp
|
||||
| hasHelp argsbeforecmd = dbgIO "" "--help before command, showing general help" >> generalHelp
|
||||
| not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
|
||||
= putStrLn prognameandversion
|
||||
| not (hasHelp argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand))
|
||||
= putStrLn prognameanddetailedversion
|
||||
-- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname
|
||||
-- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show)
|
||||
| isNullCommand = dbgM "" "no command, showing general help" >> generalHelp
|
||||
| isNullCommand = dbgIO "" "no command, showing general help" >> generalHelp
|
||||
| isBadCommand = badCommandError
|
||||
|
||||
-- internal commands
|
||||
@ -271,9 +271,9 @@ main = do
|
||||
| isExternalCommand = do
|
||||
let externalargs = argsbeforecmd ++ filter (not.(=="--")) argsaftercmd
|
||||
let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
|
||||
dbgM "external command selected" cmd
|
||||
dbgM "external command arguments" (map quoteIfNeeded externalargs)
|
||||
dbgM "running shell command" shellcmd
|
||||
dbgIO "external command selected" cmd
|
||||
dbgIO "external command arguments" (map quoteIfNeeded externalargs)
|
||||
dbgIO "running shell command" shellcmd
|
||||
system shellcmd >>= exitWith
|
||||
|
||||
-- deprecated commands
|
||||
|
||||
Loading…
Reference in New Issue
Block a user