summaryrefslogtreecommitdiff
path: root/src/GF/System/Tracing.hs
blob: e90a37648442f8bf0393ac4b5a76dac1edf98360 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
{-# OPTIONS -cpp #-}

----------------------------------------------------------------------
-- |
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/16 05:40:50 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- 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 IOExts 

-- | 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 = IOExts.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"