diff --git a/Check.hs b/Check.hs index 64939af..ecc6822 100644 --- a/Check.hs +++ b/Check.hs @@ -1,6 +1,7 @@ module Check (checkSyntax) where import Bag +import Cabal import Control.Applicative import Data.IORef import ErrUtils @@ -9,9 +10,9 @@ import FastString import GHC import HscTypes import Outputable hiding (showSDoc) +import Prelude hiding (catch) import Pretty import Types -import Prelude hiding (catch) ---------------------------------------------------------------- @@ -23,12 +24,24 @@ checkSyntax _ file = unlines <$> check file check :: String -> IO [String] check fileName = withGHC $ do ref <- newRef [] - initSession ["-Wall","-fno-warn-unused-do-bind"] - setTargetFile fileName + (owdir,mdirfile) <- getDirs + case mdirfile of + Nothing -> do + initSession options Nothing + setTargetFile 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) + setTargetFile (ajustFileName fileName owdir cdir) 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 @@ -66,4 +79,4 @@ showSDoc :: SDoc -> String showSDoc d = map toNull . Pretty.showDocWith PageMode $ d style where toNull '\n' = '\0' - toNull x = x + toNull x = x \ No newline at end of file diff --git a/Info.hs b/Info.hs index 596f064..4bbcfb6 100644 --- a/Info.hs +++ b/Info.hs @@ -71,12 +71,12 @@ inModuleContext :: FilePath -> ModuleString -> Ghc String -> IO String inModuleContext fileName modstr action = withGHC valid where valid = do - initSession ["-w"] + initSession ["-w"] Nothing setTargetFile fileName loadWithLogger (\_ -> return ()) LoadAllTargets mif setContextFromTarget action invalid invalid = do - initSession ["-w"] + initSession ["-w"] Nothing setTargetBuffer loadWithLogger defaultWarnErrLogger LoadAllTargets mif setContextFromTarget action (return errorMessage) diff --git a/Types.hs b/Types.hs index 9e20eed..22a3c1b 100644 --- a/Types.hs +++ b/Types.hs @@ -25,27 +25,23 @@ withGHC body = ghandle ignore $ runGhc (Just libdir) body 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" diff --git a/ghc-mod.cabal b/ghc-mod.cabal index d70176b..5eb9f4e 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -23,14 +23,15 @@ Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el 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