hdevtools 0.1.6.1 → 0.1.7.0
raw patch · 7 files changed
+86/−23 lines, 7 files
Files
- CHANGELOG.md +4/−0
- hdevtools.cabal +2/−1
- src/Cabal.hs +19/−6
- src/CommandLoop.hs +5/−4
- src/FindSymbol.hs +3/−1
- src/GhcTypes.hs +33/−0
- src/Info.hs +20/−11
CHANGELOG.md view
@@ -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.
hdevtools.cabal view
@@ -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,
src/Cabal.hs view
@@ -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)
src/CommandLoop.hs view
@@ -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) ]
src/FindSymbol.hs view
@@ -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]
+ src/GhcTypes.hs view
@@ -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+
src/Info.hs view
@@ -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<TypeChecker) :: GHC.PostTc GHC.Id GHC.Type -> Bool+ postTcType = const (stage<TypeChecker) :: GHC.PostTc TypecheckI GHC.Type -> Bool #else postTcType = const (stage<TypeChecker) :: GHC.PostTcType -> 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