Merge pull request #287 from DanielG/dev-untangle

Untangle Monad.hs and GHCApi.hs and some other changes
This commit is contained in:
Kazu Yamamoto 2014-07-12 14:27:43 +09:00
commit d98cedc9c0
13 changed files with 286 additions and 201 deletions

View File

@ -10,10 +10,10 @@ import Data.List (sort)
import Data.Maybe (catMaybes)
import Exception (ghandle)
import FastString (mkFastString)
import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module)
import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon)
import qualified GHC as G
import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified)
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Convert
@ -144,7 +144,7 @@ browseAll dflag = do
is <- mapM G.getModuleInfo ms
return $ concatMap (toNameModule dflag) (zip ms is)
toNameModule :: DynFlags -> (Module, Maybe ModuleInfo) -> [(String,String)]
toNameModule :: DynFlags -> (G.Module, Maybe ModuleInfo) -> [(String,String)]
toNameModule _ (_,Nothing) = []
toNameModule dflag (m,Just inf) = map (\name -> (toStr name, mdl)) names
where

View File

@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.Check (
) where
import Control.Applicative ((<$>))
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.DynFlags
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Monad

View File

@ -4,12 +4,10 @@ import Control.Applicative ((<$>))
import CoreMonad (liftIO)
import Data.List (intercalate)
import Data.Maybe (isJust, fromJust)
import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.GHCChoice ((||>))
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Internal
----------------------------------------------------------------
@ -28,7 +26,7 @@ debugInfo = cradle >>= \c -> convert' =<< do
, "GHC options: " ++ unwords gopts
, "Include directories: " ++ unwords incDir
, "Dependent packages: " ++ intercalate ", " (map showPkg pkgs)
, "System libraries: " ++ systemLibDir
, "System libraries: " ++ ghcLibDir
]
where
simpleCompilerOption = options >>= \op ->

View File

