diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +## 0.1.7.0 - 2018-08-08 + + * Add support for ghc-8.4 and Cabal-2.2. + ## 0.1.6.1 - 2017-12-17 * Fixed `moduleinfo` command to load targets correctly. diff --git a/hdevtools.cabal b/hdevtools.cabal --- a/hdevtools.cabal +++ b/hdevtools.cabal @@ -1,5 +1,5 @@ name: hdevtools -version: 0.1.6.1 +version: 0.1.7.0 synopsis: Persistent GHC powered background server for FAST haskell development tools license: MIT license-file: LICENSE @@ -56,6 +56,7 @@ CommandLoop, Daemonize, FindSymbol, + GhcTypes, Info, Server, Stack, diff --git a/src/Cabal.hs b/src/Cabal.hs --- a/src/Cabal.hs +++ b/src/Cabal.hs @@ -19,7 +19,12 @@ import Distribution.Package (PackageIdentifier(..), PackageName) #endif import Distribution.PackageDescription (PackageDescription(..), Executable(..), TestSuite(..), Benchmark(..), emptyHookedBuildInfo, buildable, libBuildInfo) -import Distribution.PackageDescription.Parse (readPackageDescription) +import qualified Distribution.PackageDescription as Distribution +#if MIN_VERSION_Cabal(2, 2, 0) +import qualified Distribution.PackageDescription.Parsec as Distribution +#else +import qualified Distribution.PackageDescription.Parse as Distribution +#endif import Distribution.Simple.Configure (configure) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), Component(..), componentName, getComponentLocalBuildInfo, componentBuildInfo) import Distribution.Simple.Compiler (PackageDB(..)) @@ -29,18 +34,26 @@ import Distribution.Simple.Program.Db (lookupProgram) import Distribution.Simple.Program.Types (ConfiguredProgram(programVersion), simpleProgram) import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions) -import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, configureCommand, toFlag) +import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, configureCommand, toFlag, flagToMaybe) #if MIN_VERSION_Cabal(1,21,1) import Distribution.Utils.NubList #endif import qualified Distribution.Simple.GHC as GHC(configure) import Distribution.Verbosity (silent) +import qualified Distribution.Verbosity as Distribution import Distribution.Version import System.IO.Error (ioeGetErrorString) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (takeDirectory, splitFileName, ()) +readGenericPackageDescription :: Distribution.Verbosity -> FilePath -> IO Distribution.GenericPackageDescription +#if MIN_VERSION_Cabal(2, 0, 0) +readGenericPackageDescription = Distribution.readGenericPackageDescription +#else +readGenericPackageDescription = Distribution.readPackageDescription +#endif + -- TODO: Fix callsites so we don't need `allComponentsBy`. It was taken from -- http://hackage.haskell.org/package/Cabal-1.16.0.3/docs/src/Distribution-Simple-LocalBuildInfo.html#allComponentsBy -- since it doesn't exist in Cabal 1.18.* @@ -84,8 +97,7 @@ where getPackageGhcOpts' :: IO (Either String [String]) getPackageGhcOpts' = do - -- TODO(SN): readPackageDescription is deprecated - genPkgDescr <- readPackageDescription silent path + genPkgDescr <- readGenericPackageDescription silent path distDir <- getDistDir -- TODO(SN): defaultProgramConfiguration is deprecated let programCfg = defaultProgramConfiguration @@ -148,9 +160,10 @@ , ghcOptSourcePath = map (baseDir ) (ghcOptSourcePath ghcOpts') } #endif - + let hcPath = flagToMaybe . configHcPath $ configFlags localBuildInfo + let pkgPath = flagToMaybe . configHcPkg $ configFlags localBuildInfo -- TODO(SN): defaultProgramConfiguration is deprecated - (ghcInfo, mbPlatform, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration + (ghcInfo, mbPlatform, _) <- GHC.configure silent hcPath pkgPath defaultProgramConfiguration putStrLn $ "Configured GHC " ++ show ghcVersion ++ " " ++ show mbPlatform #if MIN_VERSION_Cabal(1,23,2) diff --git a/src/CommandLoop.hs b/src/CommandLoop.hs --- a/src/CommandLoop.hs +++ b/src/CommandLoop.hs @@ -35,6 +35,7 @@ import System.Posix.Files (getFileStatus, modificationTime) import Types (ClientDirective(..), Command(..), CommandExtra(..)) +import GhcTypes (needsTemplateHaskellOrQQ, getModSummaries) import Info (getIdentifierInfo, getType) import FindSymbol (findSymbol) import Cabal (getPackageGhcOpts) @@ -212,9 +213,9 @@ targets <- mapM (flip GHC.guessTarget noPhase) files GHC.setTargets targets graph <- GHC.depanal [] True - if configTH conf || (not $ GHC.needsTemplateHaskell graph) + if configTH conf || (not $ needsTemplateHaskellOrQQ graph) then do - when (GHC.needsTemplateHaskell graph) $ do + when (needsTemplateHaskellOrQQ graph) $ do flags <- GHC.getSessionDynFlags void . GHC.setSessionDynFlags $ flags { GHC.hscTarget = GHC.HscInterpreted, GHC.ghcLink = GHC.LinkInMemory } Just <$> GHC.load GHC.LoadAllTargets @@ -243,8 +244,8 @@ , ClientExit (ExitFailure 1) ] GHC.Succeeded -> do - moduleGraph <- GHC.getModuleGraph - case find (moduleSummaryMatchesModuleName moduleName) moduleGraph of + modSummaries <- getModSummaries + case find (moduleSummaryMatchesModuleName moduleName) modSummaries of Nothing -> liftIO $ mapM_ clientSend [ ClientStderr "Module not found" , ClientExit (ExitFailure 1) ] diff --git a/src/FindSymbol.hs b/src/FindSymbol.hs --- a/src/FindSymbol.hs +++ b/src/FindSymbol.hs @@ -24,6 +24,8 @@ import qualified Packages as PKG import qualified Name +import GhcTypes (getModSummaries) + type SymbolName = String type ModuleName = String @@ -37,7 +39,7 @@ findSymbolInFile :: SymbolName -> GHC.Ghc [GHC.Module] findSymbolInFile symbol = - filterM (containsSymbol symbol) =<< map GHC.ms_mod <$> GHC.getModuleGraph + filterM (containsSymbol symbol) =<< map GHC.ms_mod <$> getModSummaries findSymbolInPackages :: SymbolName -> GHC.Ghc [GHC.Module] diff --git a/src/GhcTypes.hs b/src/GhcTypes.hs new file mode 100644 --- /dev/null +++ b/src/GhcTypes.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} +module GhcTypes + ( getModSummaries + , TypecheckI + , needsTemplateHaskellOrQQ + ) where + +import qualified GHC +import qualified HscTypes +#if __GLASGOW_HASKELL__ < 804 +import qualified Var +#endif + +getModSummaries :: GHC.Ghc [GHC.ModSummary] +#if __GLASGOW_HASKELL__ >= 804 +getModSummaries = HscTypes.mgModSummaries <$> GHC.getModuleGraph +#else +getModSummaries = GHC.getModuleGraph +#endif + +#if __GLASGOW_HASKELL__ >= 804 +type TypecheckI = GHC.GhcTc +#else +type TypecheckI = Var.Var +#endif + +needsTemplateHaskellOrQQ :: GHC.ModuleGraph -> Bool +#if __GLASGOW_HASKELL__ >= 804 +needsTemplateHaskellOrQQ = GHC.needsTemplateHaskellOrQQ +#else +needsTemplateHaskellOrQQ = GHC.needsTemplateHaskell +#endif + diff --git a/src/Info.hs b/src/Info.hs --- a/src/Info.hs +++ b/src/Info.hs @@ -29,6 +29,8 @@ import qualified Pretty import qualified TcHsSyn +import GhcTypes (getModSummaries, TypecheckI) + getIdentifierInfo :: FilePath -> String -> GHC.Ghc (Either String String) getIdentifierInfo file identifier = withModSummary file $ \m -> do @@ -59,8 +61,8 @@ getModuleSummary :: FilePath -> GHC.Ghc (Maybe GHC.ModSummary) getModuleSummary file = do - moduleGraph <- GHC.getModuleGraph - case find (moduleSummaryMatchesFilePath file) moduleGraph of + modSummaries <- getModSummaries + case find (moduleSummaryMatchesFilePath file) $ modSummaries of Nothing -> return Nothing Just moduleSummary -> return (Just moduleSummary) @@ -83,9 +85,9 @@ processTypeCheckedModule :: GHC.TypecheckedModule -> (Int, Int) -> GHC.Ghc [((Int, Int, Int, Int), String)] processTypeCheckedModule tcm (line, col) = do let tcs = GHC.tm_typechecked_source tcm - bs = listifySpans tcs (line, col) :: [GHC.LHsBind GHC.Id] - es = listifySpans tcs (line, col) :: [GHC.LHsExpr GHC.Id] - ps = listifySpans tcs (line, col) :: [GHC.LPat GHC.Id] + bs = listifySpans tcs (line, col) :: [GHC.LHsBind TypecheckI] + es = listifySpans tcs (line, col) :: [GHC.LHsExpr TypecheckI] + ps = listifySpans tcs (line, col) :: [GHC.LPat TypecheckI] bts <- mapM (getTypeLHsBind tcm) bs ets <- mapM (getTypeLHsExpr tcm) es pts <- mapM (getTypeLPat tcm) ps @@ -121,7 +123,7 @@ , GHC.srcSpanEndCol spn) getSrcSpan _ = Nothing -getTypeLHsBind :: GHC.TypecheckedModule -> GHC.LHsBind GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) +getTypeLHsBind :: GHC.TypecheckedModule -> GHC.LHsBind TypecheckI -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) #if __GLASGOW_HASKELL__ >= 708 getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = grp}) = return $ Just (spn, HsExpr.mg_res_ty grp) #else @@ -129,7 +131,7 @@ #endif getTypeLHsBind _ _ = return Nothing -getTypeLHsExpr :: GHC.TypecheckedModule -> GHC.LHsExpr GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) +getTypeLHsExpr :: GHC.TypecheckedModule -> GHC.LHsExpr TypecheckI -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) #if __GLASGOW_HASKELL__ >= 708 getTypeLHsExpr _ e = do #else @@ -149,7 +151,7 @@ Nothing -> return Nothing Just expr -> return $ Just (GHC.getLoc e, CoreUtils.exprType expr) -getTypeLPat :: GHC.TypecheckedModule -> GHC.LPat GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) +getTypeLPat :: GHC.TypecheckedModule -> GHC.LPat TypecheckI -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) getTypeLPat _ (GHC.L spn pat) = return $ Just (spn, TcHsSyn.hsPatType pat) listifySpans :: Typeable a => GHC.TypecheckedSource -> (Int, Int) -> [GHC.Located a] @@ -210,7 +212,7 @@ | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x) where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet.NameSet -> Bool #if __GLASGOW_HASKELL__ >= 709 - postTcType = const (stage Bool + postTcType = const (stage Bool #else postTcType = const (stage Bool #endif @@ -223,8 +225,11 @@ infoThing :: String -> GHC.Ghc String infoThing str = do names <- GHC.parseName str -#if __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 803 mb_stuffs <- mapM (GHC.getInfo False) names + let filtered = filterOutChildren (\(t,_f,_i,_,_) -> t) (catMaybes mb_stuffs) +#elif __GLASGOW_HASKELL__ >= 708 + mb_stuffs <- mapM (GHC.getInfo False) names let filtered = filterOutChildren (\(t,_f,_i,_) -> t) (catMaybes mb_stuffs) #else mb_stuffs <- mapM GHC.getInfo names @@ -259,7 +264,11 @@ Just p -> GHC.getName p `NameSet.elemNameSet` all_names Nothing -> False -#if __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 803 +pprInfo :: (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst], [GHC.FamInst], Outputable.SDoc) -> Outputable.SDoc +pprInfo (thing, fixity, insts, _, _) = + PprTyThing.pprTyThingInContextLoc thing +#elif __GLASGOW_HASKELL__ >= 708 pprInfo :: (HscTypes.TyThing, GHC.Fixity, [GHC.ClsInst], [GHC.FamInst]) -> Outputable.SDoc pprInfo (thing, fixity, insts, _) = PprTyThing.pprTyThingInContextLoc thing