monadloc 0.1 → 0.2

raw patch · 2 files changed

+39/−16 lines, 2 files

Files

• MonadLoc.hs +38/−15
• monadloc.cabal +1/−1

@@ -8,16 +8,37 @@  main :: IO () main = do-  (fn:inp:outp:_) <- getArgs-  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'+  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@@ -45,11 +66,13 @@ ourPrintMode :: PPHsMode ourPrintMode = defaultMode { linePragmas = True } + annotateDecl :: String -> Decl SrcSpanInfo -> Decl SrcSpanInfo-annotateDecl mname e@(FunBind loc (m:_)) = everywhere (mkT (annotateStatements (Just funName) mname)) e+annotateDecl mname e@(FunBind _ (m:_)) = everywhere (mkT (annotateStatements (Just funName) mname)) e   where-    funName | Match _ name _ _ _ <- m = prettyPrint name-            | InfixMatch _ _ name _ _ _ <- m = prettyPrint name+    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@@ -71,7 +94,7 @@    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-     | Nothing  <- fun = locStringTail-     | Just fun <- fun = text fun <> comma <+> locStringTail+   locString = case fun of+                 Nothing  -> locStringTail+                 Just fun -> text fun <> comma <+> locStringTail 

@@ -1,5 +1,5 @@ name: monadloc-version: 0.1+version: 0.2 Cabal-Version:  >= 1.2.3 build-type: Simple license: PublicDomain