diff --git a/Language/Haskell/GhcMod/Boot.hs b/Language/Haskell/GhcMod/Boot.hs index cba7341..38f6ac4 100644 --- a/Language/Haskell/GhcMod/Boot.hs +++ b/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 opt cradle = withGHC' $ do - initializeFlagsWithCradle opt cradle - boot opt +bootInfo :: Options -> IO String +bootInfo opt = runGhcMod opt $ boot -- | Printing necessary information for front-end booting. -boot :: Options -> Ghc String -boot opt = do - mods <- modules opt +boot :: GhcMod String +boot = do + 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] diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index b2ce287..e7565e9 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/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 - initializeFlagsWithCradle opt cradle - modules opt +listModules opt _ = runGhcMod opt $ modules -- | Listing installed modules. -modules :: Options -> Ghc String -modules opt = convert opt . arrange <$> (getModules `G.gcatch` handler) +modules :: GhcMod String +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 - dropPkgs (name, pkg) + arrange opt = nub . sort . map (dropPkgs opt) + dropPkgs opt (name, pkg) | detailed opt = name ++ " " ++ pkg | otherwise = name handler (SomeException _) = return [] diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 5cfa8c1..58fc3c6 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/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 diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 98b2563..265be66 100644 --- a/src/GHCMod.hs +++ b/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) diff --git a/src/GHCModi.hs b/src/GHCModi.hs index aba6609..3695b21 100644 --- a/src/GHCModi.hs +++ b/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 mlibdir opt body = G.runGhc mlibdir $ do - initializeFlagsWithCradle opt cradle +run :: Cradle -> Maybe FilePath -> Options -> GhcMod a -> IO a +run _ _ opt body = runGhcMod opt $ do 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 - "find" -> findSym opt set arg mvar - "lint" -> lintStx opt set arg - "info" -> showInfo opt set arg - "type" -> showType opt set arg - "boot" -> bootIt opt set - "browse" -> browseIt opt set arg + "check" -> toGhcMod $ checkStx opt set arg + "find" -> toGhcMod $ findSym opt set arg mvar + "lint" -> toGhcMod $ lintStx opt set arg + "info" -> toGhcMod $ showInfo opt set arg + "type" -> toGhcMod $ showType opt set arg + "boot" -> bootIt set + "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 - -> Set FilePath - -> Ghc (String, Bool, Set FilePath) -bootIt opt set = do - ret <- boot opt +bootIt :: Set FilePath + -> GhcMod (String, Bool, Set FilePath) +bootIt set = do + ret <- boot return (ret, True, set) browseIt :: Options