packages feed

loch-th 0.1 → 0.2.2

raw patch · 2 files changed

Files

Debug/Trace/LocationTH.hs view
@@ -10,7 +10,7 @@ -- 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@@ -20,6 +20,8 @@     , undef     , check     , checkIO+    , checkTrace+    , checkTraceIO     ) where  import qualified Control.Exception as C@@ -27,6 +29,7 @@ import Language.Haskell.TH.Ppr (pprint) import Language.Haskell.TH.Syntax (location, Loc(..), Q, Exp, lift) import System.IO.Unsafe  (unsafePerformIO)+import qualified Text.PrettyPrint.HughesPJ as PP import Text.PrettyPrint.HughesPJ  ppUnless :: Bool -> Doc -> Doc@@ -39,16 +42,16 @@             , loc_start = (sline, start_col)             , loc_end = (eline, end_col) })     | sline == eline = hcat-        [ text src_path <> colon+        [ text src_path PP.<> colon         , int sline, char ':', int start_col         , ppUnless (end_col - start_col <= 1)-                   (char '-' <> int (end_col-1))+                   (char '-' PP.<> int (end_col-1))         ]     | otherwise = hcat-        [ text src_path <> colon-        , parens (int sline <> char ',' <>  int start_col)+        [ text src_path PP.<> colon+        , parens (int sline PP.<> char ',' PP.<>  int start_col)         , char '-'-        , parens (int eline <> char ',' <>+        , parens (int eline PP.<> char ',' PP.<>             if end_col == 0 then int end_col else int (end_col-1))         ] @@ -57,7 +60,7 @@ -- -- @$__LOCATION__ :: 'String'@ ----- >>> $__LOCATION__ +-- >>> $__LOCATION__ -- "<interactive>:1:1-13" -- __LOCATION__ :: Q Exp@@ -66,7 +69,7 @@ -- -- | 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'. +-- 'String' with the source file and line number of the call to 'assert'. -- -- @$(assert [| 'False' |]) :: a -> a@ --@@ -76,13 +79,13 @@ 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-     |]+    [| assert' $t $__LOCATION__ st |] +assert' :: Bool -> String -> String -> a -> a+assert' False loc st _ = throw $ AssertionFailed $+    loc ++ ": Assertion `" ++ st ++ "' failed"+assert' True  _   _  x = x+ -- -- | A location-emitting 'error' call. --@@ -92,8 +95,11 @@ -- *** Exception: <interactive>:1:1-8: no such thing. -- failure :: Q Exp-failure = [| \t -> error $ $__LOCATION__ ++ ": " ++ t |]+failure = [| failure' $__LOCATION__ |] +failure' :: String -> String -> a+failure' loc t = error $ loc ++ ": " ++ t+ -- -- | A location-emitting 'undefined'. --@@ -112,7 +118,7 @@ -- message. -- -- @$check :: c -> c@--- +-- -- >>> $check $ head [] -- *** Exception: <interactive>:1:1-6: Prelude.head: empty list --@@ -121,6 +127,8 @@ -- -- >>> $check $ Just $ head "" -- Just *** Exception: Prelude.head: empty list+-- >>> Just $ $check $ head ""+-- Just *** Exception: <interactive>:9:8-13: Prelude.head: empty list -- >>> $check $ join deepseq $ Just $ head "" -- *** Exception: <interactive>:1:1-6: Prelude.head: empty list --@@ -138,7 +146,40 @@ -- "*** 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) |]+checkIO = [| checkIO' $__LOCATION__ |]++checkIO' :: String -> IO a -> IO a+checkIO' loc a = C.catch a $ \e -> return $ failure' loc (showEx e)++--+-- | 'checkTrace' extends 'check' with the ability to add a custom string+-- to the error message.+--+-- @$checkTrace :: String -> c -> c@+--+-- >>> $checkTrace "XXX" $ head []+-- *** Exception: <interactive>:1:1-6 XXX: Prelude.head: empty list+--+checkTrace :: Q Exp+checkTrace = [| checkTrace' $__LOCATION__ |]++checkTrace' :: String -> String -> a -> a+checkTrace' loc t = unsafePerformIO . checkTraceIO' loc t . C.evaluate++--+-- | 'checkTraceIO' extends 'checkIO' with the ability to add a custom+-- string to the error message.+--+-- @$checkTraceIO :: String -> IO a -> IO a@+--+-- >>> $checkTraceIO "XXX" $ readFile "/foo"+-- "*** Exception: <interactive>:1:1-8 XXX: /foo: openFile: does not exist (No such file or directory)+--+checkTraceIO :: Q Exp+checkTraceIO = [| checkTraceIO' $__LOCATION__ |]++checkTraceIO' :: String -> String -> IO a -> IO a+checkTraceIO' loc t = checkIO' (loc ++ " " ++ t)  showEx :: C.SomeException -> String showEx = show
loch-th.cabal view
@@ -1,10 +1,10 @@ Name:                loch-th-Version:             0.1+Version:             0.2.2 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.+                     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@@ -12,8 +12,8 @@ Maintainer:          tomi@nomi.cz Category:            Development Build-type:          Simple-Cabal-version:       >=1.2+Cabal-version:       >=1.6  Library   Exposed-modules:     Debug.Trace.LocationTH-  Build-depends:       base >=4 && <5, template-haskell, pretty+  Build-depends:       base == 4.*, template-haskell, pretty