module ErrorLocation (err, undef, debug, debugM, debugMsg, dbg, dbgMsg, trc, ltrace, ltraceM, strace) where
import Language.Haskell.TH.Syntax
import Debug.Trace
err :: String -> Q Exp
err str = do
loc <- qLocation
let prefix = (locationToString loc) ++ " "
[|error (prefix ++ str)|]
undef :: Q Exp
undef = do
loc <- qLocation
let prefix = (locationToString loc) ++ " "
[|trace (prefix ++ "undefined") undefined|]
locationToString :: Loc -> String
locationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)
where
line = show . fst . loc_start
char = show . snd . loc_start
debug :: Show a => a -> a
debug = ltrace "DEBUG"
debugMsg :: Show a => String -> a -> a
debugMsg msg = ltrace ("DEBUG: " ++ msg)
dbg :: Q Exp
dbg = do
loc <- qLocation
let pre = "DEBUG: " ++ (locationToString loc)
[|(\x -> ltrace pre x)|]
dbgMsg :: String -> Q Exp
dbgMsg msg = do
loc <- qLocation
let pre = "DEBUG: " ++ (locationToString loc) ++ ' ' : msg
[|(\x -> ltrace pre x)|]
trc :: String -> Q Exp
trc str = do
loc <- qLocation
let prefix = "TRACE: " ++ (locationToString loc) ++ " "
[|trace (prefix ++ str)|]
dbgM :: Q Exp
dbgM = do
loc <- qLocation
let prefix = "DEBUG: " ++ (locationToString loc) ++ " "
[|(\x -> ltraceM (prefix ++ show x) x)|]
debugM :: (Monad m, Show a) => a -> m a
debugM a = debug a `seq` return a
strace :: Show a => a -> a
strace a = trace (show a) a
ltrace :: Show a => String -> a -> a
ltrace l a = trace (l ++ ": " ++ show a) a
ltraceM :: (Monad m, Show a) => String -> a -> m a
ltraceM str a = ltrace str a `seq` return a