file-location 0.4.2 → 0.4.3

raw patch · 13 files changed

+268/−48 lines, 13 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• Control/Exception/FileLocation.hs +2/−2
• Debug/FileLocation.hs +3/−3
• Debug/Util.hs +16/−11
• FileLocation.hs +49/−13
• file-location.cabal +37/−19
• test/bench/bench.hs +13/−0
• test/bench/bench.md +33/−0
• test/bench/consts.h +16/−0
• test/bench/cpp.hs +36/−0
• test/bench/hs.hs +7/−0
• test/file-location.shelltest +24/−0
• test/main.hs +30/−0
• test/run.sh +2/−0

@@ -16,13 +16,13 @@ thrwIO = do   loc <- qLocation   let locStr = locationToString loc-  [|(\mkEx -> throwIO (mkEx locStr))|]+  [|(\_mkEx -> throwIO (_mkEx locStr))|]  thrwsIO :: String -> Q Exp thrwsIO errMsg = do   loc <- qLocation   let locStr = locationToString loc-  [|(\mkEx -> throwIO (mkEx (locStr ++ " " ++ errMsg)))|]+  [|(\_mkEx -> throwIO (_mkEx (locStr ++ " " ++ errMsg)))|]  {- usually want to make a located vesion of a function rather than use this.  - perhaps it could be used to quickly make a located version

@@ -16,7 +16,7 @@ dbg = do   loc <- qLocation   let pre = "DEBUG: " ++ (locationToString loc)-  [|(\x -> ltrace pre x)|]+  [|(\_x -> ltrace pre _x)|]  -- | TH version  of Debug.Trace.trace that prints a value and a message -- prefix.@@ -24,7 +24,7 @@ dbgMsg msg = do   loc <- qLocation   let pre = "DEBUG: " ++ (locationToString loc) ++ ' ' : msg-  [|(\x -> ltrace pre x)|]+  [|(\_x -> ltrace pre _x)|]  -- | A TH version of Debug.Trace.trace that prints location information trc :: String -> Q Exp@@ -38,4 +38,4 @@ dbgM = do   loc <- qLocation   let prefix = "DEBUG: " ++ (locationToString loc) ++ " "-  [|(\x -> ltraceM (prefix ++ show x) x)|]+  [|(\_x -> ltraceM (prefix ++ show _x) _x)|]

@@ -1,5 +1,5 @@--- | functions that help you with debugging.--- Most would make sense in the Debug.Trace module+-- | 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@@ -21,26 +21,31 @@ 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+-- | 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 stdout at runtime) a showable expression--- like debug, but does not print "DEBUG: "--- traceId is an alias for strace--- strace stands for "show trace"--- traceId means it returns itself after tracing like the id function-strace, traceId :: Show a => a -> 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, with a label prepended+-- | 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+-- | 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

@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} -- | see Debug.FileLocation module for more definitions module FileLocation-  ( err, undef, fromJst, fromRht+  ( err, err', undef, fromJst, fromRht, indx, indxShow   , debug, debugM, debugMsg, debugMsgIf, dbg, dbgMsg, trc, ltrace, ltraceM, strace   , locationToString   , thrwIO, thrwsIO@@ -14,10 +14,13 @@ import Control.Exception.FileLocation (thrwIO, thrwsIO) 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+-- | Like Prelude.error, but gives the file location. ----- > $(err "OH NO!)+-- > $(err "OH NO!") -- > main:Main main.hs:4:10 OH NO! err :: String -> Q Exp err str = do@@ -25,10 +28,20 @@   let prefix = (locationToString loc) ++ " "   [|error (prefix ++ str)|] --- | like Prelude.undefined, but gives the file location--- use trace to output the location.--- this way we still use undefined instead of calling error+-- | 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@@ -38,20 +51,43 @@   let prefix = (locationToString loc) ++ " "   [|trace (prefix ++ "undefined") undefined|] --- | like fromJust, but also shows the file location+-- | 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+  [|\_m -> case _m of+            Just _v -> _v             Nothing -> error msg|] --- | like fromRight, but also show the file location+-- | 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)|]+  [|\_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) |]

@@ -1,5 +1,5 @@ Name:                file-location-Version:             0.4.2+Version:             0.4.3 Synopsis:            common functions that show file location information Homepage:            https://github.com/gregwebs/FileLocation.hs License:             BSD3@@ -10,39 +10,53 @@ Build-type:          Simple Cabal-version:       >=1.6 Description: -    Common debugging/error/exception functions that give file location information+    Common debugging\/error\/exception functions that give file location information     .-    > $(err "OH NO!")-    >-    > main:Main main.hs:16:1 OH NO!+    @+    $(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]+    @+    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]+    @+    $(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"     .+    @+    ($(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 -Source-Repository head-  type: git-  location:    https://github.com/gregwebs/FileLocation.hs+extra-source-files:+    test/*.sh+    test/*.hs+    test/*.shelltest+    test/bench/*.hs+    test/bench/*.md+    test/bench/*.h  Library   Exposed-modules: FileLocation,@@ -55,4 +69,8 @@   Build-depends:  base >= 4 && < 5                 , template-haskell                 , transformers     >= 0.2 && < 0.3+                , containers +Source-Repository head+  type: git+  location:    https://github.com/gregwebs/FileLocation.hs

@@ -0,0 +1,13 @@+import 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+                     ]+                    ]

@@ -0,0 +1,33 @@+A 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.

@@ -0,0 +1,16 @@+#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+

@@ -0,0 +1,36 @@+{-# 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!")

@@ -0,0 +1,7 @@+{-# LANGUAGE CPP, TemplateHaskell #-}+import FileLocation+#include "consts.h"++main = do+  -- $(undef)+  $(err "Oh no!")

@@ -0,0 +1,24 @@++./test/main+>>>+[1,2,3]+Caught AException "main:Main test/main.hs:25:4"+Caught AException "main:Main test/main.hs:26:6 doh!"+Caught main:Main test/main.hs:27:4 fromJst: Nothing+Caught main:Main test/main.hs:28:4 fromRht: Left: "Lefty"+Caught Prelude.undefined+>>>2+TRACE: main:Main test/main.hs:22:84 trc+DEBUG: debugMsgIf: [1,2,3]+DEBUG: [1,2,3]+DEBUG: main:Main test/main.hs:22:67: [1,2,3]+DEBUG: Msg plain: [1,2,3]+DEBUG: main:Main test/main.hs:22:23 Msg TH: [1,2,3]+traceM: [1,2,3]+DEBUG: [1,2,3]+main:Main test/main.hs:29:3 undefined+main: main:Main test/main.hs:30:5 Oh no!+>>>= 1++rm ./test/main ./test/main.hi ./test/main.o+>>>= 0

@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable  #-}++import Data.Data (Data, Typeable)+import FileLocation+import Control.Exception.Base (SomeException, Exception(..))+import Prelude hiding (catch)+import Control.Exception.Control (catch)+++++data AException = AException String+     deriving (Show, Typeable)++instance Exception AException++++main = 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))+  $(err "Oh no!")

@@ -0,0 +1,2 @@+#!/bin/bash -x+ghc --make test/main.hs && shelltest test/file-location.shelltest