type check.

Check.hs

@@ -3,7 +3,6 @@ module Check (checkSyntax) where
 import Bag
 import Control.Applicative
 import Data.IORef
-import DynFlags
 import ErrUtils
 import Exception
 import FastString
@@ -23,28 +22,18 @@ checkSyntax _ file = unlines <$> check file
 
 check :: String -> IO [String]
 check fileName = withGHC $ do
-    ref <- liftIO $ newIORef []
-    initSession
+    ref <- newRef []
+    initSession ["-Wall","-fno-warn-unused-do-bind"]
     setTargetFile fileName
     loadWithLogger (refLogger ref) LoadAllTargets `gcatch` handleParseError ref
     clearWarnings
-    liftIO $ readIORef ref
+    readRef ref
   where
-    -- I don't know why, but parseDynamicFlags must be used.
-    initSession = do
-        dflags <- getSessionDynFlags
-        (dflags',_,_) <- parseDynamicFlags dflags cmdOptions
-        setSessionDynFlags $ setFlags dflags'
-    setTargetFile file = do
-        target <- guessTarget file Nothing
-        setTargets [target]
     handleParseError ref e = do
         liftIO . writeIORef ref $ errBagToStrList . srcErrorMessages $ e
         return Succeeded
-
--- I don't know why, but parseDynamicFlags must be used.
-cmdOptions :: [Located String]
-cmdOptions = map noLoc ["-Wall","-fno-warn-unused-do-bind"]
+    newRef  = liftIO . newIORef
+    readRef = liftIO . readIORef
 
 ----------------------------------------------------------------
 
@@ -59,24 +48,6 @@ errBagToStrList = map showErrMsg . reverse . bagToList
 
 ----------------------------------------------------------------
 
-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 = ["..","../..","../../..","../../../../.."]
-
-ghcPackage :: PackageFlag
-ghcPackage = ExposePackage "ghc"
-
-----------------------------------------------------------------
-
 showErrMsg :: ErrMsg -> String
 showErrMsg err = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ msg ++ "\0" ++ ext
    where