lib: debug utils cleanup
This commit is contained in:
		
							parent
							
								
									b262be7838
								
							
						
					
					
						commit
						2f4dde3699
					
				| @ -530,7 +530,7 @@ checkBalanceAssertion (errs,startbal) ps | |||||||
|     finalfullbal = sum $ [startbal] ++ map pamount (dbg2 "ps" ps) |     finalfullbal = sum $ [startbal] ++ map pamount (dbg2 "ps" ps) | ||||||
|     finalsinglebal = filterMixedAmount (\a -> acommodity a == assertedcomm) finalfullbal |     finalsinglebal = filterMixedAmount (\a -> acommodity a == assertedcomm) finalfullbal | ||||||
|     actualbal = finalsinglebal -- just check the single-commodity balance, like Ledger; maybe add ==FULLBAL later |     actualbal = finalsinglebal -- just check the single-commodity balance, like Ledger; maybe add ==FULLBAL later | ||||||
|     iswrong = dbgtrace 2 debugmsg $ |     iswrong = dbg2 debugmsg $ | ||||||
|       not (isReallyZeroMixedAmount (actualbal - assertedbal)) |       not (isReallyZeroMixedAmount (actualbal - assertedbal)) | ||||||
|       -- bal' /= assertedbal  -- MixedAmount's Eq instance currently gets confused by different precisions |       -- bal' /= assertedbal  -- MixedAmount's Eq instance currently gets confused by different precisions | ||||||
|       where |       where | ||||||
|  | |||||||
| @ -40,23 +40,9 @@ ppShow = show | |||||||
| pprint :: Show a => a -> IO () | pprint :: Show a => a -> IO () | ||||||
| pprint = putStrLn . ppShow | pprint = putStrLn . ppShow | ||||||
| 
 | 
 | ||||||
| 
 | -- | Trace (print to stderr) a showable value using a custom show function. | ||||||
| -- | Trace (print on stdout at runtime) a showable value. |  | ||||||
| -- (for easily tracing in the middle of a complex expression) |  | ||||||
| strace :: Show a => a -> a |  | ||||||
| strace a = trace (show a) a |  | ||||||
| 
 |  | ||||||
| -- | Labelled trace - like strace, with a label prepended. |  | ||||||
| ltrace :: Show a => String -> a -> a |  | ||||||
| ltrace l a = trace (l ++ ": " ++ show a) a |  | ||||||
| 
 |  | ||||||
| -- | Monadic trace - like strace, but works as a standalone line in a monad. |  | ||||||
| mtrace :: (Monad m, Show a) => a -> m a |  | ||||||
| mtrace a = strace a `seq` return a |  | ||||||
| 
 |  | ||||||
| -- | Custom trace - like strace, with a custom show function. |  | ||||||
| traceWith :: (a -> String) -> a -> a | traceWith :: (a -> String) -> a -> a | ||||||
| traceWith f e = trace (f e) e | traceWith f a = trace (f a) a | ||||||
| 
 | 
 | ||||||
| -- | Parsec trace - show the current parsec position and next input, | -- | Parsec trace - show the current parsec position and next input, | ||||||
| -- and the provided label if it's non-null. | -- and the provided label if it's non-null. | ||||||
| @ -164,11 +150,9 @@ dbg9IO = tracePrettyAtIO 9 | |||||||
| tracePrettyAt :: Show a => Int -> String -> a -> a | tracePrettyAt :: Show a => Int -> String -> a -> a | ||||||
| tracePrettyAt lvl = dbgppshow lvl | tracePrettyAt lvl = dbgppshow lvl | ||||||
| 
 | 
 | ||||||
| tracePrettyAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m () | -- tracePrettyAtM :: (Monad m, Show a) => Int -> String -> a -> m a | ||||||
| tracePrettyAtIO lvl lbl x = liftIO $ tracePrettyAt lvl lbl x `seq` return () | -- tracePrettyAtM lvl lbl x = tracePrettyAt lvl lbl x `seq` return x | ||||||
| 
 | -- XXX Could not deduce (a ~ ()) | ||||||
