ghc-modi boot.

This commit is contained in:
Kazu Yamamoto 2014-04-21 16:30:31 +09:00
parent 152b218813
commit 4764ff1acb
4 changed files with 38 additions and 10 deletions

View File

@ -31,17 +31,17 @@ browseModule :: Options
-> Cradle -> Cradle
-> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> IO String -> IO String
browseModule opt cradle mdlName = withGHCDummyFile (browse opt cradle mdlName) browseModule opt cradle mdlName = withGHCDummyFile $ do
void $ initializeFlagsWithCradle opt cradle [] False
browse opt mdlName
-- | Getting functions, classes, etc from a module. -- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained. -- If 'detailed' is 'True', their types are also obtained.
-- If 'operators' is 'True', operators are also returned. -- If 'operators' is 'True', operators are also returned.
browse :: Options browse :: Options
-> Cradle
-> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> Ghc String -> Ghc String
browse opt cradle mdlName = do browse opt mdlName = do
void $ initializeFlagsWithCradle opt cradle [] False
convert opt . sort <$> (getModule >>= G.getModuleInfo >>= listExports) convert opt . sort <$> (getModule >>= G.getModuleInfo >>= listExports)
where where
getModule = G.findModule mdlname mpkgid `G.gcatch` fallback getModule = G.findModule mdlname mpkgid `G.gcatch` fallback

View File

@ -14,14 +14,15 @@ import UniqFM (eltsUFM)
-- | Listing installed modules. -- | Listing installed modules.
listModules :: Options -> Cradle -> IO String listModules :: Options -> Cradle -> IO String
listModules opt cradle = withGHCDummyFile (modules opt cradle) listModules opt cradle = withGHCDummyFile $ do
void $ initializeFlagsWithCradle opt cradle [] False
modules opt
-- | Listing installed modules. -- | Listing installed modules.
modules :: Options -> Cradle -> Ghc String modules :: Options -> Ghc String
modules opt cradle = do modules opt = convert opt . arrange <$> G.getSessionDynFlags
void $ initializeFlagsWithCradle opt cradle [] False
convert opt . nub . sort . map dropPkgs . getExposedModules <$> G.getSessionDynFlags
where where
arrange = nub . sort . map dropPkgs . getExposedModules
getExposedModules = concatMap exposedModules' getExposedModules = concatMap exposedModules'
. eltsUFM . pkgIdMap . G.pkgState . eltsUFM . pkgIdMap . G.pkgState
exposedModules' p = exposedModules' p =

View File

@ -1,7 +1,10 @@
module Boot where module Boot where
import Language.Haskell.GhcMod
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import CoreMonad (liftIO)
import GHC (Ghc)
import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Ghc
boot :: Options -> Cradle -> IO String boot :: Options -> Cradle -> IO String
boot opt cradle = do boot opt cradle = do
@ -12,6 +15,15 @@ boot opt cradle = do
pre <- concat <$> mapM (browseModule opt' cradle) preBrowsedModules pre <- concat <$> mapM (browseModule opt' cradle) preBrowsedModules
return $ mods ++ langs ++ flags ++ pre return $ mods ++ langs ++ flags ++ pre
boot' :: Options -> Ghc String
boot' opt = do
mods <- modules opt
langs <- liftIO $ listLanguages opt
flags <- liftIO $ listFlags opt
let opt' = addPackages opt
pre <- concat <$> mapM (browse opt') preBrowsedModules
return $ mods ++ langs ++ flags ++ pre
preBrowsedModules :: [String] preBrowsedModules :: [String]
preBrowsedModules = [ preBrowsedModules = [
"Prelude" "Prelude"

View File

@ -9,6 +9,7 @@
-- lint [hlint options] <file> -- lint [hlint options] <file>
-- the format of hlint options is [String] because they may contain -- the format of hlint options is [String] because they may contain
-- spaces and aslo <file> may contain spaces. -- spaces and aslo <file> may contain spaces.
-- boot
-- --
-- Session separators: -- Session separators:
-- OK -- success -- OK -- success
@ -53,6 +54,8 @@ import System.Directory (setCurrentDirectory)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.IO (hFlush,stdout) import System.IO (hFlush,stdout)
import Boot
---------------------------------------------------------------- ----------------------------------------------------------------
type DB = Map String [String] type DB = Map String [String]
@ -158,6 +161,7 @@ loop opt set mvar readLog = do
"lint" -> lintStx opt set arg "lint" -> lintStx opt set arg
"info" -> showInfo opt set arg readLog "info" -> showInfo opt set arg readLog
"type" -> showType opt set arg readLog "type" -> showType opt set arg readLog
"boot" -> bootIt opt set
_ -> return ([], False, set) _ -> return ([], False, set)
let put = case outputStyle opt of let put = case outputStyle opt of
LispStyle -> putStr LispStyle -> putStr
@ -244,6 +248,8 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
| p x = ([x],xs') | p x = ([x],xs')
| otherwise = let (ys,zs) = brk p xs' in (x:ys,zs) | otherwise = let (ys,zs) = brk p xs' in (x:ys,zs)
----------------------------------------------------------------
showInfo :: Options showInfo :: Options
-> Set FilePath -> Set FilePath
-> FilePath -> FilePath
@ -267,3 +273,12 @@ showType opt set fileArg readLog = do
ret <- types opt file (read line) (read column) ret <- types opt file (read line) (read column)
_ <- liftIO readLog _ <- liftIO readLog
return (ret, True, set') return (ret, True, set')
----------------------------------------------------------------
bootIt :: Options
-> Set FilePath
-> Ghc (String, Bool, Set FilePath)
bootIt opt set = do
ret <- boot' opt
return (ret, True, set)