loch-th (empty) → 0.1
raw patch · 4 files changed
+195/−0 lines, 4 filesdep +basedep +prettydep +template-haskellsetup-changed
Dependencies added: base, pretty, template-haskell
Files
- Debug/Trace/LocationTH.hs +144/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- loch-th.cabal +19/−0
+ Debug/Trace/LocationTH.hs view
@@ -0,0 +1,144 @@+-- |+-- Module : Debug.Trace.LocationTH+-- Copyright : (c) Tomas Janousek 2011+-- License : BSD-style+-- Maintainer : tomi@nomi.cz+-- Stability : experimental+-- Portability : non-portable (requires Template haskell)+-- Tested : GHC 7.0.3+--+-- This module provides a Template Haskell based mechanism to tag failures+-- with the location of the failure call. The location message includes the+-- file name, line and column numbers.+-- ++{-# LANGUAGE TemplateHaskell #-}+module Debug.Trace.LocationTH+ ( __LOCATION__+ , assert+ , failure+ , undef+ , check+ , checkIO+ ) where++import qualified Control.Exception as C+import Control.Exception (throw, AssertionFailed(..))+import Language.Haskell.TH.Ppr (pprint)+import Language.Haskell.TH.Syntax (location, Loc(..), Q, Exp, lift)+import System.IO.Unsafe (unsafePerformIO)+import Text.PrettyPrint.HughesPJ++ppUnless :: Bool -> Doc -> Doc+ppUnless True _ = empty+ppUnless False doc = doc++-- | Pretty print Loc. Mostly copypasted pprUserSpan from GHC 7.+pprLoc :: Loc -> Doc+pprLoc (Loc { loc_filename = src_path+ , loc_start = (sline, start_col)+ , loc_end = (eline, end_col) })+ | sline == eline = hcat+ [ text src_path <> colon+ , int sline, char ':', int start_col+ , ppUnless (end_col - start_col <= 1)+ (char '-' <> int (end_col-1))+ ]+ | otherwise = hcat+ [ text src_path <> colon+ , parens (int sline <> char ',' <> int start_col)+ , char '-'+ , parens (int eline <> char ',' <>+ if end_col == 0 then int end_col else int (end_col-1))+ ]++--+-- | Get the location of current splice as a 'String'.+--+-- @$__LOCATION__ :: 'String'@+--+-- >>> $__LOCATION__ +-- "<interactive>:1:1-13"+--+__LOCATION__ :: Q Exp+__LOCATION__ = lift =<< (render . pprLoc) `fmap` location++--+-- | If the first argument evaluates to 'True', then the result is the second+-- argument. Otherwise an 'AssertionFailed' exception is raised, containing a+-- 'String' with the source file and line number of the call to 'assert'. +--+-- @$(assert [| 'False' |]) :: a -> a@+--+-- >>> $(assert [| 5 + 5 == 9 |]) "foo"+-- "*** Exception: <interactive>:1:3-25: Assertion `(5 GHC.Num.+ 5) GHC.Classes.== 9' failed+--+assert :: Q Exp -> Q Exp+assert t = do+ st <- pprint `fmap` t+ [|+ \cont -> if not $t+ then throw $ AssertionFailed $+ $__LOCATION__ ++ ": Assertion `" ++ st ++ "' failed"+ else cont+ |]++--+-- | A location-emitting 'error' call.+--+-- @$failure :: 'String' -> a@+--+-- >>> $failure "no such thing."+-- *** Exception: <interactive>:1:1-8: no such thing.+--+failure :: Q Exp+failure = [| \t -> error $ $__LOCATION__ ++ ": " ++ t |]++--+-- | A location-emitting 'undefined'.+--+-- @$undef :: a@+--+-- >>> $undef+-- *** Exception: <interactive>:1:1-6: undefined+--+undef :: Q Exp+undef = [| $failure "undefined" |]++--+-- | 'check' wraps a pure, partial function in a location-emitting+-- handler, should an exception be thrown. So instead of producing an+-- anonymous call to 'error', a location will be tagged to the error+-- message.+--+-- @$check :: c -> c@+-- +-- >>> $check $ head []+-- *** Exception: <interactive>:1:1-6: Prelude.head: empty list+--+-- Be careful with laziness as the argument is only evaluated to weak head+-- normal form:+--+-- >>> $check $ Just $ head ""+-- Just *** Exception: Prelude.head: empty list+-- >>> $check $ join deepseq $ Just $ head ""+-- *** Exception: <interactive>:1:1-6: Prelude.head: empty list+--+check :: Q Exp+check = [| unsafePerformIO . $checkIO . C.evaluate |]++--+-- | 'checkIO' wraps an IO function in a location-emitting handler,+-- should an exception be thrown. So instead of producing an anonymous+-- call to 'error', a location will be tagged to the error message.+--+-- @$checkIO :: IO a -> IO a@+--+-- >>> $checkIO $ readFile "/foo"+-- "*** Exception: <interactive>:1:1-8: /foo: openFile: does not exist (No such file or directory)+--+checkIO :: Q Exp+checkIO = [| \a -> C.catch a $ \e -> return $ $failure (showEx e) |]++showEx :: C.SomeException -> String+showEx = show
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Tomas Janousek++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 Tomas Janousek 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ loch-th.cabal view
@@ -0,0 +1,19 @@+Name: loch-th+Version: 0.1+Synopsis: Support for precise error locations in source files (Template Haskell version)+Description: This module provides a Template Haskell based mechanism to+ tag failures with the location of the failure call. The+ location message includes the file name, line and column+ numbers.+Homepage: https://github.com/liskin/loch-th+License: BSD3+License-file: LICENSE+Author: Tomas Janousek+Maintainer: tomi@nomi.cz+Category: Development+Build-type: Simple+Cabal-version: >=1.2++Library+ Exposed-modules: Debug.Trace.LocationTH+ Build-depends: base >=4 && <5, template-haskell, pretty