browse takes a list of modules.

This commit is contained in:
Kazu Yamamoto 2010-04-30 16:27:10 +09:00
parent 90d6a70811
commit 20e68337d8
2 changed files with 10 additions and 11 deletions

View File

@ -3,7 +3,7 @@ module Browse (browseModule) where
import Control.Applicative import Control.Applicative
import Data.Char import Data.Char
import Data.List import Data.List
import DynFlags import Exception
import GHC import GHC
import GHC.Paths (libdir) import GHC.Paths (libdir)
import Name import Name
@ -17,14 +17,12 @@ browseModule opt mdlName = convert opt . validate <$> browse mdlName
validate = sort . filter (isAlpha.head) validate = sort . filter (isAlpha.head)
browse :: String -> IO [String] browse :: String -> IO [String]
browse mdlName = withGHCAPI (maybeNamesToStrings <$> lookupModuleInfo) browse mdlName = ghandle ignore $ runGhc (Just libdir) $ do
initSession
maybeNamesToStrings <$> lookupModuleInfo
where where
initSession = getSessionDynFlags >>= setSessionDynFlags
lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo
maybeNamesToStrings = maybe [] (map getOccString . modInfoExports) maybeNamesToStrings = maybe [] (map getOccString . modInfoExports)
ignore :: SomeException -> IO [String]
withGHCAPI :: Ghc a -> IO a ignore _ = return []
withGHCAPI body = defaultErrorHandler defaultDynFlags $
runGhc (Just libdir) $ do
getSessionDynFlags >>= setSessionDynFlags
body

View File

@ -2,10 +2,11 @@ module Main where
import Browse import Browse
import Check import Check
import Control.Applicative
import Control.Exception hiding (try) import Control.Exception hiding (try)
import Lang
import List import List
import Param import Param
import Lang
import Prelude hiding (catch) import Prelude hiding (catch)
import System.Console.GetOpt import System.Console.GetOpt
import System.Environment (getArgs) import System.Environment (getArgs)
@ -50,7 +51,7 @@ main = flip catch handler $ do
args <- getArgs args <- getArgs
let (opt,cmdArg) = parseArgs argspec args let (opt,cmdArg) = parseArgs argspec args
res <- case head cmdArg of res <- case head cmdArg of
"browse" -> browseModule opt (cmdArg !! 1) "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
"list" -> listModules opt "list" -> listModules opt
"check" -> checkSyntax opt (cmdArg !! 1) "check" -> checkSyntax opt (cmdArg !! 1)
"lang" -> listLanguages opt "lang" -> listLanguages opt