new include scheme.
This commit is contained in:
parent
8bb0c27b0b
commit
783e4a4e4c
17
Check.hs
17
Check.hs
@ -1,6 +1,7 @@
|
|||||||
module Check (checkSyntax) where
|
module Check (checkSyntax) where
|
||||||
|
|
||||||
import Bag
|
import Bag
|
||||||
|
import Cabal
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import ErrUtils
|
import ErrUtils
|
||||||
@ -9,9 +10,9 @@ import FastString
|
|||||||
import GHC
|
import GHC
|
||||||
import HscTypes
|
import HscTypes
|
||||||
import Outputable hiding (showSDoc)
|
import Outputable hiding (showSDoc)
|
||||||
|
import Prelude hiding (catch)
|
||||||
import Pretty
|
import Pretty
|
||||||
import Types
|
import Types
|
||||||
import Prelude hiding (catch)
|
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
@ -23,12 +24,24 @@ checkSyntax _ file = unlines <$> check file
|
|||||||
check :: String -> IO [String]
|
check :: String -> IO [String]
|
||||||
check fileName = withGHC $ do
|
check fileName = withGHC $ do
|
||||||
ref <- newRef []
|
ref <- newRef []
|
||||||
initSession ["-Wall","-fno-warn-unused-do-bind"]
|
(owdir,mdirfile) <- getDirs
|
||||||
|
case mdirfile of
|
||||||
|
Nothing -> do
|
||||||
|
initSession options Nothing
|
||||||
setTargetFile fileName
|
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
|
loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
|
||||||
clearWarnings
|
clearWarnings
|
||||||
readRef ref
|
readRef ref
|
||||||
where
|
where
|
||||||
|
options = ["-Wall","-fno-warn-unused-do-bind"]
|
||||||
handleParseError ref e = do
|
handleParseError ref e = do
|
||||||
liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
|
liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
|
||||||
return Succeeded
|
return Succeeded
|
||||||
|
4
Info.hs
4
Info.hs
@ -71,12 +71,12 @@ inModuleContext :: FilePath -> ModuleString -> Ghc String -> IO String
|
|||||||
inModuleContext fileName modstr action = withGHC valid
|
inModuleContext fileName modstr action = withGHC valid
|
||||||
where
|
where
|
||||||
valid = do
|
valid = do
|
||||||
initSession ["-w"]
|
initSession ["-w"] Nothing
|
||||||
setTargetFile fileName
|
setTargetFile fileName
|
||||||
loadWithLogger (\_ -> return ()) LoadAllTargets
|
loadWithLogger (\_ -> return ()) LoadAllTargets
|
||||||
mif setContextFromTarget action invalid
|
mif setContextFromTarget action invalid
|
||||||
invalid = do
|
invalid = do
|
||||||
initSession ["-w"]
|
initSession ["-w"] Nothing
|
||||||
setTargetBuffer
|
setTargetBuffer
|
||||||
loadWithLogger defaultWarnErrLogger LoadAllTargets
|
loadWithLogger defaultWarnErrLogger LoadAllTargets
|
||||||
mif setContextFromTarget action (return errorMessage)
|
mif setContextFromTarget action (return errorMessage)
|
||||||
|
20
Types.hs
20
Types.hs
@ -25,28 +25,24 @@ withGHC body = ghandle ignore $ runGhc (Just libdir) body
|
|||||||
initSession0 :: Ghc [PackageId]
|
initSession0 :: Ghc [PackageId]
|
||||||
initSession0 = getSessionDynFlags >>= setSessionDynFlags
|
initSession0 = getSessionDynFlags >>= setSessionDynFlags
|
||||||
|
|
||||||
initSession :: [String] -> Ghc [PackageId]
|
initSession :: [String] -> Maybe [FilePath] -> Ghc [PackageId]
|
||||||
initSession cmdOpts = do
|
initSession cmdOpts midirs = do
|
||||||
dflags <- getSessionDynFlags
|
dflags <- getSessionDynFlags
|
||||||
let opts = map noLoc cmdOpts
|
let opts = map noLoc cmdOpts
|
||||||
(dflags',_,_) <- parseDynamicFlags dflags opts
|
(dflags',_,_) <- parseDynamicFlags dflags opts
|
||||||
setSessionDynFlags $ setFlags dflags'
|
setSessionDynFlags $ setFlags dflags' midirs
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
setFlags :: DynFlags -> DynFlags
|
setFlags :: DynFlags -> Maybe [FilePath] -> DynFlags
|
||||||
setFlags d = d {
|
setFlags d midirs = maybe d' (\x -> d' { importPaths = x }) midirs
|
||||||
importPaths = importPaths d ++ importDirs
|
where
|
||||||
, packageFlags = ghcPackage : packageFlags d
|
d' = d {
|
||||||
|
packageFlags = ghcPackage : packageFlags d
|
||||||
, ghcLink = NoLink
|
, ghcLink = NoLink
|
||||||
-- GHC.desugarModule does not produces the pattern warnings, why?
|
|
||||||
-- , hscTarget = HscNothing
|
|
||||||
, hscTarget = HscInterpreted
|
, hscTarget = HscInterpreted
|
||||||
}
|
}
|
||||||
|
|
||||||
importDirs :: [String]
|
|
||||||
importDirs = ["..","../..","../../..","../../../..","../../../../.."]
|
|
||||||
|
|
||||||
ghcPackage :: PackageFlag
|
ghcPackage :: PackageFlag
|
||||||
ghcPackage = ExposePackage "ghc"
|
ghcPackage = ExposePackage "ghc"
|
||||||
|
|
||||||
|
@ -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
|
ghc-flymake.el ghc-command.el ghc-info.el
|
||||||
Executable ghc-mod
|
Executable ghc-mod
|
||||||
Main-Is: GHCMod.hs
|
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)
|
if impl(ghc >= 6.12)
|
||||||
GHC-Options: -Wall -fno-warn-unused-do-bind
|
GHC-Options: -Wall -fno-warn-unused-do-bind
|
||||||
else
|
else
|
||||||
GHC-Options: -Wall
|
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,
|
process, directory, filepath, old-time,
|
||||||
hlint >= 1.7.1
|
hlint >= 1.7.1,
|
||||||
|
attoparsec, enumerator, attoparsec-enumerator
|
||||||
Source-Repository head
|
Source-Repository head
|
||||||
Type: git
|
Type: git
|
||||||
Location: git://github.com/kazu-yamamoto/ghc-mod.git
|
Location: git://github.com/kazu-yamamoto/ghc-mod.git
|
||||||
|
Loading…
Reference in New Issue
Block a user