ghc-mod 0.5.5 → 0.6.0

raw patch · 7 files changed

+136/−33 lines, 7 filesdep +attoparsecdep +attoparsec-enumeratordep +enumerator

Dependencies added: attoparsec, attoparsec-enumerator, enumerator, transformers

Files

• Cabal.hs +102/−0
• Check.hs +7/−4
• GHCMod.hs +1/−1
• Info.hs +9/−8
• Types.hs +11/−15
• elisp/ghc.el +1/−1
• ghc-mod.cabal +5/−4

@@ -0,0 +1,102 @@+module Cabal (initializeGHC) where++import Control.Applicative hiding (many)+import Data.Attoparsec.Char8+import Data.Attoparsec.Enumerator+import Data.Enumerator (run, ($$))+import Data.Enumerator.Binary (enumFile)+import Data.List+import GHC+import qualified HscTypes as H+import System.Directory+import System.FilePath+import Types++----------------------------------------------------------------++initializeGHC :: FilePath -> [String] -> Ghc FilePath+initializeGHC fileName options = do+    (owdir,mdirfile) <- getDirs+    case mdirfile of+        Nothing -> do+            initSession options Nothing+            return fileName+        Just (cdir,cfile) -> do+            midirs <- parseCabalFile cfile+            changeToCabalDirectory cdir+            let idirs = case midirs of+                    Nothing   -> [cdir,owdir]+                    Just dirs -> dirs ++ [owdir]+            initSession options (Just idirs)+            return (ajustFileName fileName owdir cdir)++----------------------------------------------------------------++parseCabalFile :: FilePath -> Ghc (Maybe [String])+parseCabalFile file = H.liftIO $ do+    res <- run (enumFile file $$ iterParser findTarget)+    case res of+        Right x -> return x+        Left  e -> error (show e)++findTarget :: Parser (Maybe [String])+findTarget = Just <$> hs_source_dirs+         <|> (anyChar >> findTarget)+         <|> Nothing <$ endOfInput++hs_source_dirs :: Parser [String]+hs_source_dirs = do+    satisfy $ inClass "hH"+    satisfy $ inClass "sS"+    char '-'+    satisfy $ inClass "sS"+    satisfy $ inClass "oO"+    satisfy $ inClass "uU"+    satisfy $ inClass "rR"+    satisfy $ inClass "cC"+    satisfy $ inClass "eE"+    char '-'+    satisfy $ inClass "dD"+    satisfy $ inClass "iI"+    satisfy $ inClass "rR"+    satisfy $ inClass "sS"+    char ':'+    many (char ' ')+    sepBy1 (many . satisfy $ notInClass " ,\n") (many1 . satisfy $ inClass " ,")++----------------------------------------------------------------++ajustFileName :: FilePath -> FilePath -> FilePath -> FilePath+ajustFileName name olddir newdir+  | olen == nlen = name+  | otherwise    = drop (nlen+1) olddir </> name+  where+    olen = length olddir+    nlen = length newdir++changeToCabalDirectory :: FilePath -> Ghc ()+changeToCabalDirectory dir = do+    H.liftIO $ setCurrentDirectory dir+    workingDirectoryChanged++getDirs :: Ghc (FilePath, Maybe (FilePath,FilePath))+getDirs = do+    wdir <- H.liftIO $ getCurrentDirectory+    mcabdir <- cabalDir wdir+    case mcabdir of+        Nothing -> return (wdir,Nothing)+        jdf     -> return (wdir,jdf)++cabalDir :: FilePath -> Ghc (Maybe (FilePath,FilePath))+cabalDir dir = do+    cnts <- H.liftIO $ getDirectoryContents dir+    case filter isCabal cnts of+        [] -> do+            let dir' = takeDirectory dir+            if dir' == dir+               then return Nothing+               else cabalDir dir'+        cfile:_ -> return (Just (dir,dir </> cfile))+  where+    isCabal name = ".cabal" `isSuffixOf` name+                && length name > 6

@@ -1,6 +1,7 @@ module Check (checkSyntax) where  import Bag+import Cabal import Control.Applicative import Data.IORef import ErrUtils@@ -9,9 +10,10 @@ import GHC import HscTypes import Outputable hiding (showSDoc)+import Prelude hiding (catch) import Pretty+import System.FilePath import Types-import Prelude hiding (catch)  ---------------------------------------------------------------- @@ -22,13 +24,14 @@  check :: String -> IO [String] check fileName = withGHC $ do+    file <- initializeGHC fileName options+    setTargetFile file     ref <- newRef []-    initSession ["-Wall","-fno-warn-unused-do-bind"]-    setTargetFile fileName     loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref     clearWarnings     readRef ref   where+    options = ["-Wall","-fno-warn-unused-do-bind"]     handleParseError ref e = do         liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e         return Succeeded@@ -52,7 +55,7 @@ showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg ++ "\0" ++ ext    where      spn = head (errMsgSpans err)-     file = unpackFS (srcSpanFile spn)+     file = takeFileName $ unpackFS (srcSpanFile spn)      line = show (srcSpanStartLine spn)      col  = show (srcSpanStartCol spn)      msg = showSDoc (errMsgShortDoc err)

