refactoring GHCApi.

Browse.hs

@@ -33,8 +33,8 @@ browseModule opt mdlName = convert opt . format <$> browse opt mdlName
     formatOps' [] = error "formatOps'"
 
 browse :: Options -> String -> IO [String]
-browse opt mdlName = withGHC $ do
+browse opt mdlName = withGHCDummyFile $ do
-    _ <- initSession0 opt
+    initializeFlags opt
     getModule >>= getModuleInfo >>= listExports
   where
     getModule = findModule (mkModuleName mdlName) Nothing

Check.hs

@@ -17,10 +17,10 @@ checkSyntax opt cradle file = unlines <$> check opt cradle file
 ----------------------------------------------------------------
 
 check :: Options -> Cradle -> String -> IO [String]
-check opt cradle fileName = withGHC' fileName $ checkIt `gcatch` handleErrMsg
+check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg
   where
     checkIt = do
-        readLog <- initializeGHC opt cradle fileName options True
+        readLog <- initializeFlagsWithCradle opt cradle fileName options True
         setTargetFile fileName
         _ <- load LoadAllTargets
         liftIO readLog

Debug.hs

@@ -1,4 +1,4 @@
-module Debug where
+module Debug (debugInfo) where
 
 import CabalApi
 import GHCApi
@@ -20,8 +20,8 @@ debug opt cradle fileName = do
             fromCabalFile (ghcOpts opt) cradle
           else
             return (ghcOpts opt, [], [], [])
-    dflags <- getDynFlags
+    dflags <- getDynamicFlags
-    fast <- isFastCheck dflags fileName (Just langext)
+    fast <- getFastCheck dflags fileName (Just langext)
     return [
         "GHC version:         " ++ ghcVer
       , "Current directory:   " ++ currentDir

GHCApi.hs

@@ -1,8 +1,17 @@
-module GHCApi where
+module GHCApi (
+    withGHC
+  , withGHCDummyFile
+  , initializeFlags
+  , initializeFlagsWithCradle
+  , setTargetFile
+  , getDynamicFlags
+  , getFastCheck
+  ) where
 
 import CabalApi
 import Control.Applicative
 import Control.Exception
+import Control.Monad
 import CoreMonad
 import Data.Maybe (isJust)
 import DynFlags
@@ -17,11 +26,11 @@ import Types
 
 ----------------------------------------------------------------
 
-withGHC :: Alternative m => Ghc (m a) -> IO (m a)
+withGHCDummyFile :: Alternative m => Ghc (m a) -> IO (m a)
-withGHC = withGHC' "Dummy"
+withGHCDummyFile = withGHC "Dummy"
 
-withGHC' :: Alternative m => FilePath -> Ghc (m a) -> IO (m a)
+withGHC :: Alternative m => FilePath -> Ghc (m a) -> IO (m a)
-withGHC' file body = ghandle ignore $ runGhc (Just libdir) $ do
+withGHC file body = ghandle ignore $ runGhc (Just libdir) $ do
     dflags <- getSessionDynFlags
     defaultCleanupHandler dflags body
   where
@@ -33,19 +42,11 @@ withGHC' file body = ghandle ignore $ runGhc (Just libdir) $ do
 
 ----------------------------------------------------------------
 
-initSession0 :: Options -> Ghc [PackageId]
-initSession0 opt = do
-    dflags0 <- getSessionDynFlags
-    dflags1 <- setGhcFlags dflags0 opt
-    setSessionDynFlags dflags1
-
-----------------------------------------------------------------
-
 importDirs :: [IncludeDir]
 importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
 
-initializeGHC :: Options -> Cradle -> FilePath -> [GHCOption] -> Bool -> Ghc LogReader
+initializeFlagsWithCradle :: Options -> Cradle -> FilePath -> [GHCOption] -> Bool -> Ghc LogReader
-initializeGHC opt cradle fileName ghcOptions logging
+initializeFlagsWithCradle opt cradle fileName ghcOptions logging
   | cabal     = do
       (gopts,idirs,depPkgs,hdrExts) <- liftIO $ fromCabalFile ghcOptions cradle
       initSession opt gopts idirs (Just depPkgs) (Just hdrExts) logging fileName
@@ -54,6 +55,8 @@ initializeGHC opt cradle fileName ghcOptions logging
   where
     cabal = isJust $ cradleCabalFile cradle
 
+----------------------------------------------------------------
+
 initSession :: Options
             -> [GHCOption]
             -> [IncludeDir]
@@ -70,20 +73,28 @@ initSession opt cmdOpts idirs mDepPkgs mLangExts logging file = do
   where
     setupDynamicFlags df0 = do
         df1 <- modifyFlagsWithOpts df0 cmdOpts
-        fast <- liftIO $ isFastCheck df0 file mLangExts
+        fast <- liftIO $ getFastCheck df0 file mLangExts
         let df2 = modifyFlags df1 idirs mDepPkgs fast (expandSplice opt)
         df3 <- setGhcFlags df2 opt
         liftIO $ setLogger logging df3
 
 ----------------------------------------------------------------
 
+initializeFlags :: Options -> Ghc ()
+initializeFlags opt = do
+    dflags0 <- getSessionDynFlags
+    dflags1 <- setGhcFlags dflags0 opt
+    void $ setSessionDynFlags dflags1
+
+----------------------------------------------------------------
+
 getHeaderExtension :: DynFlags -> FilePath -> IO [String]
 getHeaderExtension dflags file = map unLoc <$> getOptionsFromFile dflags file
 
 ----------------------------------------------------------------
 
-isFastCheck :: DynFlags -> FilePath -> Maybe [LangExt] -> IO Bool
+getFastCheck :: DynFlags -> FilePath -> Maybe [LangExt] -> IO Bool
-isFastCheck dflags file mLangExts = do
+getFastCheck dflags file mLangExts = do
     hdrExts <- getHeaderExtension dflags file
     return . not $ useTemplateHaskell mLangExts hdrExts
 
@@ -149,5 +160,5 @@ setTargetFile file = do
 
 ----------------------------------------------------------------
 
-getDynFlags :: IO DynFlags
+getDynamicFlags :: IO DynFlags
-getDynFlags = runGhc (Just libdir) getSessionDynFlags
+getDynamicFlags = runGhc (Just libdir) getSessionDynFlags

Info.hs

@@ -139,15 +139,15 @@ pprInfo pefas (thing, fixity, insts)
 
 inModuleContext :: Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String
 inModuleContext opt cradle fileName modstr action errmsg =
-    withGHC (valid ||> invalid ||> return errmsg)
+    withGHCDummyFile (valid ||> invalid ||> return errmsg)
   where
     valid = do
-        _ <- initializeGHC opt cradle fileName ["-w"] False
+        _ <- initializeFlagsWithCradle opt cradle fileName ["-w"] False
         setTargetFile fileName
         _ <- load LoadAllTargets
         doif setContextFromTarget action
     invalid = do
-        _ <- initializeGHC opt cradle fileName ["-w"] False
+        _ <- initializeFlagsWithCradle opt cradle fileName ["-w"] False
         setTargetBuffer
         _ <- load LoadAllTargets
         doif setContextFromTarget action

List.hs

@@ -14,8 +14,8 @@ listModules :: Options -> IO String
 listModules opt = convert opt . nub . sort <$> list opt
 
 list :: Options -> IO [String]
-list opt = withGHC $ do
+list opt = withGHCDummyFile $ do
-    _ <- initSession0 opt
+    initializeFlags opt
     getExposedModules <$> getSessionDynFlags
   where
     getExposedModules = map moduleNameString