GHC API for list!

GHCMod.hs

@@ -25,17 +25,12 @@ usage =    "ghc-mod version 0.4.0\n"
 ----------------------------------------------------------------
 
 defaultOptions :: Options
-defaultOptions = Options { convert = toPlain
-                         , ghcPkg  = "ghc-pkg"
-                         }
+defaultOptions = Options { convert = toPlain }
 
 argspec :: [OptDescr (Options -> Options)]
 argspec = [ Option "l" ["tolisp"]
             (NoArg (\opts -> opts { convert = toLisp }))
             "print as a list of Lisp"
-          , Option "p" ["ghc-pkg"]
-            (ReqArg (\str opts -> opts { ghcPkg = str }) "ghc-pkg")
-            "ghc-pkg path"
           ]
 
 parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])

List.hs

@@ -2,48 +2,24 @@ module List (listModules) where
 
 import Control.Applicative
 import Data.List
+import Exception
+import GHC
+import GHC.Paths (libdir)
+import Packages
 import Param
-import System.IO
-import System.Process
+import UniqFM
 
 ----------------------------------------------------------------
 
 listModules :: Options -> IO String
-listModules opt = convert opt . nub . sort . exposedModules <$> getDump opt
+listModules opt = convert opt . nub . sort <$> getModules
 
-getDump :: Options -> IO String
-getDump opt = do
-  (_,hout,_,_) <- runInteractiveProcess (ghcPkg opt) ["dump"] Nothing Nothing
-  hGetContents hout
-
-exposedModules :: String -> [String]
-exposedModules cs = concatMap words ms
+getModules :: IO [String]
+getModules = ghandle ignore $ runGhc (Just libdir) $ do
+    initSession
+    getExposedModules <$> getSessionDynFlags
   where
-    ls = unfoldLines cs
-    ms = values "exposed-modules: " ls
-
-values :: String -> [String] -> [String]
-values tag ls = value
-  where
-    value = map (drop len) fs
-    len = length tag
-    fs = filter (tag `isPrefixOf`) ls
-
-----------------------------------------------------------------
-
-unfoldLines :: String -> [String]
-unfoldLines xs = self xs
-  where
-    splitNL = break (== '\n')
-    self "" = []
-    self s  = let (l, s') = splitNL s
-              in case s' of
-                []          -> [l]
-                (_:' ':s'') -> cont s'' l
-                (_:s'')     -> l : self s''
-    cont s a = let (l, s') = splitNL $ dropWhile (== ' ') s
-                   a' = a ++ " " ++ l
-               in case s' of
-                 []          -> [a']
-                 (_:' ':s'') -> cont s'' a'
-                 (_:s'')     -> a' : self s''
+    initSession = getSessionDynFlags >>= setSessionDynFlags
+    getExposedModules = map moduleNameString . concatMap exposedModules . eltsUFM . pkgIdMap . pkgState
+    ignore :: SomeException -> IO [String]
+    ignore _ = return []

Param.hs

@@ -2,5 +2,4 @@ module Param where
 
 data Options = Options {
     convert :: [String] -> String
-  , ghcPkg  :: FilePath
   }