@@ -21,7 +21,7 @@ ----------------------------------------------------------------  usage :: String-usage =    "ghc-mod version 0.5.5\n"+usage =    "ghc-mod version 0.6.0\n"         ++ "Usage:\n"         ++ "\t ghc-mod list [-l]\n"         ++ "\t ghc-mod lang [-l]\n"

@@ -1,18 +1,19 @@ module Info where +import Cabal import Control.Applicative hiding (empty)+import Control.Exception import Control.Monad+import Data.List import Data.Maybe import GHC+import HscTypes+import NameSet import Outputable import PprTyThing-import Types-import NameSet-import HscTypes-import Data.List-import Control.Exception import StringBuffer import System.Time+import Types  type Expression = String type ModuleString = String@@ -71,12 +72,12 @@ inModuleContext fileName modstr action = withGHC valid   where     valid = do-        initSession ["-w"]-        setTargetFile fileName+        file <- initializeGHC fileName ["-w"]+        setTargetFile file         loadWithLogger (\_ -> return ()) LoadAllTargets         mif setContextFromTarget action invalid     invalid = do-        initSession ["-w"]+        initializeGHC fileName ["-w"]         setTargetBuffer         loadWithLogger defaultWarnErrLogger LoadAllTargets         mif setContextFromTarget action (return errorMessage)

@@ -25,27 +25,23 @@ initSession0 :: Ghc [PackageId] initSession0 = getSessionDynFlags >>= setSessionDynFlags -initSession :: [String] -> Ghc [PackageId]-initSession cmdOpts = do+initSession :: [String] -> Maybe [FilePath] -> Ghc [PackageId]+initSession cmdOpts midirs = do     dflags <- getSessionDynFlags     let opts = map noLoc cmdOpts     (dflags',_,_) <- parseDynamicFlags dflags opts-    setSessionDynFlags $ setFlags dflags'+    setSessionDynFlags $ setFlags dflags' midirs  ---------------------------------------------------------------- -setFlags :: DynFlags -> DynFlags-setFlags d = d {-    importPaths = importPaths d ++ importDirs-  , packageFlags = ghcPackage : packageFlags d-  , ghcLink = NoLink--- GHC.desugarModule does not produces the pattern warnings, why?---  , hscTarget = HscNothing-  , hscTarget = HscInterpreted-  }--importDirs :: [String]-importDirs = ["..","../..","../../..","../../../..","../../../../.."]+setFlags :: DynFlags -> Maybe [FilePath] -> DynFlags+setFlags d midirs = maybe d' (\x -> d' { importPaths = x }) midirs+  where+    d' = d {+        packageFlags = ghcPackage : packageFlags d+      , ghcLink = NoLink+      , hscTarget = HscInterpreted+      }  ghcPackage :: PackageFlag ghcPackage = ExposePackage "ghc"

@@ -16,7 +16,7 @@  ;;; Code: -(defconst ghc-version "0.5.5")+(defconst ghc-version "0.6.0")  ;; (eval-when-compile ;;  (require 'haskell-mode))

@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                0.5.5+Version:                0.6.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -23,14 +23,15 @@                         ghc-flymake.el ghc-command.el ghc-info.el Executable ghc-mod   Main-Is:              GHCMod.hs-  Other-Modules:        List Browse Check Info Lang Lint Types+  Other-Modules:        List Browse Cabal Check Info Lang Lint Types   if impl(ghc >= 6.12)     GHC-Options:        -Wall -fno-warn-unused-do-bind   else     GHC-Options:        -Wall-  Build-Depends:        base >= 4.0 && < 5, ghc, ghc-paths,+  Build-Depends:        base >= 4.0 && < 5, ghc, ghc-paths, transformers,                         process, directory, filepath, old-time,-                        hlint >= 1.7.1+                        hlint >= 1.7.1,+                        attoparsec, enumerator, attoparsec-enumerator Source-Repository head   Type:                 git   Location:             git://github.com/kazu-yamamoto/ghc-mod.git