@ -0,0 +1,108 @@
module Language.Haskell.GhcMod.DynFlags where
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Types
import Control.Applicative ((<$>))
import Control.Monad (forM, void)
import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
import qualified GHC as G
import GhcMonad
import GHC.Paths (libdir)
import System.IO.Unsafe (unsafePerformIO)
data Build = CabalPkg | SingleFile deriving Eq
setEmptyLogger :: DynFlags -> DynFlags
setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
-- we don't want to generate object code so we compile to bytecode
-- (HscInterpreted) which implies LinkInMemory
-- HscInterpreted
setLinkerOptions :: DynFlags -> DynFlags
setLinkerOptions df = df {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
setIncludeDirs idirs df = df { importPaths = idirs }
setBuildEnv :: Build -> DynFlags -> DynFlags
setBuildEnv build = setHideAllPackages build . setCabalPackage build
-- At the moment with this option set ghc only prints different error messages,
-- suggesting the user to add a hidden package to the build-depends in his cabal
-- file for example
setCabalPackage :: Build -> DynFlags -> DynFlags
setCabalPackage CabalPkg df = Gap.setCabalPkg df
setCabalPackage _ df = df
-- | Enable hiding of all package not explicitly exposed (like Cabal does)
setHideAllPackages :: Build -> DynFlags -> DynFlags
setHideAllPackages CabalPkg df = Gap.setHideAllPackages df
setHideAllPackages _ df = df
-- | Parse command line ghc options and add them to the 'DynFlags' passed
addCmdOpts :: GhcMonad m => [GHCOption] -> DynFlags -> m DynFlags
addCmdOpts cmdOpts df =
tfst <$> G.parseDynamicFlags df (map G.noLoc cmdOpts)
where
tfst (a,_,_) = a
----------------------------------------------------------------
-- | Set the files as targets and load them.
setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
setTargetFiles files = do
targets <- forM files $ \file -> G.guessTarget file Nothing
G.setTargets targets
void $ G.load LoadAllTargets
----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags = do
G.runGhc (Just libdir) G.getSessionDynFlags
withDynFlags :: GhcMonad m
=> (DynFlags -> DynFlags)
-> m a
-> m a
withDynFlags setFlags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflags <- G.getSessionDynFlags
void $ G.setSessionDynFlags (setFlags dflags)
return dflags
teardown = void . G.setSessionDynFlags
withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a
withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflags <- G.getSessionDynFlags >>= addCmdOpts flags
void $ G.setSessionDynFlags dflags
return dflags
teardown = void . G.setSessionDynFlags
----------------------------------------------------------------
-- | Set 'DynFlags' equivalent to "-w:".
setNoWaringFlags :: DynFlags -> DynFlags
setNoWaringFlags df = df { warningFlags = Gap.emptyWarnFlags}
-- | Set 'DynFlags' equivalent to "-Wall".
setAllWaringFlags :: DynFlags -> DynFlags
setAllWaringFlags df = df { warningFlags = allWarningFlags }
allWarningFlags :: Gap.WarnFlags
allWarningFlags = unsafePerformIO $ do
G.runGhc (Just libdir) $ do
df <- G.getSessionDynFlags
df' <- addCmdOpts ["-Wall"] df
return $ G.warningFlags df'
----------------------------------------------------------------

View File

@ -1,201 +1,87 @@
{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}
module Language.Haskell.GhcMod.GHCApi (
withGHC
, withGHC'
, initializeFlagsWithCradle
, setTargetFiles
, getDynamicFlags
, systemLibDir
, withDynFlags
, withCmdFlags
, setNoWaringFlags
, setAllWaringFlags
ghcPkgDb
, package
, modules
, findModule
, moduleInfo
, localModuleInfo
, bindings
) where
import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.GHCChoice
import Language.Haskell.GhcMod.GhcPkg
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Types
import Control.Applicative ((<$>))
import Control.Monad (forM, void)
import Data.Maybe (isJust, fromJust)
import Exception (ghandle, SomeException(..))
import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
import Distribution.Package (InstalledPackageId(..))
import qualified Data.Map as M
import GHC (DynFlags(..))
import qualified GHC as G
import GhcMonad
import GHC.Paths (libdir)
import System.Exit (exitSuccess)
import System.IO (hPutStr, hPrint, stderr)
import System.IO.Unsafe (unsafePerformIO)
import qualified Packages as G
import qualified Module as G
import qualified OccName as G
----------------------------------------------------------------
-- get Packages,Modules,Bindings
-- | Obtaining the directory for system libraries.
systemLibDir :: FilePath
systemLibDir = libdir
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
-- | Converting the 'Ghc' monad to the 'IO' monad.
withGHC :: FilePath -- ^ A target file displayed in an error message.
-> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.
-> IO a
withGHC file body = ghandle ignore $ withGHC' body
where
ignore :: SomeException -> IO a
ignore e = do
hPutStr stderr $ file ++ ":0:0:Error:"
hPrint stderr e
exitSuccess
modules :: G.PackageConfig -> [ModuleString]
modules = map G.moduleNameString . G.exposedModules
withGHC' :: Ghc a -> IO a
withGHC' body = do
G.runGhc (Just systemLibDir) $ do
dflags <- G.getSessionDynFlags
G.defaultCleanupHandler dflags body
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
----------------------------------------------------------------
importDirs :: [IncludeDir]
importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
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
data Build = CabalPkg | SingleFile deriving Eq
type Binding = String
-- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
initializeFlagsWithCradle :: GhcMonad m
=> Options
-> Cradle
-> m ()
initializeFlagsWithCradle opt cradle
| cabal = withCabal |||> withSandbox
| otherwise = withSandbox
where
mCradleFile = cradleCabalFile cradle
cabal = isJust mCradleFile
ghcopts = ghcOpts opt
withCabal = do
pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile
compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc
initSession CabalPkg opt compOpts
withSandbox = initSession SingleFile opt compOpts
where
pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle
compOpts
| null pkgOpts = CompilerOptions ghcopts importDirs []
| otherwise = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
wdir = cradleCurrentDir cradle
rdir = cradleRootDir cradle
-- | @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
initSession :: GhcMonad m
=> Build
-> Options
-> CompilerOptions
-> m ()
initSession build Options {..} CompilerOptions {..} = do
df <- G.getSessionDynFlags
void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
$ setLinkerOptions
$ setIncludeDirs includeDirs
$ setBuildEnv build
$ setEmptyLogger
$ Gap.addPackageFlags depPackages df)
setEmptyLogger :: DynFlags -> DynFlags
setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
----------------------------------------------------------------
-- we don't want to generate object code so we compile to bytecode
-- (HscInterpreted) which implies LinkInMemory
-- HscInterpreted
setLinkerOptions :: DynFlags -> DynFlags
setLinkerOptions df = df {
ghcLink = LinkInMemory
, hscTarget = HscInterpreted
}
setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
setIncludeDirs idirs df = df { importPaths = idirs }
setBuildEnv :: Build -> DynFlags -> DynFlags
setBuildEnv build = setHideAllPackages build . setCabalPackage build
-- At the moment with this option set ghc only prints different error messages,
-- suggesting the user to add a hidden package to the build-depends in his cabal
-- file for example
setCabalPackage :: Build -> DynFlags -> DynFlags
setCabalPackage CabalPkg df = Gap.setCabalPkg df
setCabalPackage _ df = df
-- | Enable hiding of all package not explicitly exposed (like Cabal does)
setHideAllPackages :: Build -> DynFlags -> DynFlags
setHideAllPackages CabalPkg df = Gap.setHideAllPackages df
setHideAllPackages _ df = df
-- | Parse command line ghc options and add them to the 'DynFlags' passed
addCmdOpts :: GhcMonad m => [GHCOption] -> DynFlags -> m DynFlags
addCmdOpts cmdOpts df =
tfst <$> G.parseDynamicFlags df (map G.noLoc cmdOpts)
where
tfst (a,_,_) = a
----------------------------------------------------------------
-- | Set the files as targets and load them.
setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
setTargetFiles files = do
targets <- forM files $ \file -> G.guessTarget file Nothing
G.setTargets targets
void $ G.load LoadAllTargets
----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags = do
G.runGhc (Just systemLibDir) G.getSessionDynFlags
withDynFlags :: GhcMonad m
=> (DynFlags -> DynFlags)
-> m a
-> m a
withDynFlags setFlags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflags <- G.getSessionDynFlags
void $ G.setSessionDynFlags (setFlags dflags)
return dflags
teardown = void . G.setSessionDynFlags
withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a
withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflags <- G.getSessionDynFlags >>= addCmdOpts flags
void $ G.setSessionDynFlags dflags
return dflags
teardown = void . G.setSessionDynFlags
----------------------------------------------------------------
-- | Set 'DynFlags' equivalent to "-w:".
setNoWaringFlags :: DynFlags -> DynFlags
setNoWaringFlags df = df { warningFlags = Gap.emptyWarnFlags}
-- | Set 'DynFlags' equivalent to "-Wall".
setAllWaringFlags :: DynFlags -> DynFlags
setAllWaringFlags df = df { warningFlags = allWarningFlags }
allWarningFlags :: Gap.WarnFlags
allWarningFlags = unsafePerformIO $ do
G.runGhc (Just systemLibDir) $ do
df <- G.getSessionDynFlags
df' <- addCmdOpts ["-Wall"] df
return $ G.warningFlags df'
bindings :: G.ModuleInfo -> [Binding]
bindings minfo = do
map (G.occNameString . G.getOccName) $ G.modInfoExports minfo

