summaryrefslogtreecommitdiff
path: root/src-3.0/GF/System/Tracing.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-05-21 09:26:44 +0000
committeraarne <aarne@cs.chalmers.se>2008-05-21 09:26:44 +0000
commit055c0d0d5a5bb0dc75904fe53df7f2e4f5732a8f (patch)
tree0e63fb68c69c8f6ad0f78893c63420f0a3600e1c /src-3.0/GF/System/Tracing.hs
parent915a1de71783ab8446b1af9e72c7ba7dfbc12d3f (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.hs73
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"