Add functions for dealing with packages, modules and bindings to GHCApi

Language/Haskell/GhcMod/GHCApi.hs

@@ -9,6 +9,13 @@ module Language.Haskell.GhcMod.GHCApi (
   , withCmdFlags
   , setNoWaringFlags
   , setAllWaringFlags
+  , ghcPkgDb
+  , package
+  , modules
+  , findModule
+  , moduleInfo
+  , localModuleInfo
+  , bindings
   ) where
 
 import Language.Haskell.GhcMod.CabalApi
@@ -19,14 +26,17 @@ import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
 import Control.Monad (forM, void)
+import Distribution.Package (InstalledPackageId(..))
 import Data.Maybe (isJust, fromJust)
-import Exception (ghandle, SomeException(..))
+import qualified Data.Map.Strict as M
 import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
 import GhcMonad
 import GHC.Paths (libdir)
-import System.Exit (exitSuccess)
-import System.IO (hPutStr, hPrint, stderr)
+import qualified Packages as G
+import qualified Module as G
+import qualified OccName as G
+
 import System.IO.Unsafe (unsafePerformIO)
 
 ----------------------------------------------------------------
@@ -178,3 +188,76 @@ allWarningFlags = unsafePerformIO $ do
         df <- G.getSessionDynFlags
         df' <- addCmdOpts ["-Wall"] df
         return $ G.warningFlags df'
+
+----------------------------------------------------------------
+-- get Packages,Modules,Bindings
+
+ghcPkgDb :: GhcMonad m => m PkgDb
+ghcPkgDb = M.fromList <$>
+    maybe [] (map toKv . filterInternal) <$> pkgDatabase <$> G.getSessionDynFlags
+ where
+    toKv pkg = (fromInstalledPackageId $ G.installedPackageId pkg, pkg)
+    filterInternal =
+        filter ((/= InstalledPackageId "builtin_rts") . G.installedPackageId)
+
+package :: G.PackageConfig -> Package
+package = fromInstalledPackageId . G.installedPackageId
+
+modules :: G.PackageConfig -> [ModuleString]
+modules = map G.moduleNameString . G.exposedModules
+
+findModule :: ModuleString -> PkgDb -> [Package]
+findModule m db = do
+  M.elems $ package `M.map` (containsModule `M.filter` db)
+ where
+    containsModule :: G.PackageConfig -> Bool
+    containsModule pkgConf =
+        G.mkModuleName m `elem` G.exposedModules pkgConf
+
+
+ghcPkgId :: Package -> G.PackageId
+ghcPkgId (name,_,_) =
+    -- TODO: Adding the package version too breaks 'findModule' for some reason
+    -- this isn't a big deal since in the common case where we're in a cabal
+    -- project we just use cabal's view of package dependencies anyways so we're
+    -- guaranteed to only have one version of each package exposed. However when
+    -- we're operating without a cabal project this will probaly cause trouble.
+    G.stringToPackageId name
+
+type Binding = String
+
+-- | @moduleInfo mpkg module@. @mpkg@ should be 'Nothing' iff. moduleInfo
+-- should look for @module@ in the working directory.
+--
+-- To map a 'ModuleString' to a package see 'findModule'
+moduleInfo :: GhcMonad m
+           => Maybe Package
+           -> ModuleString
+           -> m (Maybe G.ModuleInfo)
+moduleInfo mpkg mdl = do
+    let mdlName = G.mkModuleName mdl
+        mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg
+    loadLocalModule
+    G.findModule mdlName mfsPkgId >>= G.getModuleInfo
+ where
+   loadLocalModule = case mpkg of
+       Just _ -> return ()
+       Nothing -> setTargetFiles [mdl]
+
+localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo)
+localModuleInfo mdl = moduleInfo Nothing mdl
+
+bindings :: G.ModuleInfo -> [Binding]
+bindings minfo = do
+  map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
+
+
+----------------------------------------------------------------
+-- for PkgDoc
+
+-- import Distribution.InstalledPackageInfo (showInstalledPackageInfoField)
+-- haddockHtml :: GhcMonad m => Package -> m String
+-- haddockHtml pkg = do
+--     extractField info . fromJust . lookup pkg <$> ghcPkgDb
+--  where
+--     extractField = fromJust $ showInstalledPackageInfoField "haddock-html"

Language/Haskell/GhcMod/Types.hs

@@ -1,6 +1,9 @@
 module Language.Haskell.GhcMod.Types where
 
 import Data.List (intercalate)
+import qualified Data.Map as M
+
+import PackageConfig (PackageConfig)
 
 -- | Output style.
 data OutputStyle = LispStyle  -- ^ S expression style.
@@ -87,6 +90,9 @@ showPkg (n,v,_) = intercalate "-" [n,v]
 showPkgId :: Package -> String
 showPkgId (n,v,i) = intercalate "-" [n,v,i]
 
+-- | Collection of packages
+type PkgDb = (M.Map Package PackageConfig)
+
 -- | Haskell expression.
 type Expression = String
 

test/GhcApiSpec.hs

@@ -0,0 +1,31 @@
+module GhcApiSpec where
+
+import Control.Applicative
+import Control.Monad
+import Data.List (sort)
+import Language.Haskell.GhcMod.GHCApi
+import Test.Hspec
+import TestUtils
+import CoreMonad (liftIO)
+
+import Dir
+
+spec :: Spec
+spec = do
+    describe "findModule" $ do
+        it "finds Data.List in `base' and `haskell2010'"
+            $ withDirectory_ "test/data" $ runD $ do
+                pkgs <- findModule "Data.List" <$> ghcPkgDb
+                let pkgNames = pkgName `map` pkgs
+                liftIO $ pkgNames `shouldContain` ["base", "haskell2010"]
+
+    describe "moduleInfo" $ do
+        it "works for modules from global packages (e.g. base:Data.List)"
+            $ withDirectory_ "test/data" $ runD $ do
+                Just info <- moduleInfo (Just ("base","","")) "Data.List"
+                liftIO $ sort (bindings info) `shouldContain` ["++"]
+
+        it "works for local modules"
+            $ withDirectory_ "test/data" $ runD $ do
+                Just info <- moduleInfo Nothing "Baz"
+                liftIO $ bindings info `shouldContain` ["baz"]