Start migrating Ghc -> GhcMod monad

Language/Haskell/GhcMod/Boot.hs

@@ -2,27 +2,25 @@ module Language.Haskell.GhcMod.Boot where
 
 import Control.Applicative ((<$>))
 import CoreMonad (liftIO, liftIO)
-import GHC (Ghc)
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.Flag
-import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Lang
 import Language.Haskell.GhcMod.List
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 
 -- | Printing necessary information for front-end booting.
-bootInfo :: Options -> Cradle -> IO String
+bootInfo :: Options -> IO String
-bootInfo opt cradle = withGHC' $ do
+bootInfo opt = runGhcMod opt $ boot
-    initializeFlagsWithCradle opt cradle
-    boot opt
 
 -- | Printing necessary information for front-end booting.
-boot :: Options -> Ghc String
+boot :: GhcMod String
-boot opt = do
+boot = do
-    mods  <- modules opt
+    opt   <- options
+    mods  <- modules
     langs <- liftIO $ listLanguages opt
     flags <- liftIO $ listFlags opt
-    pre   <- concat <$> mapM (browse opt) preBrowsedModules
+    pre   <- concat <$> mapM (toGhcMod . browse opt) preBrowsedModules
     return $ mods ++ langs ++ flags ++ pre
 
 preBrowsedModules :: [String]

Language/Haskell/GhcMod/List.hs

@@ -3,9 +3,8 @@ module Language.Haskell.GhcMod.List (listModules, modules) where
 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
 import Data.List (nub, sort)
-import GHC (Ghc)
 import qualified GHC as G
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 import Packages (pkgIdMap, exposedModules, sourcePackageId, display)
 import UniqFM (eltsUFM)
@@ -14,13 +13,13 @@ import UniqFM (eltsUFM)
 
 -- | Listing installed modules.
 listModules :: Options -> Cradle -> IO String
-listModules opt cradle = withGHC' $ do
+listModules opt _ = runGhcMod opt $ modules
-    initializeFlagsWithCradle opt cradle
-    modules opt
 
 -- | Listing installed modules.
-modules :: Options -> Ghc String
+modules :: GhcMod String
-modules opt = convert opt . arrange <$> (getModules `G.gcatch` handler)
+modules = do
+    opt <- options
+    convert opt . (arrange opt) <$> (getModules `G.gcatch` handler)
   where
     getModules = getExposedModules <$> G.getSessionDynFlags
     getExposedModules = concatMap exposedModules'
@@ -29,8 +28,8 @@ modules opt = convert opt . arrange <$> (getModules `G.gcatch` handler)
         map G.moduleNameString (exposedModules p)
     	`zip`
         repeat (display $ sourcePackageId p)
-    arrange = nub . sort . map dropPkgs
+    arrange opt = nub . sort . map (dropPkgs opt)
-    dropPkgs (name, pkg)
+    dropPkgs opt (name, pkg)
       | detailed opt = name ++ " " ++ pkg
       | otherwise = name
     handler (SomeException _) = return []

Language/Haskell/GhcMod/Monad.hs

@@ -8,6 +8,7 @@ module Language.Haskell.GhcMod.Monad (
  , runGhcMod'
  , runGhcMod
  , toGhcMod
+ , options
  , module Control.Monad.Reader.Class
  , module Control.Monad.Writer.Class
  , module Control.Monad.State.Class
@@ -99,6 +100,9 @@ toGhcMod a = do
     s <- gmGhcSession <$> ask
     liftIO $ unGhc a $ Session s
 
+options :: GhcMod Options
+options = gmOptions <$> ask
+
 instance MonadBase IO GhcMod where
     liftBase = GhcMod . liftBase
 

src/GHCMod.hs

@@ -122,7 +122,7 @@ main = flip E.catches handlers $ do
       "lint"    -> nArgs 1 withFile (lintSyntax opt) cmdArg1
       "root"    -> rootInfo opt cradle
       "doc"     -> nArgs 1 $ packageDoc opt cradle cmdArg1
-      "boot"    -> bootInfo opt cradle
+      "boot"    -> bootInfo opt
       "version" -> return progVersion
       "help"    -> return $ O.usageInfo usage argspec
       cmd       -> E.throw (NoSuchCommand cmd)

src/GHCModi.hs

@@ -35,6 +35,7 @@ import GHC (Ghc)
 import qualified GHC as G
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Ghc
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Internal
 import Paths_ghc_mod
 import System.Console.GetOpt
@@ -116,9 +117,8 @@ replace (x:xs)    =  x  : replace xs
 
 ----------------------------------------------------------------
 
-run :: Cradle -> Maybe FilePath -> Options -> Ghc a -> IO a
+run :: Cradle -> Maybe FilePath -> Options -> GhcMod a -> IO a
-run cradle mlibdir opt body = G.runGhc mlibdir $ do
+run _ _ opt body = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
     dflags <- G.getSessionDynFlags
     G.defaultCleanupHandler dflags body
 
@@ -126,26 +126,26 @@ run cradle mlibdir opt body = G.runGhc mlibdir $ do
 
 setupDB :: Cradle -> Maybe FilePath -> Options -> MVar SymMdlDb -> IO ()
 setupDB cradle mlibdir opt mvar = E.handle handler $ do
-    db <- run cradle mlibdir opt getSymMdlDb
+    db <- run cradle mlibdir opt (toGhcMod getSymMdlDb)
     putMVar mvar db
   where
     handler (SomeException _) = return () -- fixme: put emptyDb?
 
 ----------------------------------------------------------------
 
-loop :: Options -> Set FilePath -> MVar SymMdlDb -> Ghc ()
+loop :: Options -> Set FilePath -> MVar SymMdlDb -> GhcMod ()
 loop opt set mvar = do
     cmdArg <- liftIO getLine
     let (cmd,arg') = break (== ' ') cmdArg
         arg = dropWhile (== ' ') arg'
     (ret,ok,set') <- case cmd of
-        "check"  -> checkStx opt set arg
+        "check"  -> toGhcMod $ checkStx opt set arg
-        "find"   -> findSym  opt set arg mvar
+        "find"   -> toGhcMod $ findSym  opt set arg mvar
-        "lint"   -> lintStx  opt set arg
+        "lint"   -> toGhcMod $ lintStx  opt set arg
-        "info"   -> showInfo opt set arg
+        "info"   -> toGhcMod $ showInfo opt set arg
-        "type"   -> showType opt set arg
+        "type"   -> toGhcMod $ showType opt set arg
-        "boot"   -> bootIt   opt set
+        "boot"   -> bootIt set
-        "browse" -> browseIt opt set arg
+        "browse" -> toGhcMod $ browseIt opt set arg
         "quit"   -> return ("quit", False, set)
         ""       -> return ("quit", False, set)
         _        -> return ([], True, set)
@@ -255,11 +255,10 @@ showType opt set fileArg  = do
 
 ----------------------------------------------------------------
 
-bootIt :: Options
+bootIt :: Set FilePath
-       -> Set FilePath
+       -> GhcMod (String, Bool, Set FilePath)
-       -> Ghc (String, Bool, Set FilePath)
+bootIt set = do
-bootIt opt set = do
+    ret <- boot
-    ret <- boot opt
     return (ret, True, set)
 
 browseIt :: Options