diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 27088deb6..0fdda868f 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 1b7b8cb66..a027b1a7e 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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 -> [] diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 59d22b28f..c7c44920a 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 22f92ac27..8ba49fc3a 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 '_' diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index efa22c87b..7330d3bf8 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -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' diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 2846896c2..443b5419c 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 894161cbd..a66299121 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -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" diff --git a/hledger-lib/Hledger/Utils/Debug.hs b/hledger-lib/Hledger/Utils/Debug.hs index 97b328b20..82b3d9435 100644 --- a/hledger-lib/Hledger/Utils/Debug.hs +++ b/hledger-lib/Hledger/Utils/Debug.hs @@ -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" diff --git a/hledger/Hledger/Cli/Accounts.hs b/hledger/Hledger/Cli/Accounts.hs index 5c5a48358..f19a638e9 100644 --- a/hledger/Hledger/Cli/Accounts.hs +++ b/hledger/Hledger/Cli/Accounts.hs @@ -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 diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index c4b9c81b1..98e26ef57 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -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 diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 6128a6f9a..e4ba9a930 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -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' diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 793c83c98..0bb0eee2e 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -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