packages feed

ghc-mod 4.0.0 → 4.0.1

raw patch · 10 files changed

+68/−66 lines, 10 filesdep ~base

Dependency ranges changed: base

Files

ChangeLog view
@@ -1,3 +1,7 @@+2014-04-03 v4.0.1+	* Displaying a qualified name for one if two unqualified names+	  are conflict.+ 2014-04-01 v4.0.0 	* Implementing interactive "ghc-modi" command. 	  "check", "find", and "lint" are available.
Language/Haskell/GhcMod/Browse.hs view
@@ -12,7 +12,7 @@ import FastString (mkFastString) import GHC (Ghc, GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module) import qualified GHC as G-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine)+import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified) import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Gap import Language.Haskell.GhcMod.Types@@ -130,7 +130,7 @@     | otherwise           = ty  showOutputable :: Outputable a => DynFlags -> a -> String-showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr+showOutputable dflag = unwords . lines . showPage dflag styleUnqualified . ppr  ---------------------------------------------------------------- @@ -147,4 +147,4 @@   where     mdl = G.moduleNameString (G.moduleName m)     names = G.modInfoExports inf-    toStr = showUnqualifiedOneLine dflag . ppr+    toStr = showOneLine dflag styleUnqualified . ppr
Language/Haskell/GhcMod/Doc.hs view
@@ -1,43 +1,22 @@ module Language.Haskell.GhcMod.Doc where  import DynFlags (DynFlags)+import GHC (Ghc)+import qualified GHC as G import Language.Haskell.GhcMod.Gap (withStyle, showDocWith)-import Outputable (SDoc, PprStyle, Depth(AllTheWay), mkUserStyle, alwaysQualify, neverQualify)+import Outputable (SDoc, PprStyle, mkUserStyle, Depth(AllTheWay), neverQualify) import Pretty (Mode(..)) -------------------------------------------------------------------{--pretty :: Outputable a => a -> String-pretty = showSDocForUser neverQualify . ppr--debug :: Outputable a => a -> b -> b-debug x v = trace (pretty x) v--}+showPage :: DynFlags -> PprStyle -> SDoc -> String+showPage dflag style = showDocWith dflag PageMode . withStyle dflag style -----------------------------------------------------------------+showOneLine :: DynFlags -> PprStyle -> SDoc -> String+showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style -styleQualified :: PprStyle-styleQualified = mkUserStyle alwaysQualify AllTheWay+getStyle :: Ghc PprStyle+getStyle = do+    unqual <- G.getPrintUnqual+    return $ mkUserStyle unqual AllTheWay  styleUnqualified :: PprStyle styleUnqualified = mkUserStyle neverQualify AllTheWay---------------------------------------------------------------------- For "ghc-mod type"-showQualifiedPage :: DynFlags -> SDoc -> String-showQualifiedPage dflag = showDocWith dflag PageMode . withStyle dflag styleQualified---- For "ghc-mod browse" and show GHC's error messages.-showUnqualifiedPage :: DynFlags -> SDoc -> String-showUnqualifiedPage dflag = showDocWith dflag PageMode-                          . withStyle dflag styleUnqualified---- Not used-showQualifiedOneLine :: DynFlags -> SDoc -> String-showQualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleQualified---- To write Haskell code in a buffer-showUnqualifiedOneLine :: DynFlags -> SDoc -> String-showUnqualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleUnqualified
Language/Haskell/GhcMod/ErrMsg.hs view
@@ -15,10 +15,10 @@ import GHC (Ghc, DynFlags, SrcSpan, Severity(SevError)) import qualified GHC as G import HscTypes (SourceError, srcErrorMessages)-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)+import Language.Haskell.GhcMod.Doc (showPage, getStyle) import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types (LineSeparator(..))-import Outputable (SDoc)+import Outputable (PprStyle, SDoc) import System.FilePath (normalise)  ----------------------------------------------------------------@@ -41,9 +41,9 @@     writeIORef ref id     return $! b [] -appendLogRef :: DynFlags -> LineSeparator -> LogRef -> a -> Severity -> SrcSpan -> b -> SDoc -> IO ()-appendLogRef df ls (LogRef ref) _ sev src _ msg = do-        let !l = ppMsg src sev df ls msg+appendLogRef :: DynFlags -> LineSeparator -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()+appendLogRef df ls (LogRef ref) _ sev src style msg = do+        let !l = ppMsg src sev df ls style msg         modifyIORef ref (\b -> b . (l:))  ----------------------------------------------------------------@@ -63,24 +63,25 @@ handleErrMsg :: LineSeparator -> SourceError -> Ghc [String] handleErrMsg ls err = do     dflag <- G.getSessionDynFlags-    return . errBagToStrList dflag ls . srcErrorMessages $ err+    style <- getStyle+    return . errBagToStrList dflag ls style . srcErrorMessages $ err -errBagToStrList :: DynFlags -> LineSeparator -> Bag ErrMsg -> [String]-errBagToStrList dflag ls = map (ppErrMsg dflag ls) . reverse . bagToList+errBagToStrList :: DynFlags -> LineSeparator -> PprStyle -> Bag ErrMsg -> [String]+errBagToStrList dflag ls style = map (ppErrMsg dflag ls style) . reverse . bagToList  ---------------------------------------------------------------- -ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String-ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext+ppErrMsg :: DynFlags -> LineSeparator -> PprStyle -> ErrMsg -> String+ppErrMsg dflag ls style err = ppMsg spn SevError dflag ls style msg ++ ext    where      spn = Gap.errorMsgSpan err      msg = errMsgShortDoc err-     ext = showMsg dflag ls (errMsgExtraInfo err)+     ext = showMsg dflag ls style (errMsgExtraInfo err) -ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String-ppMsg spn sev dflag ls msg = prefix ++ cts+ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> PprStyle -> SDoc -> String+ppMsg spn sev dflag ls style msg = prefix ++ cts   where-    cts  = showMsg dflag ls msg+    cts  = showMsg dflag ls style msg     defaultPrefix       | dopt Gap.dumpSplicesFlag dflag = ""       | otherwise                      = "Dummy:0:0:Error:"@@ -92,8 +93,8 @@  ---------------------------------------------------------------- -showMsg :: DynFlags -> LineSeparator -> SDoc -> String-showMsg dflag (LineSeparator lsep) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc+showMsg :: DynFlags -> LineSeparator -> PprStyle -> SDoc -> String+showMsg dflag (LineSeparator lsep) style sdoc = replaceNull $ showPage dflag style sdoc   where     replaceNull []        = []     replaceNull ('\n':xs) = lsep ++ replaceNull xs
Language/Haskell/GhcMod/GHCApi.hs view
@@ -91,8 +91,8 @@       where         pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle         compOpts-          | pkgDb == [] = CompilerOptions ghcopts importDirs []-          | otherwise   = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] []+          | null pkgDb = CompilerOptions ghcopts importDirs []+          | otherwise  = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] []         wdir = cradleCurrentDir cradle         rdir = cradleRootDir    cradle
Language/Haskell/GhcMod/Info.hs view
@@ -24,13 +24,13 @@ import qualified GHC as G import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged) import HscTypes (ms_imps)-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine, showQualifiedPage)+import Language.Haskell.GhcMod.Doc (showPage, showOneLine, getStyle) import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCChoice ((||>), goNext) import Language.Haskell.GhcMod.Gap (HasType(..)) import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types-import Outputable (ppr)+import Outputable (PprStyle, ppr) import TcHsSyn (hsPatType)  ----------------------------------------------------------------@@ -61,7 +61,8 @@     exprToInfo = do         dflag <- G.getSessionDynFlags         sdoc <- Gap.infoThing expr-        return $ showUnqualifiedPage dflag sdoc+        style <- getStyle+        return $ showPage dflag style sdoc  ---------------------------------------------------------------- @@ -108,11 +109,12 @@       ets <- mapM (getType tcm) es       pts <- mapM (getType tcm) ps       dflag <- G.getSessionDynFlags-      let sss = map (toTup dflag) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts]+      style <- getStyle+      let sss = map (toTup dflag style) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts]       return $ convert opt sss -    toTup :: DynFlags -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String)-    toTup dflag (spn, typ) = (fourInts spn, pretty dflag typ)+    toTup :: DynFlags -> PprStyle -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String)+    toTup dflag style (spn, typ) = (fourInts spn, pretty dflag style typ)      fourInts :: SrcSpan -> (Int,Int,Int,Int)     fourInts = fromMaybe (0,0,0,0) . Gap.getSrcSpan@@ -132,8 +134,8 @@ listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) -pretty :: DynFlags -> Type -> String-pretty dflag = showUnqualifiedOneLine dflag . Gap.typeForUser+pretty :: DynFlags -> PprStyle -> Type -> String+pretty dflag style = showOneLine dflag style . Gap.typeForUser  ---------------------------------------------------------------- @@ -154,7 +156,8 @@     setTargetBuffer = do         modgraph <- G.depanal [G.mkModuleName modstr] True         dflag <- G.getSessionDynFlags-        let imports = concatMap (map (showQualifiedPage dflag . ppr . G.unLoc)) $+        style <- getStyle+        let imports = concatMap (map (showPage dflag style . ppr . G.unLoc)) $                       map ms_imps modgraph ++ map G.ms_srcimps modgraph             moddef = "module " ++ sanitize modstr ++ " where"             header = moddef : imports
elisp/ghc.el view
@@ -11,7 +11,7 @@  ;;; Code: -(defconst ghc-version "4.0.0")+(defconst ghc-version "4.0.1")  ;; (eval-when-compile ;;  (require 'haskell-mode))
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                4.0.0+Version:                4.0.1 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3
src/GHCModi.hs view
@@ -14,7 +14,7 @@ module Main where  #ifndef MIN_VERSION_containers-#define MIN_VERSION_containers 1+#define MIN_VERSION_containers(x,y,z) 1 #endif  import Control.Applicative ((<$>))@@ -41,6 +41,7 @@ import HscTypes (SourceError) import Language.Haskell.GhcMod import Language.Haskell.GhcMod.Internal+import System.Directory (setCurrentDirectory) import System.IO (hFlush,stdout)  ----------------------------------------------------------------@@ -55,7 +56,10 @@  main :: IO () main = E.handle handler $ do-    cradle <- findCradle+    cradle0 <- findCradle+    let rootdir = cradleRootDir cradle0+        cradle = cradle0 { cradleCurrentDir = rootdir }+    setCurrentDirectory rootdir     mvar <- liftIO newEmptyMVar     mlibdir <- getSystemLibDir     void $ forkIO $ setupDB cradle mlibdir opt mvar
+ test/data/Bs.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}++module Bs where++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString as B++foo :: ByteString+foo = "foo"++bar = B.putStrLn foo