monadloc 0.5 → 0.6
raw patch · 5 files changed
+16/−179 lines, 5 filesdep −haskell-src-extsdep −mtldep −prettydep ~base
Dependencies removed: haskell-src-exts, mtl, pretty, syb
Dependency ranges changed: base
Files
- Control/Monad/Loc.hs +3/−3
- Control/Monad/Loc/MTL.hs +0/−42
- Control/Monad/Loc/Transformers.hs +6/−1
- MonadLoc.hs +0/−100
- monadloc.cabal +7/−33
Control/Monad/Loc.hs view
@@ -21,8 +21,8 @@ -} module Control.Monad.Loc (MonadLoc(..), withLocTH) where import Language.Haskell.TH.Syntax (qLocation, Loc(..), Q, Exp)-import Text.PrettyPrint import Prelude hiding (mod)+import Text.Printf -- | Generating stack traces for failures class Monad m => MonadLoc m where@@ -52,6 +52,6 @@ [| withLoc loc_msg |] showLoc :: Loc -> String-showLoc Loc{loc_module=mod, loc_filename=filename, loc_start=start} = render $+showLoc Loc{loc_module=mod, loc_filename=filename, loc_start=start} = {- text package <> char '.' <> -}- text mod <> parens (text filename) <> colon <+> text (show start)+ printf "%s (%s). %s" mod filename (show start)
− Control/Monad/Loc/MTL.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE OverlappingInstances #-}-module Control.Monad.Loc.MTL where--import Control.Monad.Loc--import Control.Monad.Error-import Control.Monad.List-import Control.Monad.Reader-import Control.Monad.State.Lazy as Lazy-import Control.Monad.State.Strict as Strict-import Control.Monad.Writer.Lazy as Lazy-import Control.Monad.Writer.Strict as Strict-import Control.Monad.RWS.Lazy as Lazy-import Control.Monad.RWS.Strict as Strict-import Data.Monoid--instance MonadLoc m => MonadLoc (ListT m) where- withLoc l = ListT . withLoc l . runListT--instance (Error e, MonadLoc m) => MonadLoc (ErrorT e m) where- withLoc l = ErrorT . withLoc l . runErrorT--instance MonadLoc m => MonadLoc (ReaderT r m) where- withLoc l m = ReaderT $ \r -> withLoc l $ runReaderT m r--instance (Monoid w, MonadLoc m) => MonadLoc (Lazy.WriterT w m) where- withLoc l = Lazy.WriterT . withLoc l . Lazy.runWriterT--instance MonadLoc m => MonadLoc (Lazy.StateT s m) where- withLoc l m = Lazy.StateT $ \s -> withLoc l $ Lazy.runStateT m s--instance (Monoid w, MonadLoc m) => MonadLoc (Lazy.RWST r w s m) where- withLoc l m = Lazy.RWST $ \r s -> withLoc l $ Lazy.runRWST m r s--instance (Monoid w, MonadLoc m) => MonadLoc (Strict.WriterT w m) where- withLoc l = Strict.WriterT . withLoc l . Strict.runWriterT--instance MonadLoc m => MonadLoc (Strict.StateT s m) where- withLoc l m = Strict.StateT $ \s -> withLoc l $ Strict.runStateT m s--instance (Monoid w, MonadLoc m) => MonadLoc (Strict.RWST r w s m) where- withLoc l m = Strict.RWST $ \r s -> withLoc l $ Strict.runRWST m r s
Control/Monad/Loc/Transformers.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE OverlappingInstances #-}++{-|+ This package contains MonadLoc instance declarations for the monad+ transformer type constructors in the @transformers@ package.+-}+ module Control.Monad.Loc.Transformers where import Control.Monad.Loc
− MonadLoc.hs
@@ -1,100 +0,0 @@-{-# LANGUAGE PatternGuards #-}--import Control.Applicative-import Data.Generics-import Language.Haskell.Exts.Annotated-import System.Environment-import Text.PrettyPrint--main :: IO ()-main = do- args <- getArgs- case args of-- (fn:inp:outp:_) -> do- Module l mhead opt imports decls- <- fromParseResult <$>- parseFileWithMode ourParseMode{parseFilename = fn} inp- let mod' = Module l mhead opt imports decls'- mname = case mhead of- Nothing -> ""- Just (ModuleHead _ mn _ _) -> prettyPrint mn- decls' = map (annotateDecl mname) decls- writeFile outp $ prettyPrintStyleMode style{lineLength=100000} ourPrintMode mod'--- writeFile outp $ exactPrint mod' []-- [] -> do- contents <- getContents- let Module l mhead opt imports decls =- fromParseResult $- parseFileContentsWithMode ourParseMode contents- let mod' = Module l mhead opt imports decls'- mname = case mhead of- Nothing -> ""- Just (ModuleHead _ mn _ _) -> prettyPrint mn- decls' = map (annotateDecl mname) decls-- putStrLn $ prettyPrintStyleMode style{lineLength=100000} ourPrintMode mod'-- _ -> error "USAGE: MonadLoc expects the input from stdin and writes to stdout"---ourParseMode :: ParseMode-ourParseMode = defaultParseMode { extensions =- [CPP- ,MultiParamTypeClasses- ,FunctionalDependencies- ,FlexibleContexts- ,FlexibleInstances- ,ExplicitForall- ,ExistentialQuantification- ,PatternGuards- ,ViewPatterns- ,Arrows- ,NamedFieldPuns- ,DisambiguateRecordFields- ,RecordWildCards- ,StandaloneDeriving- ,GeneralizedNewtypeDeriving- ,ScopedTypeVariables- ,PatternSignatures- ,PackageImports- ,QuasiQuotes- ,PostfixOperators]- }--ourPrintMode :: PPHsMode-ourPrintMode = defaultMode { linePragmas = True }---annotateDecl :: String -> Decl SrcSpanInfo -> Decl SrcSpanInfo-annotateDecl mname e@(FunBind _ (m:_)) = everywhere (mkT (annotateStatements (Just funName) mname)) e- where- funName = case m of- Match _ name _ _ _ -> prettyPrint name- InfixMatch _ _ name _ _ _ -> prettyPrint name--annotateDecl mname e@(PatBind _ (PVar _ fn) _ _ _) = everywhere (mkT (annotateStatements (Just $ prettyPrint fn) mname)) e-annotateDecl mname e = everywhere (mkT (annotateStatements Nothing mname)) e--annotateStatements :: Maybe String -> String -> Exp SrcSpanInfo -> Exp SrcSpanInfo-annotateStatements fun m (Do loc stmts) = App loc (withLocCall fun m loc) (Paren loc $ Do loc $ map (annotateStmt fun m) stmts)-annotateStatements fun m (MDo loc stmts) = App loc (withLocCall fun m loc) (Paren loc $ MDo loc $ map (annotateStmt fun m) stmts)-annotateStatements _ _ e = e--annotateStmt :: Maybe String -> String -> Stmt SrcSpanInfo -> Stmt SrcSpanInfo-annotateStmt fun m (Generator loc pat exp) = Generator loc pat $ App loc (withLocCall fun m loc) (Paren loc exp)-annotateStmt fun m (Qualifier loc exp) = Qualifier loc $ App loc (withLocCall fun m loc) (Paren loc exp)-annotateStmt fun m (RecStmt loc stmts) = RecStmt loc $ map (annotateStmt fun m) stmts-annotateStmt _ _ stmt = stmt--withLocCall :: Maybe String -> String -> SrcSpanInfo -> Exp SrcSpanInfo-withLocCall fun m loc = App loc (Var loc withLoc) (Lit loc srclocLit)- where- withLoc = Qual loc (ModuleName loc "Control.Monad.Loc") (Ident loc "withLoc")- srclocLit = String loc (render locString) ""- locStringTail = text m <> parens(text (fileName loc)) <> colon <+> parens (int (startLine loc) <> comma <+> int(startColumn loc))- locString = case fun of- Nothing -> locStringTail- Just fun -> text fun <> comma <+> locStringTail-
monadloc.cabal view
@@ -1,5 +1,5 @@ name: monadloc-version: 0.5+version: 0.6 Cabal-Version: >= 1.6 build-type: Simple license: PublicDomain@@ -14,7 +14,7 @@ . * See the blog post <http://pepeiborra.posterous.com/monadic-stack-traces-that-make-a-lot-of-sense> for more information. .- A preprocessor is provided which can insert calls+ A preprocessor is available (see the package monadloc-pp) which inserts calls to "Control.Monad.Loc.withLoc" before every monadic statement in a module. To invoke the preprocessor, add the pragma @OPTIONS_GHC -F -pgmF MonadLoc@ at the top of your Haskell files together with an import for the "Control.Monad.Loc" module .@@ -22,45 +22,19 @@ Currently the only package that does so is @control-monad-exception@, but any other package can implement it and provide monadic call traces. -Flag syb-in-base- default: False--Flag mtl- default: True--Flag transformers- default: True+ /Changes/:+ .+ * 0.6 - Extracted the preprocessor to a separate package @monadloc-pp@ to minimize the set of dependencies. Library buildable: True- build-depends: pretty, template-haskell-- if flag(syb-in-base)- build-depends: base >= 3 && < 4- else- build-depends: base >= 4 && < 5, syb-- if flag(mtl)- cpp-options: -DMTL- build-depends: mtl- exposed-modules: Control.Monad.Loc.MTL-- if flag(transformers)- cpp-options: -DTRANSFORMERS- build-depends: transformers- exposed-modules: Control.Monad.Loc.Transformers+ build-depends: base >= 4 && < 5, template-haskell, transformers ghc-options: -Wall -fno-warn-orphans extensions: FlexibleInstances, OverlappingInstances, UndecidableInstances, TemplateHaskell, PatternGuards exposed-modules: Control.Monad.Loc--Executable MonadLoc- buildable: True- build-depends: haskell-src-exts >= 1.3.0- main-is: MonadLoc.hs- ghc-options: -Wall -fno-warn-name-shadowing-+ Control.Monad.Loc.Transformers source-repository head type: git