extract initializeGHC.

This commit is contained in:
Kazu Yamamoto 2011-05-24 16:17:19 +09:00
parent ce1123395b
commit 3b6848d7a5
2 changed files with 11 additions and 21 deletions

View File

@ -23,20 +23,9 @@ checkSyntax _ file = unlines <$> check file
check :: String -> IO [String] check :: String -> IO [String]
check fileName = withGHC $ do check fileName = withGHC $ do
file <- initializeGHC fileName options
setTargetFile file
ref <- newRef [] ref <- newRef []
(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 loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
clearWarnings clearWarnings
readRef ref readRef ref

17
Info.hs
View File

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