trace2 :: Show a => [Char] -> a -> a
trace2 name x = trace (name ++ ": " ++ show x) x

{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import Debug.Trace

withLocation :: Q Exp -> Q Exp
withLocation f = do
    let error = locationString =<< location
    appE f error
    where
        locationString :: Loc -> Q Exp
        locationString loc = do
            litE $ stringL $ formatLoc loc

formatLoc :: Loc -> String
formatLoc loc = let file = loc_filename loc
                    (line, col) = loc_start loc
                in concat [file, ":", show line, ":", show col]

trace3' (loc :: String) msg x =
    trace2 ('[' : loc ++ "] " ++ msg) x
trace3 = withLocation [| trace3' |]

{-# LANGUAGE TemplateHaskell #-}
tr3 x = $trace3 "hello" x

> tr3 4
[MyFile.hs:2:9] hello: 4

$ ghci HsColour.hs
    *Main> :set -fbreak-on-exception
    *Main> :set args "source.hs"

*Main> :trace main
    Stopped at (exception thrown)

[(exception thrown)] *Main> :back
    Logged breakpoint at Language/Haskell/HsColour/Classify.hs:(19,0)-(31,46)
    _result :: [String]

[-1: Language/Haskell/HsColour/Classify.hs:(19,0)-(31,46)] *Main> :list
    18  chunk :: String -> [String]
        vv
    19  chunk []    = head []
    20  chunk ('r':s) = chunk s -- get rid of DOS newline stuff
    21  chunk ('n':s) = "n": chunk s
                                       ^^