View File

@ -1,9 +1,6 @@
module Language.Haskell.GhcMod.Ghc (
-- * Converting the 'Ghc' monad to the 'IO' monad
withGHC
, withGHC'
-- * 'SymMdlDb'
, Symbol
Symbol
, SymMdlDb
, getSymMdlDb
, lookupSym
@ -11,4 +8,3 @@ module Language.Haskell.GhcMod.Ghc (
) where
import Language.Haskell.GhcMod.Find
import Language.Haskell.GhcMod.GHCApi

View File

@ -17,11 +17,9 @@ module Language.Haskell.GhcMod.Internal (
, cabalSourceDirs
, cabalAllTargets
-- * GHC.Paths
, systemLibDir
, ghcLibDir
-- * IO
, getDynamicFlags
-- * Initializing 'DynFlags'
, initializeFlagsWithCradle
-- * Targets
, setTargetFiles
-- * Logging
@ -36,8 +34,14 @@ module Language.Haskell.GhcMod.Internal (
, (|||>)
) where
import GHC.Paths (libdir)
import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.GHCChoice
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Types
-- | Obtaining the directory for ghc system libraries.
ghcLibDir :: FilePath
ghcLibDir = libdir

View File

@ -17,7 +17,7 @@ import GHC (DynFlags, SrcSpan, Severity(SevError))
import qualified GHC as G
import HscTypes (SourceError, srcErrorMessages)
import Language.Haskell.GhcMod.Doc (showPage, getStyle)
import Language.Haskell.GhcMod.GHCApi (withDynFlags, withCmdFlags)
import Language.Haskell.GhcMod.DynFlags (withDynFlags, withCmdFlags)
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Convert (convert')
import Language.Haskell.GhcMod.Monad

View File

@ -1,6 +1,6 @@
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
{-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Haskell.GhcMod.Monad (
@ -23,13 +23,18 @@ module Language.Haskell.GhcMod.Monad (
, module Control.Monad.State.Class
) where
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.GHCChoice
import Language.Haskell.GhcMod.CabalApi
import qualified Language.Haskell.GhcMod.Gap as Gap
import DynFlags
import Exception
import GHC
import qualified GHC as G
import GHC.Paths (libdir)
import GhcMonad
#if __GLASGOW_HASKELL__ <= 702
@ -49,7 +54,7 @@ import Data.Monoid (Monoid)
#endif
import Control.Applicative (Alternative)
import Control.Monad (MonadPlus, liftM)
import Control.Monad (MonadPlus, liftM, void)
import Control.Monad.Base (MonadBase, liftBase)
import Control.Monad.Reader.Class
@ -59,6 +64,7 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, con
import Control.Monad.Trans.RWS.Lazy (RWST(..), runRWST)
import Control.Monad.Writer.Class
import Data.Maybe (fromJust, isJust)
import Data.IORef (IORef, readIORef, writeIORef, newIORef)
import System.Exit (exitSuccess)
import System.IO (hPutStr, hPrint, stderr)
@ -80,6 +86,7 @@ defaultState = GhcModState
type GhcModWriter = ()
----------------------------------------------------------------
type GhcMod a = GhcModT IO a
newtype GhcModT m a = GhcModT {
@ -103,6 +110,51 @@ instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
#endif
----------------------------------------------------------------
-- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
initializeFlagsWithCradle :: GhcMonad m
=> Options
-> Cradle
-> m ()
initializeFlagsWithCradle opt c
| cabal = withCabal |||> withSandbox
| otherwise = withSandbox
where
mCradleFile = cradleCabalFile c
cabal = isJust mCradleFile
ghcopts = ghcOpts opt
withCabal = do
pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile
compOpts <- liftIO $ getCompilerOptions ghcopts c pkgDesc
initSession CabalPkg opt compOpts
withSandbox = initSession SingleFile opt compOpts
where
importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
pkgOpts = ghcDbStackOpts $ cradlePkgDbStack c
compOpts
| null pkgOpts = CompilerOptions ghcopts importDirs []
| otherwise = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
wdir = cradleCurrentDir c
rdir = cradleRootDir c
initSession :: GhcMonad m
=> Build
-> Options
-> CompilerOptions
-> m ()
initSession build Options {..} CompilerOptions {..} = do
df <- G.getSessionDynFlags
void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
$ setLinkerOptions
$ setIncludeDirs includeDirs
$ setBuildEnv build
$ setEmptyLogger
$ Gap.addPackageFlags depPackages df)
----------------------------------------------------------------
runGhcModT' :: (MonadIO m, MonadBaseControl IO m)
=> GhcModEnv
-> GhcModState

View File

@ -13,7 +13,7 @@ import GhcMonad
import qualified GHC as G
import GHC.SYB.Utils (Stage(..), everythingStaged)
import Language.Haskell.GhcMod.Doc (showOneLine, getStyle)
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors)
import qualified Language.Haskell.GhcMod.Gap as Gap
import Outputable (PprStyle)

View File

@ -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,12 +90,18 @@ 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
-- | Module name.
type ModuleString = String
-- | A Module
type Module = [String]
-- | Option information for GHC
data CompilerOptions = CompilerOptions {
ghcOptions :: [GHCOption] -- ^ Command line options

View File

@ -67,6 +67,7 @@ Library
Language.Haskell.GhcMod.Convert
Language.Haskell.GhcMod.Debug
Language.Haskell.GhcMod.Doc
Language.Haskell.GhcMod.DynFlags
Language.Haskell.GhcMod.FillSig
Language.Haskell.GhcMod.Find
Language.Haskell.GhcMod.Flag

31
test/GhcApiSpec.hs Normal file
View File

@ -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"]