file-location-0.4.9.1/Control/0000755000000000000000000000000013072567502014225 5ustar0000000000000000file-location-0.4.9.1/Control/Exception/0000755000000000000000000000000013072567502016163 5ustar0000000000000000file-location-0.4.9.1/Debug/0000755000000000000000000000000013072567502013633 5ustar0000000000000000file-location-0.4.9.1/FileLocation/0000755000000000000000000000000013072567502015155 5ustar0000000000000000file-location-0.4.9.1/Test/0000755000000000000000000000000013072567502013524 5ustar0000000000000000file-location-0.4.9.1/test/0000755000000000000000000000000013072567502013564 5ustar0000000000000000file-location-0.4.9.1/test/bench/0000755000000000000000000000000013072567502014643 5ustar0000000000000000file-location-0.4.9.1/FileLocation.hs0000644000000000000000000000546013072567502015516 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | see Debug.FileLocation module for more definitions module FileLocation ( err, err', undef, fromJst, fromRht, indx, indxShow , debug, debugM, debugMsg, debugMsgIf, dbg, dbgMsg, trc, ltrace, ltraceM, strace , locationToString , thrwIO, thrwsIO , reThrow ) where import FileLocation.LocationString (locationToString) import Debug.FileLocation (debug, debugM, debugMsg, dbg, dbgMsg, trc, ltrace, ltraceM, strace) import Debug.Util (debugMsgIf) import Control.Exception.FileLocation (thrwIO, thrwsIO, reThrow) import Debug.Trace (trace) import Language.Haskell.TH.Syntax import Language.Haskell.TH(varE) import Data.Maybe(fromMaybe) import qualified Data.Map as M (lookup) -- | Like Prelude.error, but gives the file location. -- -- > $(err "OH NO!") -- > main:Main main.hs:4:10 OH NO! err :: String -> Q Exp err str = do loc <- qLocation let prefix = (locationToString loc) ++ " " [|error (prefix ++ str)|] -- | Like 'err', but the error message (to be appended to the location) is an argument of the generated expression. -- -- > $(err) "OH NO!" -- > main:Main main.hs:4:10 OH NO! err' :: Q Exp err' = do loc <- qLocation let prefix = (locationToString loc) ++ " " [| error . (prefix ++) |] -- | Like Prelude.undefined, but gives the file location. -- -- Uses trace to output the location (this way we still use undefined instead of calling error). -- -- > $(undef) -- > main:Main main.hs:4:10 undefined -- > err: Prelude.undefined undef :: Q Exp undef = do loc <- qLocation let prefix = (locationToString loc) ++ " " [|trace (prefix ++ "undefined") undefined|] -- | Like 'fromJust', but also shows the file location. fromJst :: Q Exp fromJst = do loc <- qLocation let msg = (locationToString loc) ++ " fromJst: Nothing" [|\_m -> case _m of Just _v -> _v Nothing -> error msg|] -- | Like 'fromRight', but also show the file location. fromRht :: Q Exp fromRht = do loc <- qLocation let msg = (locationToString loc) ++ " fromRht: Left: " [|\_m -> case _m of Right _v -> _v Left _e -> error (msg ++ show _e)|] -- | Like @(flip ('Data.Map.!')@, but also shows the file location in case the element isn't found. indx :: Q Exp indx = indx_common False -- | Like 'indx', but also 'show's the looked-up element in case it isn't found. indxShow :: Q Exp indxShow = indx_common True indx_common :: Bool -> Q Exp indx_common = indxWith_common [| M.lookup |] indxWith_common :: Q Exp -> Bool -> Q Exp indxWith_common lookupE showElt = do loc <- qLocation let msg = (locationToString loc) ++ " indx: Element not in the map" msgE varName = if showElt then [| msg ++ ": " ++ show $(varE varName) |] else [| msg |] [| \_x _m -> fromMaybe (error $(msgE '_x)) ($(lookupE) _x _m) |] file-location-0.4.9.1/Debug/FileLocation.hs0000644000000000000000000000333413072567502016542 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | functions that help you with debugging. -- Most would make sense in the Debug.Trace module -- There are Template Haskell versions that show you file locaiton information module Debug.FileLocation (debug, debugM, debugMsg, dbg, dbgMsg, trc, ltrace, ltraceM, strace, traceId, __LOC__) where import Control.Applicative ((<$>), (<*>), pure) import Language.Haskell.TH (recConE, litE, stringL, integerL) import Language.Haskell.TH.Instances import Language.Haskell.TH.Syntax import Debug.Util import Debug.Trace (trace) import FileLocation.LocationString (locationToString) -- | TH version of Debug.Trace.trace that just prints a value. dbg :: Q Exp dbg = do loc <- qLocation let pre = "DEBUG: " ++ (locationToString loc) [|(\_x -> ltrace pre _x)|] -- | TH version of Debug.Trace.trace that prints a value and a message -- prefix. dbgMsg :: String -> Q Exp dbgMsg msg = do loc <- qLocation let pre = "DEBUG: " ++ (locationToString loc) ++ ' ' : msg [|(\_x -> ltrace pre _x)|] -- | A TH version of Debug.Trace.trace that prints location information trc :: String -> Q Exp trc str = do loc <- qLocation let prefix = "TRACE: " ++ (locationToString loc) ++ " " [|trace (prefix ++ str)|] -- | A TH monadic version of debug - print a value with location information as a stand alone expression in a monad dbgM :: Q Exp dbgM = do loc <- qLocation let prefix = "DEBUG: " ++ (locationToString loc) ++ " " [|(\_x -> ltraceM (prefix ++ show _x) _x)|] -- | Embed an expression of type Loc containing the location -- information for the place where it appears. Could be used in -- custom Exception types and similar: -- -- > throw $ MyException $__LOC__ __LOC__ :: Q Exp __LOC__ = lift =<< location file-location-0.4.9.1/Control/Exception/FileLocation.hs0000644000000000000000000000220713072567502021070 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} module Control.Exception.FileLocation ( thrwIO , thrwsIO , reThrow ) where import Language.Haskell.TH.Syntax import FileLocation.LocationString (locationToString) import Control.Exception.Base hiding (throwIO) import qualified Control.Exception.Lifted as E import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Typeable (Typeable) throwIO :: (Exception e, MonadIO m) => e -> m a throwIO = liftIO . E.throwIO thrwIO :: Q Exp thrwIO = do loc <- qLocation let locStr = locationToString loc [|(\_mkEx -> throwIO (_mkEx locStr))|] thrwsIO :: String -> Q Exp thrwsIO errMsg = do loc <- qLocation let locStr = locationToString loc [|(\_mkEx -> throwIO (_mkEx (locStr ++ " " ++ errMsg)))|] data ReThrownException = ReThrownException String E.SomeException deriving Typeable instance Show ReThrownException where show (ReThrownException s e) = "ReThrownException (" ++ s ++ "): " ++ show e instance Exception ReThrownException reThrow :: Q Exp reThrow = do loc <- qLocation let locStr = locationToString loc [|E.handle (E.throwIO . ReThrownException locStr)|] file-location-0.4.9.1/Debug/Util.hs0000644000000000000000000000332713072567502015111 0ustar0000000000000000-- | Functions that help you with debugging. -- Most would make sense in the Debug.Trace module. module Debug.Util (debug, debugM, debugMsg, debugMsgIf, ltrace, ltraceM, strace, traceId) where import Debug.Trace (trace) -- | A version of Debug.Trace.trace that just prints a value. -- This should be included in Debug.Trace debug :: Show a => a -> a debug = ltrace "DEBUG" -- | A version of Debug.Trace.trace that just prints a value and a message. -- This should be included in Debug.Trace debugMsg :: Show a => String -> a -> a debugMsg msg = ltrace ("DEBUG: " ++ msg) -- | A version of Debug.Trace.trace that just prints a value and a message. -- This should be included in Debug.Trace debugMsgIf :: Show a => String -> (a -> Bool) -> a -> a debugMsgIf msg cond x = if cond x then ltrace ("DEBUG: " ++ msg) x else x -- | Monadic debug - like debug, but works as a standalone line in a monad. -- -- TODO: TH version with error loaction info debugM :: (Monad m, Show a) => a -> m a debugM a = debug a `seq` return a -- | Trace (print on stderr at runtime) a showable expression -- like 'debug', but do not print \"DEBUG: \". -- -- \"strace\" stands for \"show trace\". strace :: Show a => a -> a strace a = trace (show a) a -- Alias for 'strace'. -- -- \"traceId\" means it returns itself after tracing like the 'id' function. traceId :: Show a => a -> a traceId = strace -- | Labelled trace - like 'strace', but with a label prepended. ltrace :: Show a => String -> a -> a ltrace l a = trace (l ++ ": " ++ show a) a -- | Monadic debug - like debug, but works as a standalone line in a monad. -- -- TODO: TH version with error loaction info ltraceM :: (Monad m, Show a) => String -> a -> m a ltraceM str a = ltrace str a `seq` return a file-location-0.4.9.1/FileLocation/LocationString.hs0000644000000000000000000000070213072567502020447 0ustar0000000000000000module FileLocation.LocationString (locationToString) where import Language.Haskell.TH.Syntax -- turn the TH Loc loaction information into a human readable string -- leaving out the loc_end parameter 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 file-location-0.4.9.1/Test/FileLocation.hs0000644000000000000000000000172213072567502016432 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Test.FileLocation where import qualified Test.HUnit as HUnit import Language.Haskell.TH import FileLocation (locationToString) import Control.Monad.IO.Class (liftIO) -- | A version of assertEqual that gives location information. assertEq :: Q Exp assertEq = do loc <- location let prefix = locationToString loc ++ " " [|(\x -> HUnit.assertEqual prefix x)|] -- | a MonadIO version of assertBool that gives location information. assertB :: Q Exp assertB = do loc <- location let prefix = locationToString loc ++ "assertB " [|(HUnit.assertBool prefix)|] -- | Same as 'assertEq', but uses 'liftIO' assertEq' :: Q Exp assertEq' = do loc <- location let prefix = locationToString loc ++ " " [|(\x -> liftIO . HUnit.assertEqual prefix x)|] -- | Same as 'assertB, but uses 'liftIO' assertB' :: Q Exp assertB' = do loc <- location let prefix = locationToString loc ++ "assertB " [|(liftIO . HUnit.assertBool prefix)|] file-location-0.4.9.1/test/main.hs0000644000000000000000000000420313072567502015043 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} import Data.Data (Data, Typeable) import FileLocation import Control.Exception.Base (SomeException, Exception(..)) import Prelude hiding (catch) import Control.Exception.Lifted (catch) import Control.Monad (unless) import System.Environment (getArgs) import System.Process (readProcessWithExitCode) data AException = AException String deriving (Show, Typeable) instance Exception AException main = do args <- getArgs case args of [] -> do (_, stdout, stderr) <- readProcessWithExitCode "dist/build/test/test" ["foo"] "" shelltest <- readFile "test/file-location.shelltest" let (stdout', stderr') = parseShellTest shelltest unless (unlines (lines stdout) == stdout') $ do putStrLn "Invalid stdout:" putStr stdout error "Failure" unless (unlines (lines stderr) == stderr') $ do putStrLn "Invalid stderr:" putStr stderr error "Failure" putStrLn "Success" _ -> main2 parseShellTest :: String -> (String, String) parseShellTest orig = (unlines stdout, unlines stderr) where ls1 = lines orig ls2 = drop 1 $ dropWhile (/= ">>>") ls1 (stdout, ls3) = break (== ">>>2") ls2 stderr = takeWhile (/= ">>>= 1") $ drop 1 ls3 main2 :: IO () main2 = do let _ = debugMsgIf "Not Visble" id False let x = debugMsgIf "debugMsgIf" (\xs -> head xs == 1) [1,2,3] putStrLn . show $ $(dbgMsg "Msg TH") $ debugMsg "Msg plain" $ $(dbg) $ debug $ $(trc "trc") x ltraceM "traceM" x debugM x ($thrwIO AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException)) ($(thrwsIO "doh!") AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException)) ($fromJst Nothing) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) ($fromRht (Left "Lefty")) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) $undef `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) $reThrow (error "foo") `catch` \e -> print ("Rethrow", e :: SomeException) $(err "Oh no!") file-location-0.4.9.1/LICENSE0000644000000000000000000000275513072567502013623 0ustar0000000000000000Copyright (c)2011, Greg Weber All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Greg Weber nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. file-location-0.4.9.1/Setup.hs0000644000000000000000000000005613072567502014242 0ustar0000000000000000import Distribution.Simple main = defaultMain file-location-0.4.9.1/file-location.cabal0000644000000000000000000000541413072567603016324 0ustar0000000000000000Name: file-location Version: 0.4.9.1 Synopsis: common functions that show file location information Homepage: https://github.com/gregwebs/FileLocation.hs License: BSD3 License-file: LICENSE Author: Greg Weber Maintainer: greg@gregweber.info Category: Development Build-type: Simple Cabal-version: >=1.8 Description: Common debugging\/error\/exception functions that give file location information . @ $(err \"OH NO!\") main:Main main.hs:16:1 OH NO! @ . Notice how it displays package:module file:line:character . It exposes the functions err (error), undef (undefined), and trc (Debug.Trace.trace). All of these behave the same as their normal counterpart but also spit out a location. . Here is my favorite helper, debug, which is like trace but just show the value. . @ debug [1,2,3] DEBUG: [1,2,3] [1,2,3] @ . And The Template Haskell version. . @ $(dbg) [1,2,3] DEBUG main:Main main.hs:1:3 [1,2,3] [1,2,3] @ . Also there is a version of thrwIO that gives location information . @ ($(thrwIO) $ AException) `catch` \e -> putStrLn (\"Caught \" ++ show (e :: AException)) Caught AException \"main:Main test/main.hs:25:6\" @ . See module for a listing of all the functions with short descriptions, and the homepage for some more examples https://github.com/gregwebs/ErrorLocation.hs extra-source-files: test/*.sh test/*.hs test/*.shelltest test/bench/*.hs test/bench/*.md test/bench/*.h Library Exposed-modules: FileLocation, Debug.FileLocation, Control.Exception.FileLocation, Debug.Util, FileLocation.LocationString Test.FileLocation -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5 , lifted-base , template-haskell , th-orphans >= 0.9 , transformers >= 0.2 && < 0.6 , containers , HUnit -- This just helps you get the packages for test/main.hs -- tests are ran with test/run.sh -- probably can run it entirely through this interface with just a little work test-suite test type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test ghc-options: -Wall Build-depends: file-location , base >= 4 && < 5 , lifted-base , process -- shelltestrunner: need shelltest executable Source-Repository head type: git location: https://github.com/gregwebs/FileLocation.hs file-location-0.4.9.1/test/run.sh0000755000000000000000000000012113072567502014721 0ustar0000000000000000#!/bin/bash -x ghc --make test/main.hs && shelltest test/file-location.shelltest file-location-0.4.9.1/test/main.hs0000644000000000000000000000420313072567502015043 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-} import Data.Data (Data, Typeable) import FileLocation import Control.Exception.Base (SomeException, Exception(..)) import Prelude hiding (catch) import Control.Exception.Lifted (catch) import Control.Monad (unless) import System.Environment (getArgs) import System.Process (readProcessWithExitCode) data AException = AException String deriving (Show, Typeable) instance Exception AException main = do args <- getArgs case args of [] -> do (_, stdout, stderr) <- readProcessWithExitCode "dist/build/test/test" ["foo"] "" shelltest <- readFile "test/file-location.shelltest" let (stdout', stderr') = parseShellTest shelltest unless (unlines (lines stdout) == stdout') $ do putStrLn "Invalid stdout:" putStr stdout error "Failure" unless (unlines (lines stderr) == stderr') $ do putStrLn "Invalid stderr:" putStr stderr error "Failure" putStrLn "Success" _ -> main2 parseShellTest :: String -> (String, String) parseShellTest orig = (unlines stdout, unlines stderr) where ls1 = lines orig ls2 = drop 1 $ dropWhile (/= ">>>") ls1 (stdout, ls3) = break (== ">>>2") ls2 stderr = takeWhile (/= ">>>= 1") $ drop 1 ls3 main2 :: IO () main2 = do let _ = debugMsgIf "Not Visble" id False let x = debugMsgIf "debugMsgIf" (\xs -> head xs == 1) [1,2,3] putStrLn . show $ $(dbgMsg "Msg TH") $ debugMsg "Msg plain" $ $(dbg) $ debug $ $(trc "trc") x ltraceM "traceM" x debugM x ($thrwIO AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException)) ($(thrwsIO "doh!") AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException)) ($fromJst Nothing) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) ($fromRht (Left "Lefty")) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) $undef `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException)) $reThrow (error "foo") `catch` \e -> print ("Rethrow", e :: SomeException) $(err "Oh no!") file-location-0.4.9.1/test/file-location.shelltest0000644000000000000000000000130513072567502020241 0ustar0000000000000000 ./test/main foo >>> [1,2,3] Caught AException "main:Main test/main.hs:57:4" Caught AException "main:Main test/main.hs:58:6 doh!" Caught main:Main test/main.hs:59:4 fromJst: Nothing Caught main:Main test/main.hs:60:4 fromRht: Left: "Lefty" Caught Prelude.undefined ("Rethrow",ReThrownException (main:Main test/main.hs:62:3): foo) >>>2 TRACE: main:Main test/main.hs:54:84 trc DEBUG: debugMsgIf: [1,2,3] DEBUG: [1,2,3] DEBUG: main:Main test/main.hs:54:67: [1,2,3] DEBUG: Msg plain: [1,2,3] DEBUG: main:Main test/main.hs:54:23 Msg TH: [1,2,3] traceM: [1,2,3] DEBUG: [1,2,3] main:Main test/main.hs:61:3 undefined test: main:Main test/main.hs:63:5 Oh no! >>>= 1 rm ./test/main ./test/main.hi ./test/main.o >>>= 0 file-location-0.4.9.1/test/bench/cpp.hs0000644000000000000000000000134113072567502015760 0ustar0000000000000000{-# LANGUAGE CPP, TemplateHaskell #-} -- import FileLocation #include "consts.h" main = do -- $(undef) -- make sure this also loads TH for a different comparison _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") _ERROR("Oh no!") file-location-0.4.9.1/test/bench/hs.hs0000644000000000000000000000017113072567502015610 0ustar0000000000000000{-# LANGUAGE CPP, TemplateHaskell #-} import FileLocation #include "consts.h" main = do -- $(undef) $(err "Oh no!") file-location-0.4.9.1/test/bench/bench.hs0000644000000000000000000000044713072567502016263 0ustar0000000000000000import Criterion.Main import qualified System.Process as Proc -- NOT IN USE! readProcess "" main = defaultMain [ bgroup "fib" [ bench "10" $ , bench "35" $ whnf fib 35 , bench "37" $ whnf fib 37 ] ] file-location-0.4.9.1/test/bench/bench.md0000644000000000000000000000221513072567502016244 0ustar0000000000000000A benchmarking attempt to compare CPP macros to template haskell functions. A very simple macro- add file and line number information to an error function. cpp: FATAL ERROR: Oh no!AT: cpp.hs:7 hs: main:Main hs.hs:7:5 Oh no! # Running ## running the CPP file rm -f cpp cpp.o cpp.hi && time ghc --make -O2 cpp.hs ## running the hs file rm -f hs hs.o hs.hi && time ghc --make -O2 hs.hs # Comparison These are difficutl to compare directly to eachother. Template haskell requires dependencies that take time to link- dependencies you probably already have in your application. So instead we compare the times of calling one macro/TH function versus calling 26. This benching was good enough for me that I didn't feel the need to actually use Criterion. Data: CPP 1 CPP 30 HS 1 HS 30 ------- ------- ------- ------- .35-.37 .43-.46 .57-.59 .61-.64 Results CPP line macros appear to take more time to compile than Error-Location TH functions. It is still possible that there is more per-file invocation overead for TH than CPP (that this benchmark ignrores), even if you are already using TH in your application. file-location-0.4.9.1/test/bench/consts.h0000644000000000000000000000123313072567502016324 0ustar0000000000000000#define LOGLEVEL DEBUG #define LOG_NAME "server" #define LOG(p) liftIO . Log.logM LOG_NAME Log.p $ \ (( __BASE_FILE__ ++ ":" ++ show ( __LINE__ :: Int ) ++ ":") ++) #define _UNDEF error ( "UNDEFINED AT: " ++ __FILE__ ++ ":" ++ show (__LINE__ :: Int) ) #define _ERROR(msg) error ( "FATAL ERROR: " ++ msg ++ "AT: " ++ __FILE__ ++ ":" ++ show (__LINE__ :: Int) ) #define _THROW(e) Control.throwIO $ e $ "AT: " ++ __FILE__ ++ ":" ++ show ( __LINE__ :: Int) #define _THROWS(e,s) (( LOG(ERROR) (show (e (s)) ) ) >> (Control.throwIO $ e $ (s) ++ " AT: " ++ __FILE__ ++":" ++ show ( __LINE__ :: Int) )) #if GHC7 #define HAMLET hamlet #else #define HAMLET $hamlet #endif