Add GHC-7.10 support
This commit is contained in:
parent
27c1eb1eb3
commit
2b4fd77c28
@ -13,7 +13,7 @@ import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Typ
|
||||
import qualified GHC as G
|
||||
import Language.Haskell.GhcMod.Convert
|
||||
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
|
||||
import Language.Haskell.GhcMod.Gap
|
||||
import Language.Haskell.GhcMod.Gap as Gap
|
||||
import Language.Haskell.GhcMod.Monad (GhcModT, options)
|
||||
import Language.Haskell.GhcMod.Target (setTargetFiles)
|
||||
import Language.Haskell.GhcMod.Types
|
||||
@ -127,7 +127,7 @@ tyType typ
|
||||
&& not (G.isClassTyCon typ) = Just "data"
|
||||
| G.isNewTyCon typ = Just "newtype"
|
||||
| G.isClassTyCon typ = Just "class"
|
||||
| G.isSynTyCon typ = Just "type"
|
||||
| Gap.isSynTyCon typ = Just "type"
|
||||
| otherwise = Nothing
|
||||
|
||||
removeForAlls :: Type -> Type
|
||||
|
@ -4,33 +4,27 @@ module Language.Haskell.GhcMod.CabalApi (
|
||||
getCompilerOptions
|
||||
, parseCabalFile
|
||||
, cabalAllBuildInfo
|
||||
, cabalDependPackages
|
||||
, cabalSourceDirs
|
||||
, cabalAllTargets
|
||||
, cabalConfigDependencies
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.CabalConfig
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets,
|
||||
toModuleString)
|
||||
import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, mkGHCCompilerId)
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
import Language.Haskell.GhcMod.Types
|
||||
|
||||
import MonadUtils (liftIO)
|
||||
import Control.Applicative ((<$>))
|
||||
import qualified Control.Exception as E
|
||||
import Control.Monad (filterM)
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Set (fromList, toList)
|
||||
import Distribution.Package (Dependency(Dependency)
|
||||
, PackageName(PackageName))
|
||||
import Distribution.Package (PackageName(PackageName))
|
||||
import qualified Distribution.Package as C
|
||||
import Distribution.PackageDescription (PackageDescription, BuildInfo, TestSuite, TestSuiteInterface(..), Executable)
|
||||
import Distribution.PackageDescription (PackageDescription, BuildInfo)
|
||||
import qualified Distribution.PackageDescription as P
|
||||
import Distribution.PackageDescription.Configuration (finalizePackageDescription)
|
||||
import Distribution.PackageDescription.Parse (readPackageDescription)
|
||||
import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
|
||||
import Distribution.Simple.Program as C (ghcProgram)
|
||||
import Distribution.Simple.Program.Types (programName, programFindVersion)
|
||||
import Distribution.System (buildPlatform)
|
||||
@ -78,7 +72,7 @@ parseCabalFile :: (IOish m, MonadError GhcModError m)
|
||||
-> FilePath
|
||||
-> m PackageDescription
|
||||
parseCabalFile cradle file = do
|
||||
cid <- liftIO getGHCId
|
||||
cid <- mkGHCCompilerId <$> liftIO getGHCVersion
|
||||
epgd <- liftIO $ readPackageDescription silent file
|
||||
flags <- cabalConfigFlags cradle
|
||||
case toPkgDesc cid flags epgd of
|
||||
@ -93,6 +87,14 @@ parseCabalFile cradle file = do
|
||||
where
|
||||
PackageName name = C.pkgName (P.package pd)
|
||||
|
||||
getGHCVersion :: IO Version
|
||||
getGHCVersion = do
|
||||
mv <- programFindVersion C.ghcProgram silent (programName C.ghcProgram)
|
||||
case mv of
|
||||
-- TODO: MonadError it up
|
||||
Nothing -> E.throwIO $ userError "ghc not found"
|
||||
Just v -> return v
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
|
||||
@ -130,15 +132,6 @@ cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Extracting package names of dependency.
|
||||
cabalDependPackages :: [BuildInfo] -> [PackageBaseName]
|
||||
cabalDependPackages bis = uniqueAndSort pkgs
|
||||
where
|
||||
pkgs = map getDependencyPackageName $ concatMap P.targetBuildDepends bis
|
||||
getDependencyPackageName (Dependency (PackageName nm) _) = nm
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Extracting include directories for modules.
|
||||
cabalSourceDirs :: [BuildInfo] -> [IncludeDir]
|
||||
cabalSourceDirs bis = uniqueAndSort $ concatMap P.hsSourceDirs bis
|
||||
@ -147,47 +140,3 @@ cabalSourceDirs bis = uniqueAndSort $ concatMap P.hsSourceDirs bis
|
||||
|
||||
uniqueAndSort :: [String] -> [String]
|
||||
uniqueAndSort = toList . fromList
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
getGHCId :: IO CompilerId
|
||||
getGHCId = CompilerId GHC <$> getGHC
|
||||
|
||||
getGHC :: IO Version
|
||||
getGHC = do
|
||||
mv <- programFindVersion C.ghcProgram silent (programName C.ghcProgram)
|
||||
case mv of
|
||||
-- TODO: MonadError it up
|
||||
Nothing -> E.throwIO $ userError "ghc not found"
|
||||
Just v -> return v
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Extracting all 'Module' 'FilePath's for libraries, executables,
|
||||
-- tests and benchmarks.
|
||||
cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String])
|
||||
cabalAllTargets pd = do
|
||||
exeTargets <- mapM getExecutableTarget $ P.executables pd
|
||||
testTargets <- mapM getTestTarget $ P.testSuites pd
|
||||
return (libTargets,concat exeTargets,concat testTargets,benchTargets)
|
||||
where
|
||||
lib = case P.library pd of
|
||||
Nothing -> []
|
||||
Just l -> P.libModules l
|
||||
|
||||
libTargets = map toModuleString lib
|
||||
benchTargets = benchmarkTargets pd
|
||||
|
||||
getTestTarget :: TestSuite -> IO [String]
|
||||
getTestTarget ts =
|
||||
case P.testInterface ts of
|
||||
(TestSuiteExeV10 _ filePath) -> do
|
||||
let maybeTests = [p </> e | p <- P.hsSourceDirs $ P.testBuildInfo ts, e <- [filePath]]
|
||||
liftIO $ filterM doesFileExist maybeTests
|
||||
(TestSuiteLibV09 _ moduleName) -> return [toModuleString moduleName]
|
||||
(TestSuiteUnsupported _) -> return []
|
||||
|
||||
getExecutableTarget :: Executable -> IO [String]
|
||||
getExecutableTarget exe = do
|
||||
let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]]
|
||||
liftIO $ filterM doesFileExist maybeExes
|
||||
|
@ -1,66 +1,26 @@
|
||||
{-# LANGUAGE RecordWildCards, CPP #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
-- | This module facilitates extracting information from Cabal's on-disk
|
||||
-- 'LocalBuildInfo' (@dist/setup-config@).
|
||||
-- | This module abstracts extracting information from Cabal's on-disk
|
||||
-- 'LocalBuildInfo' (@dist/setup-config@) for different version combinations of
|
||||
-- Cabal and GHC.
|
||||
module Language.Haskell.GhcMod.CabalConfig (
|
||||
CabalConfig
|
||||
, cabalConfigDependencies
|
||||
cabalConfigDependencies
|
||||
, cabalConfigFlags
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
import Language.Haskell.GhcMod.PathsAndFiles
|
||||
import Language.Haskell.GhcMod.Read
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
import Language.Haskell.GhcMod.World
|
||||
|
||||
import qualified Language.Haskell.GhcMod.Cabal16 as C16
|
||||
import qualified Language.Haskell.GhcMod.Cabal18 as C18
|
||||
import qualified Language.Haskell.GhcMod.Cabal21 as C21
|
||||
|
||||
#ifndef MIN_VERSION_mtl
|
||||
#define MIN_VERSION_mtl(x,y,z) 1
|
||||
#endif
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (void, mplus, when)
|
||||
#if MIN_VERSION_mtl(2,2,1)
|
||||
import Control.Monad.Except ()
|
||||
#else
|
||||
import Control.Monad.Error ()
|
||||
#endif
|
||||
import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
|
||||
import Distribution.Package (InstalledPackageId(..)
|
||||
, PackageIdentifier(..)
|
||||
, PackageName(..))
|
||||
import Control.Applicative
|
||||
import Distribution.Package (PackageIdentifier)
|
||||
import Distribution.PackageDescription (FlagAssignment)
|
||||
import Distribution.Simple.LocalBuildInfo (ComponentName)
|
||||
import MonadUtils (liftIO)
|
||||
|
||||
----------------------------------------------------------------
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Error
|
||||
|
||||
-- | 'Show'ed cabal 'LocalBuildInfo' string
|
||||
type CabalConfig = String
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
import Language.Haskell.GhcMod.CabalConfig.Ghc710
|
||||
#else
|
||||
import Language.Haskell.GhcMod.CabalConfig.PreGhc710
|
||||
#endif
|
||||
|
||||
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
|
||||
-- exist run @cabal configure@ i.e. configure with default options like @cabal
|
||||
-- build@ would do.
|
||||
getConfig :: (IOish m, MonadError GhcModError m)
|
||||
=> Cradle
|
||||
-> m CabalConfig
|
||||
getConfig cradle = do
|
||||
outOfDate <- liftIO $ isSetupConfigOutOfDate cradle
|
||||
when outOfDate configure
|
||||
liftIO (readFile file) `tryFix` \_ ->
|
||||
configure `modifyError'` GMECabalConfigure
|
||||
where
|
||||
file = setupConfigFile cradle
|
||||
prjDir = cradleRootDir cradle
|
||||
|
||||
configure :: (IOish m, MonadError GhcModError m) => m ()
|
||||
configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
|
||||
|
||||
-- | Get list of 'Package's needed by all components of the current package
|
||||
cabalConfigDependencies :: (IOish m, MonadError GhcModError m)
|
||||
@ -70,83 +30,6 @@ cabalConfigDependencies :: (IOish m, MonadError GhcModError m)
|
||||
cabalConfigDependencies cradle thisPkg =
|
||||
configDependencies thisPkg <$> getConfig cradle
|
||||
|
||||
-- | Extract list of depencenies for all components from 'CabalConfig'
|
||||
configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
|
||||
configDependencies thisPkg config = map fromInstalledPackageId deps
|
||||
where
|
||||
deps :: [InstalledPackageId]
|
||||
deps = case deps21 `mplus` deps18 `mplus` deps16 of
|
||||
Right ps -> ps
|
||||
Left msg -> error msg
|
||||
|
||||
-- True if this dependency is an internal one (depends on the library
|
||||
-- defined in the same package).
|
||||
internal pkgid = pkgid == thisPkg
|
||||
|
||||
-- Cabal >= 1.21
|
||||
deps21 :: Either String [InstalledPackageId]
|
||||
deps21 =
|
||||
map fst
|
||||
<$> filterInternal21
|
||||
<$> (readEither =<< extractField config "componentsConfigs")
|
||||
|
||||
filterInternal21
|
||||
:: [(ComponentName, C21.ComponentLocalBuildInfo, [ComponentName])]
|
||||
-> [(InstalledPackageId, C21.PackageIdentifier)]
|
||||
|
||||
filterInternal21 ccfg = [ (ipkgid, pkgid)
|
||||
| (_,clbi,_) <- ccfg
|
||||
, (ipkgid, pkgid) <- C21.componentPackageDeps clbi
|
||||
, not (internal . packageIdentifierFrom21 $ pkgid) ]
|
||||
|
||||
packageIdentifierFrom21 :: C21.PackageIdentifier -> PackageIdentifier
|
||||
packageIdentifierFrom21 (C21.PackageIdentifier (C21.PackageName myName) myVersion) =
|
||||
PackageIdentifier (PackageName myName) myVersion
|
||||
|
||||
-- Cabal >= 1.18 && < 1.21
|
||||
deps18 :: Either String [InstalledPackageId]
|
||||
deps18 =
|
||||
map fst
|
||||
<$> filterInternal
|
||||
<$> (readEither =<< extractField config "componentsConfigs")
|
||||
|
||||
filterInternal
|
||||
:: [(ComponentName, C18.ComponentLocalBuildInfo, [ComponentName])]
|
||||
-> [(InstalledPackageId, PackageIdentifier)]
|
||||
|
||||
filterInternal ccfg = [ (ipkgid, pkgid)
|
||||
| (_,clbi,_) <- ccfg
|
||||
, (ipkgid, pkgid) <- C18.componentPackageDeps clbi
|
||||
, not (internal pkgid) ]
|
||||
|
||||
-- Cabal 1.16 and below
|
||||
deps16 :: Either String [InstalledPackageId]
|
||||
deps16 = map fst <$> filter (not . internal . snd) . nub <$> do
|
||||
cbi <- concat <$> sequence [ extract "executableConfigs"
|
||||
, extract "testSuiteConfigs"
|
||||
, extract "benchmarkConfigs" ]
|
||||
:: Either String [(String, C16.ComponentLocalBuildInfo)]
|
||||
|
||||
return $ maybe [] C16.componentPackageDeps libraryConfig
|
||||
++ concatMap (C16.componentPackageDeps . snd) cbi
|
||||
where
|
||||
libraryConfig :: Maybe C16.ComponentLocalBuildInfo
|
||||
libraryConfig = do
|
||||
field <- find ("libraryConfig" `isPrefixOf`) (tails config)
|
||||
clbi <- stripPrefix " = " field
|
||||
if "Nothing" `isPrefixOf` clbi
|
||||
then Nothing
|
||||
else case readMaybe =<< stripPrefix "Just " clbi of
|
||||
Just x -> x
|
||||
Nothing -> error $ "reading libraryConfig failed\n" ++ show (stripPrefix "Just " clbi)
|
||||
|
||||
extract :: String -> Either String [(String, C16.ComponentLocalBuildInfo)]
|
||||
extract field = readConfigs field <$> extractField config field
|
||||
|
||||
readConfigs :: String -> String -> [(String, C16.ComponentLocalBuildInfo)]
|
||||
readConfigs f s = case readEither s of
|
||||
Right x -> x
|
||||
Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")"
|
||||
|
||||
-- | Get the flag assignment from the local build info of the given cradle
|
||||
cabalConfigFlags :: (IOish m, MonadError GhcModError m)
|
||||
@ -157,15 +40,3 @@ cabalConfigFlags cradle = do
|
||||
case configFlags config of
|
||||
Right x -> return x
|
||||
Left msg -> throwError (GMECabalFlags (GMEString msg))
|
||||
|
||||
-- | Extract the cabal flags from the 'CabalConfig'
|
||||
configFlags :: CabalConfig -> Either String FlagAssignment
|
||||
configFlags config = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags"
|
||||
|
||||
-- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable
|
||||
-- error message with lots of context on failure.
|
||||
extractField :: CabalConfig -> String -> Either String String
|
||||
extractField config field =
|
||||
case extractParens <$> find (field `isPrefixOf`) (tails config) of
|
||||
Just f -> Right f
|
||||
Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` config)
|
||||
|
@ -31,7 +31,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
|
||||
|
||||
|
||||
-- | ComponentLocalBuildInfo for Cabal <= 1.16
|
||||
module Language.Haskell.GhcMod.Cabal16 (
|
||||
module Language.Haskell.GhcMod.CabalConfig.Cabal16 (
|
||||
ComponentLocalBuildInfo
|
||||
, componentPackageDeps
|
||||
) where
|
@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
|
||||
|
||||
-- | ComponentLocalBuildInfo for Cabal >= 1.18
|
||||
module Language.Haskell.GhcMod.Cabal18 (
|
||||
module Language.Haskell.GhcMod.CabalConfig.Cabal18 (
|
||||
ComponentLocalBuildInfo
|
||||
, componentPackageDeps
|
||||
, componentLibraries
|
@ -30,7 +30,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
|
||||
|
||||
-- | ComponentLocalBuildInfo for Cabal >= 1.21
|
||||
module Language.Haskell.GhcMod.Cabal21 (
|
||||
module Language.Haskell.GhcMod.CabalConfig.Cabal21 (
|
||||
ComponentLocalBuildInfo
|
||||
, PackageIdentifier(..)
|
||||
, PackageName(..)
|
49
Language/Haskell/GhcMod/CabalConfig/Ghc710.hs
Normal file
49
Language/Haskell/GhcMod/CabalConfig/Ghc710.hs
Normal file
@ -0,0 +1,49 @@
|
||||
module Language.Haskell.GhcMod.CabalConfig.Ghc710 (
|
||||
configDependencies
|
||||
, configFlags
|
||||
, getConfig
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, externalPackageDeps)
|
||||
import qualified Distribution.Simple.LocalBuildInfo as LBI
|
||||
import Distribution.Simple.Configure (getConfigStateFile)
|
||||
import Distribution.Simple.Setup (configConfigurationsFlags)
|
||||
import Distribution.PackageDescription (FlagAssignment)
|
||||
|
||||
import MonadUtils (liftIO)
|
||||
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
import Language.Haskell.GhcMod.PathsAndFiles
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
import Language.Haskell.GhcMod.World
|
||||
|
||||
|
||||
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
|
||||
-- exist run @cabal configure@ i.e. configure with default options like @cabal
|
||||
-- build@ would do.
|
||||
getConfig :: (IOish m, MonadError GhcModError m)
|
||||
=> Cradle
|
||||
-> m LocalBuildInfo
|
||||
getConfig cradle = do
|
||||
outOfDate <- liftIO $ isSetupConfigOutOfDate cradle
|
||||
when outOfDate configure
|
||||
liftIO (getConfigStateFile file) `tryFix` \_ ->
|
||||
configure `modifyError'` GMECabalConfigure
|
||||
where
|
||||
file = setupConfigFile cradle
|
||||
prjDir = cradleRootDir cradle
|
||||
|
||||
configure :: (IOish m, MonadError GhcModError m) => m ()
|
||||
configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
|
||||
|
||||
configDependencies :: a -> LocalBuildInfo -> [Package]
|
||||
configDependencies _ lbi =
|
||||
[ fromInstalledPackageId instPkgId
|
||||
| (instPkgId, _) <- externalPackageDeps lbi ]
|
||||
|
||||
|
||||
configFlags :: LocalBuildInfo -> Either String FlagAssignment
|
||||
configFlags = Right . configConfigurationsFlags . LBI.configFlags
|
154
Language/Haskell/GhcMod/CabalConfig/PreGhc710.hs
Normal file
154
Language/Haskell/GhcMod/CabalConfig/PreGhc710.hs
Normal file
@ -0,0 +1,154 @@
|
||||
{-# LANGUAGE RecordWildCards, CPP #-}
|
||||
|
||||
-- | This module facilitates extracting information from Cabal's on-disk
|
||||
-- 'LocalBuildInfo' (@dist/setup-config@).
|
||||
module Language.Haskell.GhcMod.CabalConfig.PreGhc710 (
|
||||
configDependencies
|
||||
, configFlags
|
||||
, getConfig
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
import Language.Haskell.GhcMod.PathsAndFiles
|
||||
import Language.Haskell.GhcMod.Read
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
import Language.Haskell.GhcMod.World
|
||||
|
||||
import qualified Language.Haskell.GhcMod.CabalConfig.Cabal16 as C16
|
||||
import qualified Language.Haskell.GhcMod.CabalConfig.Cabal18 as C18
|
||||
import qualified Language.Haskell.GhcMod.CabalConfig.Cabal21 as C21
|
||||
|
||||
#ifndef MIN_VERSION_mtl
|
||||
#define MIN_VERSION_mtl(x,y,z) 1
|
||||
#endif
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (void, mplus, when)
|
||||
#if MIN_VERSION_mtl(2,2,1)
|
||||
import Control.Monad.Except ()
|
||||
#else
|
||||
import Control.Monad.Error ()
|
||||
#endif
|
||||
import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
|
||||
import Distribution.Package (InstalledPackageId(..)
|
||||
, PackageIdentifier(..)
|
||||
, PackageName(..))
|
||||
import Distribution.PackageDescription (FlagAssignment)
|
||||
import Distribution.Simple.LocalBuildInfo (ComponentName)
|
||||
import MonadUtils (liftIO)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | 'Show'ed cabal 'LocalBuildInfo' string
|
||||
type CabalConfig = String
|
||||
|
||||
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
|
||||
-- exist run @cabal configure@ i.e. configure with default options like @cabal
|
||||
-- build@ would do.
|
||||
getConfig :: (IOish m, MonadError GhcModError m)
|
||||
=> Cradle
|
||||
-> m CabalConfig
|
||||
getConfig cradle = do
|
||||
outOfDate <- liftIO $ isSetupConfigOutOfDate cradle
|
||||
when outOfDate configure
|
||||
liftIO (readFile file) `tryFix` \_ ->
|
||||
configure `modifyError'` GMECabalConfigure
|
||||
where
|
||||
file = setupConfigFile cradle
|
||||
prjDir = cradleRootDir cradle
|
||||
|
||||
configure :: (IOish m, MonadError GhcModError m) => m ()
|
||||
configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
|
||||
|
||||
|
||||
-- | Extract list of depencenies for all components from 'CabalConfig'
|
||||
configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
|
||||
configDependencies thisPkg config = map fromInstalledPackageId deps
|
||||
where
|
||||
deps :: [InstalledPackageId]
|
||||
deps = case deps21 `mplus` deps18 `mplus` deps16 of
|
||||
Right ps -> ps
|
||||
Left msg -> error msg
|
||||
|
||||
-- True if this dependency is an internal one (depends on the library
|
||||
-- defined in the same package).
|
||||
internal pkgid = pkgid == thisPkg
|
||||
|
||||
-- Cabal >= 1.21
|
||||
deps21 :: Either String [InstalledPackageId]
|
||||
deps21 =
|
||||
map fst
|
||||
<$> filterInternal21
|
||||
<$> (readEither =<< extractField config "componentsConfigs")
|
||||
|
||||
filterInternal21
|
||||
:: [(ComponentName, C21.ComponentLocalBuildInfo, [ComponentName])]
|
||||
-> [(InstalledPackageId, C21.PackageIdentifier)]
|
||||
|
||||
filterInternal21 ccfg = [ (ipkgid, pkgid)
|
||||
| (_,clbi,_) <- ccfg
|
||||
, (ipkgid, pkgid) <- C21.componentPackageDeps clbi
|
||||
, not (internal . packageIdentifierFrom21 $ pkgid) ]
|
||||
|
||||
packageIdentifierFrom21 :: C21.PackageIdentifier -> PackageIdentifier
|
||||
packageIdentifierFrom21 (C21.PackageIdentifier (C21.PackageName myName) myVersion) =
|
||||
PackageIdentifier (PackageName myName) myVersion
|
||||
|
||||
-- Cabal >= 1.18 && < 1.21
|
||||
deps18 :: Either String [InstalledPackageId]
|
||||
deps18 =
|
||||
map fst
|
||||
<$> filterInternal
|
||||
<$> (readEither =<< extractField config "componentsConfigs")
|
||||
|
||||
filterInternal
|
||||
:: [(ComponentName, C18.ComponentLocalBuildInfo, [ComponentName])]
|
||||
-> [(InstalledPackageId, PackageIdentifier)]
|
||||
|
||||
filterInternal ccfg = [ (ipkgid, pkgid)
|
||||
| (_,clbi,_) <- ccfg
|
||||
, (ipkgid, pkgid) <- C18.componentPackageDeps clbi
|
||||
, not (internal pkgid) ]
|
||||
|
||||
-- Cabal 1.16 and below
|
||||
deps16 :: Either String [InstalledPackageId]
|
||||
deps16 = map fst <$> filter (not . internal . snd) . nub <$> do
|
||||
cbi <- concat <$> sequence [ extract "executableConfigs"
|
||||
, extract "testSuiteConfigs"
|
||||
, extract "benchmarkConfigs" ]
|
||||
:: Either String [(String, C16.ComponentLocalBuildInfo)]
|
||||
|
||||
return $ maybe [] C16.componentPackageDeps libraryConfig
|
||||
++ concatMap (C16.componentPackageDeps . snd) cbi
|
||||
where
|
||||
libraryConfig :: Maybe C16.ComponentLocalBuildInfo
|
||||
libraryConfig = do
|
||||
field <- find ("libraryConfig" `isPrefixOf`) (tails config)
|
||||
clbi <- stripPrefix " = " field
|
||||
if "Nothing" `isPrefixOf` clbi
|
||||
then Nothing
|
||||
else case readMaybe =<< stripPrefix "Just " clbi of
|
||||
Just x -> x
|
||||
Nothing -> error $ "reading libraryConfig failed\n" ++ show (stripPrefix "Just " clbi)
|
||||
|
||||
extract :: String -> Either String [(String, C16.ComponentLocalBuildInfo)]
|
||||
extract field = readConfigs field <$> extractField config field
|
||||
|
||||
readConfigs :: String -> String -> [(String, C16.ComponentLocalBuildInfo)]
|
||||
readConfigs f s = case readEither s of
|
||||
Right x -> x
|
||||
Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")"
|
||||
|
||||
-- | Extract the cabal flags from the 'CabalConfig'
|
||||
configFlags :: CabalConfig -> Either String FlagAssignment
|
||||
configFlags config = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags"
|
||||
|
||||
-- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable
|
||||
-- error message with lots of context on failure.
|
||||
extractField :: CabalConfig -> String -> Either String String
|
||||
extractField config field =
|
||||
case extractParens <$> find (field `isPrefixOf`) (tails config) of
|
||||
Just f -> Right f
|
||||
Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` config)
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, FlexibleContexts, OverlappingInstances #-}
|
||||
{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-}
|
||||
|
||||
module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFound, whenFound') where
|
||||
|
||||
|
@ -31,6 +31,10 @@ import qualified HsPat as Ty
|
||||
import qualified Language.Haskell.Exts.Annotated as HE
|
||||
import Djinn.GHC
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
import GHC (unLoc)
|
||||
#endif
|
||||
|
||||
----------------------------------------------------------------
|
||||
-- INTIAL CODE FROM FUNCTION OR INSTANCE SIGNATURE
|
||||
----------------------------------------------------------------
|
||||
@ -97,7 +101,11 @@ getSignature modSum lineNo colNo = do
|
||||
p@ParsedModule{pm_parsed_source = ps} <- G.parseModule modSum
|
||||
-- Inspect the parse tree to find the signature
|
||||
case listifyParsedSpans ps (lineNo, colNo) :: [G.LHsDecl G.RdrName] of
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
[L loc (G.SigD (Ty.TypeSig names (L _ ty) _))] ->
|
||||
#else
|
||||
[L loc (G.SigD (Ty.TypeSig names (L _ ty)))] ->
|
||||
#endif
|
||||
-- We found a type signature
|
||||
return $ Just $ Signature loc (map G.unLoc names) ty
|
||||
[L _ (G.InstD _)] -> do
|
||||
@ -238,12 +246,24 @@ class FnArgsInfo ty name | ty -> name, name -> ty where
|
||||
|
||||
instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
|
||||
getFnName dflag style name = showOccName dflag style $ Gap.occName name
|
||||
getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
getFnArgs (G.HsForAllTy _ _ _ _ (L _ iTy))
|
||||
#else
|
||||
getFnArgs (G.HsForAllTy _ _ _ (L _ iTy))
|
||||
#endif
|
||||
= getFnArgs iTy
|
||||
|
||||
getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy
|
||||
getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) =
|
||||
(if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
|
||||
where fnarg ty = case ty of
|
||||
(G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
(G.HsForAllTy _ _ _ _ (L _ iTy)) ->
|
||||
#else
|
||||
(G.HsForAllTy _ _ _ (L _ iTy)) ->
|
||||
#endif
|
||||
fnarg iTy
|
||||
|
||||
(G.HsParTy (L _ iTy)) -> fnarg iTy
|
||||
(G.HsFunTy _ _) -> True
|
||||
_ -> False
|
||||
@ -478,7 +498,13 @@ getBindingsForRecPat (Ty.PrefixCon args) =
|
||||
getBindingsForRecPat (Ty.InfixCon (L _ a1) (L _ a2)) =
|
||||
M.union (getBindingsForPat a1) (getBindingsForPat a2)
|
||||
getBindingsForRecPat (Ty.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) =
|
||||
getBindingsForRecFields fields
|
||||
where getBindingsForRecFields [] = M.empty
|
||||
getBindingsForRecFields (map unLoc' fields)
|
||||
where
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
unLoc' = unLoc
|
||||
#else
|
||||
unLoc' = id
|
||||
#endif
|
||||
getBindingsForRecFields [] = M.empty
|
||||
getBindingsForRecFields (Ty.HsRecField {Ty.hsRecFieldArg = (L _ a)}:fs) =
|
||||
M.union (getBindingsForPat a) (getBindingsForRecFields fs)
|
||||
|
@ -26,7 +26,9 @@ import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils
|
||||
import Language.Haskell.GhcMod.PathsAndFiles
|
||||
import Language.Haskell.GhcMod.Gap (listVisibleModules)
|
||||
import Name (getOccString)
|
||||
import Module (moduleNameString, moduleName)
|
||||
import System.Directory (doesFileExist, getModificationTime)
|
||||
import System.FilePath ((</>), takeDirectory)
|
||||
import System.IO
|
||||
@ -139,22 +141,17 @@ isOlderThan cache file = do
|
||||
-- | Browsing all functions in all system/user modules.
|
||||
getSymbolTable :: IOish m => GhcModT m [(Symbol,[ModuleString])]
|
||||
getSymbolTable = do
|
||||
ghcModules <- G.packageDbModules True
|
||||
moduleInfos <- mapM G.getModuleInfo ghcModules
|
||||
let modules = do
|
||||
m <- ghcModules
|
||||
let moduleName = G.moduleNameString $ G.moduleName m
|
||||
-- modulePkg = G.packageIdString $ G.modulePackageId m
|
||||
return moduleName
|
||||
|
||||
df <- G.getSessionDynFlags
|
||||
let mods = listVisibleModules df
|
||||
moduleInfos <- mapM G.getModuleInfo mods
|
||||
return $ collectModules
|
||||
$ extractBindings `concatMap` (moduleInfos `zip` modules)
|
||||
$ extractBindings `concatMap` (moduleInfos `zip` mods)
|
||||
|
||||
extractBindings :: (Maybe G.ModuleInfo, ModuleString)
|
||||
extractBindings :: (Maybe G.ModuleInfo, G.Module)
|
||||
-> [(Symbol, ModuleString)]
|
||||
extractBindings (Nothing,_) = []
|
||||
extractBindings (Just inf,mdlname) =
|
||||
map (\name -> (getOccString name, mdlname)) names
|
||||
extractBindings (Just inf,mdl) =
|
||||
map (\name -> (getOccString name, moduleNameString $ moduleName mdl)) names
|
||||
where
|
||||
names = G.modInfoExports inf
|
||||
|
||||
|
@ -1,86 +0,0 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Language.Haskell.GhcMod.GHCApi (
|
||||
ghcPkgDb
|
||||
, package
|
||||
, modules
|
||||
, findModule
|
||||
, moduleInfo
|
||||
, localModuleInfo
|
||||
, bindings
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
import Language.Haskell.GhcMod.Monad (GhcModT)
|
||||
import Language.Haskell.GhcMod.Target (setTargetFiles)
|
||||
import Language.Haskell.GhcMod.Types
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Distribution.Package (InstalledPackageId(..))
|
||||
import qualified Data.Map as M
|
||||
import GHC (DynFlags(..))
|
||||
import qualified GHC as G
|
||||
import GhcMonad
|
||||
import qualified Packages as G
|
||||
import qualified Module as G
|
||||
import qualified OccName as G
|
||||
|
||||
----------------------------------------------------------------
|
||||
-- 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 = 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 :: IOish m
|
||||
=> Maybe Package
|
||||
-> ModuleString
|
||||
-> GhcModT 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 :: IOish m => ModuleString -> GhcModT m (Maybe G.ModuleInfo)
|
||||
localModuleInfo mdl = moduleInfo Nothing mdl
|
||||
|
||||
bindings :: G.ModuleInfo -> [Binding]
|
||||
bindings minfo = map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
|
@ -41,11 +41,17 @@ module Language.Haskell.GhcMod.Gap (
|
||||
, getClass
|
||||
, occName
|
||||
, setFlags
|
||||
, ghcVersion
|
||||
, mkGHCCompilerId
|
||||
, listVisibleModuleNames
|
||||
, listVisibleModules
|
||||
, Language.Haskell.GhcMod.Gap.isSynTyCon
|
||||
) where
|
||||
|
||||
import Control.Applicative hiding (empty)
|
||||
import Control.Monad (filterM)
|
||||
import CoreSyn (CoreExpr)
|
||||
import Data.Version (parseVersion)
|
||||
import Data.List (intersperse)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
@ -65,6 +71,9 @@ import PprTyThing
|
||||
import StringBuffer
|
||||
import TcType
|
||||
import Var (varType)
|
||||
import Config (cProjectVersion)
|
||||
|
||||
import Text.ParserCombinators.ReadP (readP_to_S)
|
||||
|
||||
import qualified Distribution.PackageDescription as P
|
||||
import qualified InstEnv
|
||||
@ -88,6 +97,19 @@ import Data.Convertible
|
||||
import RdrName (rdrNameOcc)
|
||||
#endif
|
||||
|
||||
import Distribution.Version
|
||||
import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
import Distribution.Simple.Compiler (CompilerInfo(..), AbiTag(..))
|
||||
import Packages (listVisibleModuleNames, lookupModuleInAllPackages)
|
||||
#endif
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import UniqFM (eltsUFM)
|
||||
import Packages (exposedModules, exposed, pkgIdMap)
|
||||
import PackageConfig (PackageConfig, packageConfigId)
|
||||
#endif
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
import qualified Data.IntSet as I (IntSet, empty)
|
||||
import qualified Distribution.ModuleName as M (ModuleName,toFilePath)
|
||||
@ -173,7 +195,11 @@ toStringBuffer = liftIO . stringToStringBuffer . unlines
|
||||
----------------------------------------------------------------
|
||||
|
||||
fOptions :: [String]
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
fOptions = [option | (FlagSpec option _ _ _) <- fFlags]
|
||||
++ [option | (FlagSpec option _ _ _) <- fWarningFlags]
|
||||
++ [option | (FlagSpec option _ _ _) <- fLangFlags]
|
||||
#elif __GLASGOW_HASKELL__ >= 704
|
||||
fOptions = [option | (option,_,_) <- fFlags]
|
||||
++ [option | (option,_,_) <- fWarningFlags]
|
||||
++ [option | (option,_,_) <- fLangFlags]
|
||||
@ -253,7 +279,12 @@ addPackageFlags :: [Package] -> DynFlags -> DynFlags
|
||||
addPackageFlags pkgs df =
|
||||
df { packageFlags = packageFlags df ++ expose `map` pkgs }
|
||||
where
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
expose :: Package -> PackageFlag
|
||||
expose pkg = ExposePackage (PackageIdArg $ showPkgId pkg) (ModRenaming True [])
|
||||
#else
|
||||
expose pkg = ExposePackageId $ showPkgId pkg
|
||||
#endif
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
@ -445,7 +476,12 @@ type GLMatchI = LMatch Id
|
||||
#endif
|
||||
|
||||
getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
-- Instance declarations of sort 'instance F (G a)'
|
||||
getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsForAllTy _ _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _))))}))] = Just (className, loc)
|
||||
-- Instance declarations of sort 'instance F G' (no variables)
|
||||
getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsAppTy (L _ (HsTyVar className)) _))}))] = Just (className, loc)
|
||||
#elif __GLASGOW_HASKELL__ >= 708
|
||||
-- Instance declarations of sort 'instance F (G a)'
|
||||
getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _))))}))] = Just (className, loc)
|
||||
-- Instance declarations of sort 'instance F G' (no variables)
|
||||
@ -464,7 +500,6 @@ occName :: RdrName -> OccName
|
||||
occName = rdrNameOcc
|
||||
#endif
|
||||
|
||||
----------------------------------------------------------------
|
||||
----------------------------------------------------------------
|
||||
|
||||
setFlags :: DynFlags -> DynFlags
|
||||
@ -473,3 +508,57 @@ setFlags df = df `gopt_unset` Opt_SpecConstr -- consume memory if -O2
|
||||
#else
|
||||
setFlags = id
|
||||
#endif
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
ghcVersion :: Version
|
||||
ghcVersion =
|
||||
case readP_to_S parseVersion $ cProjectVersion of
|
||||
[(ver, "")] -> ver
|
||||
_ -> error "parsing ghc version(cProjectVersion) failed."
|
||||
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
mkGHCCompilerId :: Version -> Distribution.Simple.Compiler.CompilerInfo
|
||||
-- TODO we should probably fill this out properly
|
||||
mkGHCCompilerId v =
|
||||
CompilerInfo (CompilerId GHC v) NoAbiTag Nothing Nothing Nothing
|
||||
#else
|
||||
mkGHCCompilerId :: Version -> CompilerId
|
||||
mkGHCCompilerId v = CompilerId GHC v
|
||||
#endif
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
-- Copied from ghc/InteractiveUI.hs
|
||||
allExposedPackageConfigs :: DynFlags -> [PackageConfig]
|
||||
allExposedPackageConfigs df = filter exposed $ eltsUFM $ pkgIdMap $ pkgState df
|
||||
|
||||
allExposedModules :: DynFlags -> [ModuleName]
|
||||
allExposedModules df = concat $ map exposedModules $ allExposedPackageConfigs df
|
||||
|
||||
listVisibleModuleNames :: DynFlags -> [ModuleName]
|
||||
listVisibleModuleNames = allExposedModules
|
||||
#endif
|
||||
|
||||
listVisibleModules :: DynFlags -> [GHC.Module]
|
||||
listVisibleModules df = let
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
modNames = listVisibleModuleNames df
|
||||
mods = [ m | mn <- modNames, (m, _) <- lookupModuleInAllPackages df mn ]
|
||||
#else
|
||||
pkgCfgs = allExposedPackageConfigs df
|
||||
mods = [ mkModule pid modname | p <- pkgCfgs
|
||||
, let pid = packageConfigId p
|
||||
, modname <- exposedModules p ]
|
||||
#endif
|
||||
in mods
|
||||
|
||||
isSynTyCon :: TyCon -> Bool
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
isSynTyCon = GHC.isTypeSynonymTyCon
|
||||
#else
|
||||
isSynTyCon = GHC.isSynTyCon
|
||||
#endif
|
||||
|
@ -13,9 +13,7 @@ module Language.Haskell.GhcMod.Internal (
|
||||
, parseCabalFile
|
||||
, getCompilerOptions
|
||||
, cabalAllBuildInfo
|
||||
, cabalDependPackages
|
||||
, cabalSourceDirs
|
||||
, cabalAllTargets
|
||||
-- * Various Paths
|
||||
, ghcLibDir
|
||||
, ghcModExecutable
|
||||
|
@ -1,32 +1,14 @@
|
||||
module Language.Haskell.GhcMod.Modules (modules) where
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Exception (SomeException(..))
|
||||
import Data.List (nub, sort)
|
||||
import qualified GHC as G
|
||||
import Language.Haskell.GhcMod.Convert
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Packages (pkgIdMap, exposedModules, sourcePackageId, display)
|
||||
import UniqFM (eltsUFM)
|
||||
import Language.Haskell.GhcMod.Gap (listVisibleModuleNames)
|
||||
import Module (moduleNameString)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Listing installed modules.
|
||||
modules :: IOish m => GhcModT m String
|
||||
modules = do
|
||||
opt <- options
|
||||
convert opt . arrange opt <$> (getModules `G.gcatch` handler)
|
||||
where
|
||||
getModules = getExposedModules <$> G.getSessionDynFlags
|
||||
getExposedModules = concatMap exposedModules'
|
||||
. eltsUFM . pkgIdMap . G.pkgState
|
||||
exposedModules' p =
|
||||
map G.moduleNameString (exposedModules p)
|
||||
`zip`
|
||||
repeat (display $ sourcePackageId p)
|
||||
arrange opt = nub . sort . map (dropPkgs opt)
|
||||
dropPkgs opt (name, pkg)
|
||||
| detailed opt = name ++ " " ++ pkg
|
||||
| otherwise = name
|
||||
handler (SomeException _) = return []
|
||||
modules = convert' =<< map moduleNameString . listVisibleModuleNames <$> G.getSessionDynFlags
|
||||
|
@ -221,22 +221,28 @@ initializeFlagsWithCradle opt c
|
||||
| otherwise = withSandbox
|
||||
where
|
||||
mCabalFile = cradleCabalFile c
|
||||
|
||||
cabal = isJust mCabalFile
|
||||
|
||||
ghcopts = ghcUserOptions opt
|
||||
|
||||
withCabal = do
|
||||
let Just cabalFile = mCabalFile
|
||||
pkgDesc <- parseCabalFile c cabalFile
|
||||
compOpts <- 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
|
||||
|
||||
(wdir, rdir) = (cradleCurrentDir c, cradleRootDir c)
|
||||
|
||||
initSession :: GhcMonad m
|
||||
=> Build
|
||||
|
@ -20,7 +20,7 @@ Description: The ghc-mod command is a backend command to enrich
|
||||
|
||||
Category: Development
|
||||
Cabal-Version: >= 1.10
|
||||
Build-Type: Simple
|
||||
Build-Type: Custom
|
||||
Data-Dir: elisp
|
||||
Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
|
||||
ghc-check.el ghc-process.el ghc-command.el ghc-info.el
|
||||
@ -63,11 +63,11 @@ Library
|
||||
Language.Haskell.GhcMod.Internal
|
||||
Other-Modules: Language.Haskell.GhcMod.Boot
|
||||
Language.Haskell.GhcMod.Browse
|
||||
Language.Haskell.GhcMod.Cabal16
|
||||
Language.Haskell.GhcMod.Cabal18
|
||||
Language.Haskell.GhcMod.Cabal21
|
||||
Language.Haskell.GhcMod.CabalApi
|
||||
Language.Haskell.GhcMod.CabalConfig.Cabal16
|
||||
Language.Haskell.GhcMod.CabalConfig.Cabal18
|
||||
Language.Haskell.GhcMod.CabalConfig.Cabal21
|
||||
Language.Haskell.GhcMod.CabalConfig
|
||||
Language.Haskell.GhcMod.CabalApi
|
||||
Language.Haskell.GhcMod.CaseSplit
|
||||
Language.Haskell.GhcMod.Check
|
||||
Language.Haskell.GhcMod.Convert
|
||||
@ -79,7 +79,6 @@ Library
|
||||
Language.Haskell.GhcMod.FillSig
|
||||
Language.Haskell.GhcMod.Find
|
||||
Language.Haskell.GhcMod.Flag
|
||||
Language.Haskell.GhcMod.GHCApi
|
||||
Language.Haskell.GhcMod.GHCChoice
|
||||
Language.Haskell.GhcMod.Gap
|
||||
Language.Haskell.GhcMod.GhcPkg
|
||||
@ -97,6 +96,13 @@ Library
|
||||
Language.Haskell.GhcMod.Types
|
||||
Language.Haskell.GhcMod.Utils
|
||||
Language.Haskell.GhcMod.World
|
||||
|
||||
if impl(ghc >= 7.10)
|
||||
Other-Modules: Language.Haskell.GhcMod.CabalConfig.Ghc710
|
||||
else
|
||||
Other-Modules: Language.Haskell.GhcMod.CabalConfig.PreGhc710
|
||||
|
||||
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, containers
|
||||
, deepseq
|
||||
@ -122,11 +128,16 @@ Library
|
||||
, haskell-src-exts
|
||||
, text
|
||||
, djinn-ghc >= 0.0.2.2
|
||||
if impl(ghc >= 7.8)
|
||||
if impl(ghc >= 7.10)
|
||||
Build-Depends: Cabal >= 1.18
|
||||
else
|
||||
|
||||
if impl(ghc == 7.8.*)
|
||||
Build-Depends: Cabal >= 1.18 && < 1.22
|
||||
|
||||
if impl(ghc < 7.8)
|
||||
Build-Depends: convertible
|
||||
, Cabal >= 1.10 && < 1.17
|
||||
|
||||
if impl(ghc <= 7.4.2)
|
||||
-- Only used to constrain random to a version that still works with GHC 7.4
|
||||
Build-Depends: random <= 1.0.1.1
|
||||
@ -189,6 +200,7 @@ Test-Suite spec
|
||||
Main-Is: Main.hs
|
||||
Hs-Source-Dirs: test, .
|
||||
Ghc-Options: -Wall
|
||||
CPP-Options: -DSPEC=1
|
||||
Type: exitcode-stdio-1.0
|
||||
Other-Modules: BrowseSpec
|
||||
CabalApiSpec
|
||||
@ -203,6 +215,7 @@ Test-Suite spec
|
||||
PathsAndFilesSpec
|
||||
Spec
|
||||
TestUtils
|
||||
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, containers
|
||||
, deepseq
|
||||
@ -229,14 +242,20 @@ Test-Suite spec
|
||||
, haskell-src-exts
|
||||
, text
|
||||
, djinn-ghc >= 0.0.2.2
|
||||
if impl(ghc >= 7.8)
|
||||
|
||||
if impl(ghc >= 7.10)
|
||||
Build-Depends: Cabal >= 1.18
|
||||
else
|
||||
|
||||
if impl(ghc == 7.8.*)
|
||||
Build-Depends: Cabal >= 1.18 && < 1.22
|
||||
|
||||
if impl(ghc < 7.8)
|
||||
Build-Depends: convertible
|
||||
, Cabal >= 1.10 && < 1.17
|
||||
|
||||
if impl(ghc < 7.6)
|
||||
Build-Depends: executable-path
|
||||
CPP-Options: -DSPEC=1
|
||||
|
||||
|
||||
Source-Repository head
|
||||
Type: git
|
||||
|
@ -88,9 +88,6 @@ ghcModUsage =
|
||||
\\n\
|
||||
\ - list [FLAGS...] | modules [FLAGS...]\n\
|
||||
\ List all visible modules.\n\
|
||||
\ Flags:\n\
|
||||
\ -d\n\
|
||||
\ Also print the modules' package.\n\
|
||||
\\n\
|
||||
\ - lang\n\
|
||||
\ List all known GHC language extensions.\n\
|
||||
@ -607,6 +604,7 @@ hlintArgSpec =
|
||||
[ option "h" ["hlintOpt"] "Option to be passed to hlint" $
|
||||
reqArg "hlintOpt" $ \h o -> o { hlintOpts = h : hlintOpts o }
|
||||
]
|
||||
|
||||
browseArgSpec :: [OptDescr (Options -> Options)]
|
||||
browseArgSpec =
|
||||
[ option "o" ["operators"] "Also print operators." $
|
||||
|
@ -9,7 +9,6 @@ import Language.Haskell.GhcMod.Types
|
||||
import Test.Hspec
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import System.Process (readProcess)
|
||||
|
||||
import Dir
|
||||
import TestUtils
|
||||
@ -47,19 +46,6 @@ spec = do
|
||||
includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"]
|
||||
(pkgName `map` depPackages res') `shouldContain` ["Cabal"]
|
||||
|
||||
|
||||
describe "cabalDependPackages" $ do
|
||||
it "extracts dependent packages" $ do
|
||||
crdl <- findCradle' "test/data/"
|
||||
pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal")
|
||||
pkgs `shouldBe` ["Cabal","base","template-haskell"]
|
||||
it "uses non default flags" $ do
|
||||
withDirectory_ "test/data/cabal-flags" $ do
|
||||
crdl <- findCradle
|
||||
_ <- readProcess "cabal" ["configure", "-ftest-flag"] ""
|
||||
pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "cabal-flags.cabal")
|
||||
pkgs `shouldBe` ["Cabal","base"]
|
||||
|
||||
describe "cabalSourceDirs" $ do
|
||||
it "extracts all hs-source-dirs" $ do
|
||||
crdl <- findCradle' "test/data/check-test-subdir"
|
||||
|
@ -1,29 +0,0 @@
|
||||
module GhcApiSpec where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.List (sort)
|
||||
import Language.Haskell.GhcMod.GHCApi
|
||||
import Test.Hspec
|
||||
import TestUtils
|
||||
|
||||
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"]
|
Loading…
Reference in New Issue
Block a user