hdevtools 0.1.6.0 → 0.1.6.1
raw patch · 8 files changed
+76/−102 lines, 8 filesdep ~ghc-boot
Dependency ranges changed: ghc-boot
Files
- CHANGELOG.md +6/−0
- hdevtools.cabal +3/−2
- src/Cabal.hs +17/−62
- src/CommandArgs.hs +1/−1
- src/CommandLoop.hs +22/−21
- src/FindSymbol.hs +23/−14
- src/Info.hs +4/−0
- src/Main.hs +0/−2
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## 0.1.6.1 - 2017-12-17++ * Fixed `moduleinfo` command to load targets correctly.+ * Print version on `-v` command line option.+ * Fixed build with ghc-8.2.0.+ ## 0.1.6.0 - 2017-08-21 * Added handling of source errors: GHC `SourceError` and other exceptions are
hdevtools.cabal view
@@ -1,5 +1,5 @@ name: hdevtools-version: 0.1.6.0+version: 0.1.6.1 synopsis: Persistent GHC powered background server for FAST haskell development tools license: MIT license-file: LICENSE@@ -57,7 +57,6 @@ Daemonize, FindSymbol, Info,- Main, Server, Stack, Types,@@ -90,3 +89,5 @@ if impl(ghc >= 8.0) build-depends: Cabal >= 1.24, ghc-boot >= 8.0+ if impl(ghc >= 8.2)+ build-depends: ghc-boot >= 8.2
src/Cabal.hs view
@@ -15,16 +15,13 @@ import Control.Applicative ((<$>)) import Data.Monoid (Monoid(..)) #endif+#if __GLASGOW_HASKELL__ < 802 import Distribution.Package (PackageIdentifier(..), PackageName)+#endif import Distribution.PackageDescription (PackageDescription(..), Executable(..), TestSuite(..), Benchmark(..), emptyHookedBuildInfo, buildable, libBuildInfo) import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.Configure (configure)-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), ComponentLocalBuildInfo(..),- Component(..), ComponentName(..),-#if !MIN_VERSION_Cabal(1,18,0)- allComponentsBy,-#endif- componentBuildInfo, foldComponent)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), Component(..), componentName, getComponentLocalBuildInfo, componentBuildInfo) import Distribution.Simple.Compiler (PackageDB(..)) import Distribution.Simple.Command (CommandParse(..), commandParseArgs) import Distribution.Simple.GHC (componentGhcOptions)@@ -38,46 +35,12 @@ #endif import qualified Distribution.Simple.GHC as GHC(configure) import Distribution.Verbosity (silent)-import Distribution.Version (Version(..))+import Distribution.Version import System.IO.Error (ioeGetErrorString) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (takeDirectory, splitFileName, (</>)) --componentName :: Component -> ComponentName-componentName =- foldComponent (const CLibName)- (CExeName . exeName)- (CTestName . testName)- (CBenchName . benchmarkName)--getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo-#if MIN_VERSION_Cabal(1,18,0)-getComponentLocalBuildInfo lbi cname = getLocalBuildInfo cname $ componentsConfigs lbi- where getLocalBuildInfo cname' ((cname'', clbi, _):cfgs) =- if cname' == cname'' then clbi else getLocalBuildInfo cname' cfgs- getLocalBuildInfo _ [] = error $ "internal error: missing config"-#else-getComponentLocalBuildInfo lbi CLibName =- case libraryConfig lbi of- Nothing -> error $ "internal error: missing library config"- Just clbi -> clbi-getComponentLocalBuildInfo lbi (CExeName name) =- case lookup name (executableConfigs lbi) of- Nothing -> error $ "internal error: missing config for executable " ++ name- Just clbi -> clbi-getComponentLocalBuildInfo lbi (CTestName name) =- case lookup name (testSuiteConfigs lbi) of- Nothing -> error $ "internal error: missing config for test suite " ++ name- Just clbi -> clbi-getComponentLocalBuildInfo lbi (CBenchName name) =- case lookup name (testSuiteConfigs lbi) of- Nothing -> error $ "internal error: missing config for benchmark " ++ name- Just clbi -> clbi-#endif--#if MIN_VERSION_Cabal(1,18,0) -- 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.*@@ -93,12 +56,9 @@ ++ [ f (CExe exe) | exe <- executables pkg_descr , buildable (buildInfo exe) ] ++ [ f (CTest tst) | tst <- testSuites pkg_descr- , buildable (testBuildInfo tst)- , testEnabled tst ]+ , buildable (testBuildInfo tst)] ++ [ f (CBench bm) | bm <- benchmarks pkg_descr- , buildable (benchmarkBuildInfo bm)- , benchmarkEnabled bm ]-#endif+ , buildable (benchmarkBuildInfo bm)] stackifyFlags :: ConfigFlags -> Maybe StackConfig -> ConfigFlags stackifyFlags cfg Nothing = cfg@@ -124,9 +84,10 @@ where getPackageGhcOpts' :: IO (Either String [String]) getPackageGhcOpts' = do+ -- TODO(SN): readPackageDescription is deprecated genPkgDescr <- readPackageDescription silent path distDir <- getDistDir-+ -- TODO(SN): defaultProgramConfiguration is deprecated let programCfg = defaultProgramConfiguration let initCfgFlags = (defaultConfigFlags programCfg) { configDistPref = toFlag distDir@@ -156,12 +117,14 @@ _ -> return () localBuildInfo <- configure (genPkgDescr, emptyHookedBuildInfo) cfgFlags- let pkgDescr = localPkgDescr localBuildInfo let baseDir = fst . splitFileName $ path case getGhcVersion localBuildInfo of Nothing -> return $ Left "GHC is not configured" Just ghcVersion -> do+#if __GLASGOW_HASKELL__ < 802+ let pkgDescr = localPkgDescr localBuildInfo let mbLibName = pkgLibName pkgDescr+#endif let ghcOpts' = foldl' mappend mempty . map (getComponentGhcOptions localBuildInfo) . flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo -- FIX bug in GhcOptions' `mappend`@@ -173,7 +136,9 @@ #if __GLASGOW_HASKELL__ >= 709 , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts') #endif+#if __GLASGOW_HASKELL__ < 802 , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts')+#endif , ghcOptSourcePath = overNubListR (map (baseDir </>)) (ghcOptSourcePath ghcOpts') } #else@@ -184,23 +149,10 @@ } #endif -#if MIN_VERSION_Cabal(1,18,0)--- API Change:--- Distribution.Simple.GHC.configure now returns (Compiler, Maybe Platform, ProgramConfiguration) --- It used to just return (Compiler, ProgramConfiguration)--- GHC.configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration--- -> IO (Compiler, Maybe Platform, ProgramConfiguration)+ -- TODO(SN): defaultProgramConfiguration is deprecated (ghcInfo, mbPlatform, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration-#else--- configure :: Verbosity -> Maybe FilePath -> Maybe FilePath -> ProgramConfiguration--- -> IO (Compiler, ProgramConfiguration)- (ghcInfo, _) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration- -- let mbPlatform = Just (hostPlatform localBuildInfo) :: Maybe Platform-#endif putStrLn $ "Configured GHC " ++ show ghcVersion-#if MIN_VERSION_Cabal(1,18,0) ++ " " ++ show mbPlatform-#endif #if MIN_VERSION_Cabal(1,23,2) -- API Change: -- Distribution.Simple.Program.GHC.renderGhcOptions now takes Platform argument@@ -226,10 +178,12 @@ contents <- getDirectoryContents dir return . maybe dir (dir </>) $ find ("dist-sandbox-" `isPrefixOf`) contents +#if __GLASGOW_HASKELL__ < 802 pkgLibName :: PackageDescription -> Maybe PackageName pkgLibName pkgDescr = if hasLibrary pkgDescr then Just $ pkgName . package $ pkgDescr else Nothing+#endif hasLibrary :: PackageDescription -> Bool hasLibrary = maybe False (\_ -> True) . library@@ -239,6 +193,7 @@ componentGhcOptions silent lbi bi clbi (buildDir lbi) where bi = componentBuildInfo comp+ -- TODO(SN): getComponentLocalBuildInfo is deprecated as of Cabal-2.0.0.2 clbi = getComponentLocalBuildInfo lbi (componentName comp) getGhcVersion :: LocalBuildInfo -> Maybe Version
src/CommandArgs.hs view
@@ -255,7 +255,7 @@ full :: String -> Annotate Ann full progName = modes_ [admin += auto, check, moduleFile, info, type_, findSymbol] += helpArg [name "h", groupname "Help"]- += versionArg [groupname "Help"]+ += versionArg [name "v", groupname "Help"] += program progName += summary (progName ++ ": " ++ fullVersion)
src/CommandLoop.hs view
@@ -230,34 +230,35 @@ Just GHC.Succeeded -> act - runCommand :: IORef State -> ClientSend -> Config -> Command -> GHC.Ghc () runCommand _ clientSend conf (CmdCheck file) = withTargets clientSend [file] conf (liftIO . clientSend . ClientExit $ ExitSuccess) runCommand _ clientSend _ (CmdModuleFile moduleName) = do- moduleGraph <- GHC.getModuleGraph- case find (moduleSummaryMatchesModuleName moduleName) moduleGraph of- Nothing ->- liftIO $ mapM_ clientSend- [ ClientStderr "Module not found"- , ClientExit (ExitFailure 1)- ]- Just modSummary ->+ target <- GHC.guessTarget moduleName Nothing+ GHC.setTargets [target]+ res <- GHC.load GHC.LoadAllTargets+ case res of+ GHC.Failed -> liftIO $ mapM_ clientSend [ ClientStderr "Error loading targets"+ , ClientExit (ExitFailure 1)+ ]+ GHC.Succeeded -> do+ moduleGraph <- GHC.getModuleGraph+ case find (moduleSummaryMatchesModuleName moduleName) moduleGraph of+ Nothing -> liftIO $ mapM_ clientSend [ ClientStderr "Module not found"+ , ClientExit (ExitFailure 1)+ ]+ Just modSummary -> case GHC.ml_hs_file (GHC.ms_location modSummary) of- Nothing ->- liftIO $ mapM_ clientSend- [ ClientStderr "Module does not have a source file"- , ClientExit (ExitFailure 1)- ]- Just file ->- liftIO $ mapM_ clientSend- [ ClientStdout file- , ClientExit ExitSuccess- ]- where+ Nothing -> liftIO $ mapM_ clientSend [ ClientStderr "Module does not have a source file"+ , ClientExit (ExitFailure 1)+ ]+ Just file -> liftIO $ mapM_ clientSend [ ClientStdout file+ , ClientExit ExitSuccess+ ]+ where moduleSummaryMatchesModuleName modName modSummary =- modName == (GHC.moduleNameString . GHC.moduleName . GHC.ms_mod) modSummary+ modName == (GHC.moduleNameString . GHC.moduleName . GHC.ms_mod) modSummary runCommand state clientSend conf (CmdInfo file identifier) = withTargets clientSend [file] conf $ do result <- withWarnings state False $
src/FindSymbol.hs view
@@ -4,22 +4,25 @@ ( findSymbol ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((<$>))-import qualified UniqFM-#else+#if __GLASGOW_HASKELL__ >= 802+import GhcMonad (liftIO)+#elif __GLASGOW_HASKELL__ >= 710 import GHC.PackageDb (exposedName) import GhcMonad (liftIO)+#else+import Control.Applicative ((<$>))+import qualified UniqFM #endif -import Control.Monad (filterM) import Control.Exception+import Control.Monad (filterM) import Data.List (find, nub) import Data.Maybe (catMaybes, isJust)+import Exception (ghandle)+ import qualified GHC import qualified Packages as PKG import qualified Name-import Exception (ghandle) type SymbolName = String type ModuleName = String@@ -47,24 +50,30 @@ catMaybes <$> mapM findModule modNames where exposedModuleNames :: GHC.Ghc [GHC.ModuleName]-#if __GLASGOW_HASKELL__ < 710- exposedModuleNames =- concatMap exposedModules- . UniqFM.eltsUFM- . PKG.pkgIdMap- . GHC.pkgState- <$> GHC.getSessionDynFlags+#if __GLASGOW_HASKELL__ >= 802+ exposedModuleNames = do+ dynFlags <- GHC.getSessionDynFlags+ pkgConfigs <- liftIO $ fmap concat+ . (fmap . fmap) snd . PKG.readPackageConfigs $ dynFlags+ return $ map fst (concatMap exposedModules pkgConfigs) #elif __GLASGOW_HASKELL__ >= 800 exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ fmap concat . (fmap . fmap) snd . PKG.readPackageConfigs $ dynFlags return $ map exposedName (concatMap exposedModules pkgConfigs)-#else+#elif __GLASGOW_HASKELL__ >= 710 exposedModuleNames = do dynFlags <- GHC.getSessionDynFlags pkgConfigs <- liftIO $ PKG.readPackageConfigs dynFlags return $ map exposedName (concatMap exposedModules pkgConfigs)+#else+ exposedModuleNames =+ concatMap exposedModules+ . UniqFM.eltsUFM+ . PKG.pkgIdMap+ . GHC.pkgState+ <$> GHC.getSessionDynFlags #endif exposedModules pkg = if PKG.exposed pkg then PKG.exposedModules pkg else []
src/Info.hs view
@@ -180,7 +180,11 @@ #else . Outputable.withPprStyleDoc #endif+#if __GLASGOW_HASKELL__ >= 802+ (Outputable.mkUserStyle dflags Outputable.neverQualify Outputable.AllTheWay)+#else (Outputable.mkUserStyle Outputable.neverQualify Outputable.AllTheWay)+#endif #if __GLASGOW_HASKELL__ >= 708 . PprTyThing.pprTypeForUser #else
src/Main.hs view
@@ -27,10 +27,8 @@ dir <- getCurrentDirectory return $ dir </> p - defaultSocketFile :: FilePath defaultSocketFile = ".hdevtools.sock"- main :: IO () main = do