diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-05-21 09:26:44 +0000 |
| commit | 055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f (patch) | |
| tree | 0e63fb68c69c8f6ad0f78893c63420f0a3600e1c /src-3.0/GF/System/Tracing.hs | |
| parent | 915a1de71783ab8446b1af9e72c7ba7dfbc12d3f (diff) | |
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
Diffstat (limited to 'src-3.0/GF/System/Tracing.hs')
| -rw-r--r-- | src-3.0/GF/System/Tracing.hs | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/src-3.0/GF/System/Tracing.hs b/src-3.0/GF/System/Tracing.hs new file mode 100644 index 000000000..71bacfb75 --- /dev/null +++ b/src-3.0/GF/System/Tracing.hs @@ -0,0 +1,73 @@ +{-# OPTIONS -cpp #-} + +---------------------------------------------------------------------- +-- | +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/26 09:54:11 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.4 $ +-- +-- Tracing utilities for debugging purposes. +-- If the CPP symbol TRACING is set, then the debugging output is shown. +----------------------------------------------------------------------------- + + +module GF.System.Tracing + (trace, trace2, traceM, traceCall, tracePrt, traceCalcFirst) where + +import qualified Debug.Trace as Trace + +-- | emit a string inside braces, before(?) calculating the value: +-- @{str}@ +trace :: String -> a -> a + +-- | emit function name and debugging output: +-- @{fun: out}@ +trace2 :: String -> String -> a -> a + +-- | monadic version of 'trace2' +traceM :: Monad m => String -> String -> m () + +-- | show when a value is starting to be calculated (with a '+'), +-- and when it is finished (with a '-') +traceCall :: String -> String -> (a -> String) -> a -> a + +-- | showing the resulting value (filtered through a printing function): +-- @{fun: value}@ +tracePrt :: String -> (a -> String) -> a -> a + +-- | this is equivalent to 'seq' when tracing, but +-- just skips the first argument otherwise +traceCalcFirst :: a -> b -> b + +#if TRACING +trace str a = Trace.trace (bold ++ "{" ++ normal ++ str ++ bold ++ "}" ++ normal) a +trace2 fun str a = trace (bold ++ fgcol 1 ++ fun ++ ": " ++ normal ++ str) a +traceM fun str = trace2 fun str (return ()) +traceCall fun start prt val + = trace2 ("+" ++ fun) start $ + val `seq` trace2 ("-" ++ fun) (prt val) val +tracePrt mod prt val = val `seq` trace2 mod (prt val) val +traceCalcFirst = seq + +#else +trace _ = id +trace2 _ _ = id +traceM _ _ = return () +traceCall _ _ _ = id +tracePrt _ _ = id +traceCalcFirst _ = id + +#endif + + +escape = "\ESC" +highlight = escape ++ "[7m" +bold = escape ++ "[1m" +underline = escape ++ "[4m" +normal = escape ++ "[0m" +fgcol col = escape ++ "[0" ++ show (30+col) ++ "m" +bgcol col = escape ++ "[0" ++ show (40+col) ++ "m" |
