diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/hdevtools.cabal b/hdevtools.cabal --- a/hdevtools.cabal +++ b/hdevtools.cabal @@ -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 diff --git a/src/Cabal.hs b/src/Cabal.hs --- a/src/Cabal.hs +++ b/src/Cabal.hs @@ -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 diff --git a/src/CommandArgs.hs b/src/CommandArgs.hs --- a/src/CommandArgs.hs +++ b/src/CommandArgs.hs @@ -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) diff --git a/src/CommandLoop.hs b/src/CommandLoop.hs --- a/src/CommandLoop.hs +++ b/src/CommandLoop.hs @@ -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 $ diff --git a/src/FindSymbol.hs b/src/FindSymbol.hs --- a/src/FindSymbol.hs +++ b/src/FindSymbol.hs @@ -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 [] diff --git a/src/Info.hs b/src/Info.hs --- a/src/Info.hs +++ b/src/Info.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -27,10 +27,8 @@ dir <- getCurrentDirectory return $ dir p - defaultSocketFile :: FilePath defaultSocketFile = ".hdevtools.sock" - main :: IO () main = do