| -- XXX |  | ||||||
| -- Could not deduce (a ~ ()) |  | ||||||
| -- from the context (Show a) | -- from the context (Show a) | ||||||
| --   bound by the type signature for | --   bound by the type signature for | ||||||
| --              dbgM :: Show a => String -> a -> IO () | --              dbgM :: Show a => String -> a -> IO () | ||||||
| @ -178,25 +162,25 @@ tracePrettyAtIO lvl lbl x = liftIO $ tracePrettyAt lvl lbl x `seq` return () | |||||||
| --       at hledger/Hledger/Cli/Main.hs:200:13 | --       at hledger/Hledger/Cli/Main.hs:200:13 | ||||||
| -- Expected type: String -> a -> IO () | -- Expected type: String -> a -> IO () | ||||||
| --   Actual type: String -> a -> IO a | --   Actual type: String -> a -> IO a | ||||||
| -- | 
 | ||||||
| -- tracePrettyAtM :: (Monad m, Show a) => Int -> String -> a -> m a | tracePrettyAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m () | ||||||
| -- tracePrettyAtM lvl lbl x = tracePrettyAt lvl lbl x `seq` return x | tracePrettyAtIO lvl lbl x = liftIO $ tracePrettyAt lvl lbl x `seq` return () | ||||||
| 
 | 
 | ||||||
| -- | print this string to the console before evaluating the expression, | -- | print this string to the console before evaluating the expression, | ||||||
| -- if the global debug level is at or above the specified level.  Uses unsafePerformIO. | -- if the global debug level is at or above the specified level.  Uses unsafePerformIO. | ||||||
| dbgtrace :: Int -> String -> a -> a | -- dbgtrace :: Int -> String -> a -> a | ||||||
| dbgtrace level | -- dbgtrace level | ||||||
|     | debugLevel >= level = trace | --     | debugLevel >= level = trace | ||||||
|     | otherwise           = flip const | --     | otherwise           = flip const | ||||||
| 
 | 
 | ||||||
| -- | Print a showable value to the console, with a message, if the | -- | Print a showable value to the console, with a message, if the | ||||||
| -- debug level is at or above the specified level (uses | -- debug level is at or above the specified level (uses | ||||||
| -- unsafePerformIO). | -- unsafePerformIO). | ||||||
| -- Values are displayed with show, all on one line, which is hard to read. | -- Values are displayed with show, all on one line, which is hard to read. | ||||||
| dbgshow :: Show a => Int -> String -> a -> a | -- dbgshow :: Show a => Int -> String -> a -> a | ||||||
| dbgshow level | -- dbgshow level | ||||||
|     | debugLevel >= level = ltrace | --     | debugLevel >= level = ltrace | ||||||
|     | otherwise           = flip const | --     | otherwise           = flip const | ||||||
| 
 | 
 | ||||||
| -- | Print a showable value to the console, with a message, if the | -- | Print a showable value to the console, with a message, if the | ||||||
| -- debug level is at or above the specified level (uses | -- debug level is at or above the specified level (uses | ||||||
| @ -226,7 +210,6 @@ dbgppshow level | |||||||
| --                               return a | --                               return a | ||||||
| --     | otherwise           = a | --     | otherwise           = a | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
| -- | Like dbg, then exit the program. Uses unsafePerformIO. | -- | Like dbg, then exit the program. Uses unsafePerformIO. | ||||||
| dbgExit :: Show a => String -> a -> a | dbgExit :: Show a => String -> a -> a | ||||||
| dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg | dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg | ||||||
| @ -238,4 +221,11 @@ dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg | |||||||
| pdbg :: Int -> String -> TextParser m () | pdbg :: Int -> String -> TextParser m () | ||||||
| pdbg level msg = when (level <= debugLevel) $ ptrace msg | pdbg level msg = when (level <= debugLevel) $ ptrace msg | ||||||
| 
 | 
 | ||||||
| 
 | -- | Like dbg, but writes the output to "debug.log" in the current directory. | ||||||
|  | -- Uses unsafePerformIO. Can fail due to log file contention if called too quickly | ||||||
|  | -- ("*** Exception: debug.log: openFile: resource busy (file is locked)"). | ||||||
|  | dbglog :: Show a => String -> a -> a | ||||||
|  | dbglog label a = | ||||||
|  |   (unsafePerformIO $ | ||||||
|  |     appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n") | ||||||
|  |   `seq` a | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user