[Haskell-cafe] Questions about haskell CPP macros

Claus Reinke claus.reinke at talk21.com
Mon Jul 13 13:12:45 EDT 2009


> I am trying to improve the error reporting in my sendfile library, and I
> know I can find out the current file name and line number with something
> like this:
> 
> {-# LANGUAGE CPP #-}
> main = putStrLn (__FILE__ ++ ":" ++ show __LINE__)
> 
> This outputs:
> test.hs:2
> 
> Unfortunately, if your file is in a hierarchy of folders, this flat file
> name doesn't give much context. Is there a macro to find out the current
> module? IE if I had a module Foo.Bar.Car.MyModule, I would like to be able
> to output something like this on error:
> Foo.Bar.Car.MyModule:2

Sounds like a job for cabal or ghc, to define appropriate macros for
package and module when compiling the source?

> Any help is appreciated!

For actually making use of such information, see 

    http://hackage.haskell.org/trac/ghc/wiki/ExplicitCallStack 
    http://hackage.haskell.org/trac/ghc/wiki/ExplicitCallStack/StackTraceExperience

and also the recent thread on how to improve the quality of "+RTS -xc"
output via mapException (hmm, can't reach the archive at the moment,
one subject was "Should exhaustiveness testing be on by default?", about
May; http://www.haskell.org/mailman/listinfo/glasgow-haskell-users ).

If you really mean "any help", you could also use Template Haskell:-)

    {-# LANGUAGE TemplateHaskell #-}
    module Oh.Hi where 
    
    import Language.Haskell.TH
    
    main = print $( location >>= \(Loc f p m s e)-> 
                    stringE (f++":"++p++":"++m++":"++show s++":"++show e))

Claus




More information about the Haskell-Cafe mailing list