hsinspect 0.0.10 → 0.0.11

raw patch · 7 files changed

+103/−46 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• exe/Main.hs +19/−4
• hsinspect.cabal +1/−1
• library/HsInspect/Imports.hs +1/−5
• library/HsInspect/Index.hs +4/−1
• library/HsInspect/Packages.hs +14/−3
• library/HsInspect/Util.hs +15/−3
• library/HsInspect/Workarounds.hs +49/−29

@@ -6,8 +6,8 @@ import qualified Config as GHC import Control.Monad import Control.Monad.IO.Class-import Data.Char (isUpper) import Data.List (find, isPrefixOf)+import Data.Maybe (catMaybes) import DynFlags (parseDynamicFlagsCmdLine, updOptLevel) import qualified EnumSet as EnumSet import qualified GHC as GHC@@ -16,6 +16,8 @@ import HsInspect.Json import HsInspect.Packages import HsInspect.Sexp as S+import HsInspect.Util+import HsInspect.Workarounds import System.Environment (getArgs) import System.Exit @@ -53,7 +55,7 @@       flags' = filter (not . ("-B" `isPrefixOf`)) flags   GHC.runGhc libdir $ do     dflags <- GHC.getSessionDynFlags-    (updOptLevel 0 -> dflags', (GHC.unLoc <$>) -> ghcargs, _) <-+    (updOptLevel 0 -> dflags', (GHC.unLoc <$>) -> _ghcargs, _) <-       liftIO $ parseDynamicFlagsCmdLine dflags (GHC.noLoc <$> flags')     void $ GHC.setSessionDynFlags dflags'            { GHC.hscTarget = GHC.HscInterpreted -- HscNothing compiles home modules, dunno why@@ -62,8 +64,14 @@            , GHC.warningFlags = EnumSet.empty            , GHC.fatalWarningFlags = EnumSet.empty            }-    let mkTarget m = GHC.Target (GHC.TargetModule $ GHC.mkModuleName m) True Nothing-    GHC.setTargets $ mkTarget <$> filter (isUpper . head) ghcargs++    -- The caller may have provided a list of home modules, but we do not trust+    -- them because the ghcflags plugin does not keep the flags up to date for+    -- incremental compiles.+    let mkTarget m = GHC.Target (GHC.TargetModule m) True Nothing+    homeModules <- inferHomeModules+    GHC.setTargets $ mkTarget <$> homeModules+     let respond rest (S.filterNil . S.toSexp -> a) = liftIO . putStrLn $           if (elem "--json" rest)           then case sexpToJson a of@@ -82,6 +90,13 @@         respond rest hits       _ ->         liftIO $ error "invalid parameters"++inferHomeModules :: GHC.GhcMonad m => m [GHC.ModuleName]+inferHomeModules = do+  files <- homeSources+  mmns <- traverse parseModuleName' files+  let main' = GHC.mkModuleName "Main"+  pure . filter (main' /=) $ catMaybes mmns  -- removes the "+RTS ... -RTS" sections filterFlags :: [String] -> [String]

@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          hsinspect-version:       0.0.10+version:       0.0.11 synopsis:      Inspect Haskell source files. license:       GPL-3.0-or-later license-file:  LICENSE

@@ -9,12 +9,11 @@ where  import Data.Maybe (fromJust)-import DynFlags (unsafeGlobalDynFlags) import qualified GHC as GHC import HscTypes (TargetId(..)) import HsInspect.Sexp import HsInspect.Workarounds-import Outputable (Outputable, showPpr)+import HsInspect.Util import RdrName (GlobalRdrElt(..), ImpDeclSpec(..), ImportSpec(..),                 globalRdrEnvElts) @@ -33,9 +32,6 @@    rdr_env <- minf_rdr_env' m   pure $ describe =<< globalRdrEnvElts rdr_env--showGhc :: (Outputable a) => a -> String-showGhc = showPpr unsafeGlobalDynFlags  describe :: GlobalRdrElt -> [Qualified] describe GRE {gre_name, gre_imp} = describe' <$> gre_imp

@@ -30,7 +30,6 @@ import HsInspect.Sexp import HsInspect.Util import qualified Id as GHC-import Module (Module(..), moduleNameString) import Module as GHC import qualified Name as GHC import Outputable (showPpr, showSDoc)@@ -129,6 +128,8 @@   -> m (Maybe (GHC.Module, [(Maybe GHC.Module, GHC.TcTyThing)])) hiToSymbols exposed hi = (join <$>) <$> withHi hi $ \iface -> do   let m = mi_module iface+  -- FIXME we should include all modules from inplace packages, otherwise the+  -- user is unable to jump-to-definition within the same multi-package project.   if not $ Set.member (GHC.moduleName m) exposed     then pure Nothing     else do@@ -185,6 +186,8 @@ -- srcid is Nothing if it matches the re-export location data Exported = Exported (Maybe SourcePackageId) GHC.ModuleName +-- FIXME Exported should follow re-exports until they reach the original symbol.+-- Otherwise editors have to do this. mkExported :: GHC.DynFlags -> UnitId -> Module -> Exported mkExported dflags unitid m =   let unitid' = moduleUnitId m

@@ -8,8 +8,9 @@ import Control.Monad (join, void) import Control.Monad.IO.Class (liftIO) import Data.Coerce-import Data.List (delete, nub, sort, (\\))+import Data.List (delete, nub, nubBy, sort, (\\)) import Data.Maybe (catMaybes, mapMaybe)+import Data.Set (Set) import qualified Data.Set as Set import qualified DynFlags as GHC import FastString@@ -28,19 +29,29 @@ -- separate -ddump-minimal-imports pass). packages :: GHC.GhcMonad m => m PkgSummary packages = do-  mods <- Set.toList <$> getTargetModules+  homes <- getTargetModules+  targetsImportsOnly homes    dflags <- GHC.getSessionDynFlags   void $ GHC.setSessionDynFlags dflags { GHC.ghcMode = GHC.CompManager }   _ <- GHC.load $ GHC.LoadAllTargets -  imps <- nub . join <$> traverse getImports mods+  imps <- nub . join <$> traverse getImports (Set.toList homes)   pkgs <- catMaybes <$> traverse (uncurry findPackage) imps   let home = GHC.thisPackage dflags       used = delete home . nub . sort $ pkgs       loaded = nub . sort . explicitPackages $ GHC.pkgState dflags       asNames unitids = GHC.packageName <$> mapMaybe (lookupPackage dflags) unitids   pure $ PkgSummary (asNames used) (asNames $ loaded \\ used)++targetsImportsOnly :: GHC.GhcMonad m => Set GHC.ModuleName -> m ()+targetsImportsOnly homes = do+  files <- homeSources+  trimmed <- traverse (importsOnly homes) files+  -- side effect: multiple modules with no name will be deduped+  let fstEq (n1, _) (n2, _) = n1 == n2+      targets = (snd <$>) . nubBy fstEq $ trimmed+  GHC.setTargets targets  findPackage :: GHC.GhcMonad m => ModuleName -> Maybe FastString -> m (Maybe GHC.UnitId) findPackage m mp = do

@@ -1,14 +1,26 @@ {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE ViewPatterns #-}  module HsInspect.Util where -import Data.List (isSuffixOf)+import Control.Monad.IO.Class+import Data.List (isSuffixOf, nub) import Data.Maybe (catMaybes) import Data.Set (Set) import qualified Data.Set as Set+import DynFlags (unsafeGlobalDynFlags) import qualified GHC as GHC-import System.Directory (doesDirectoryExist, listDirectory)+import Outputable (Outputable, showPpr)+import System.Directory (doesDirectoryExist, listDirectory, makeAbsolute)++homeSources :: GHC.GhcMonad m => m [FilePath]+homeSources = do+  dflags <- GHC.getSessionDynFlags+  paths <- liftIO . traverse makeAbsolute $ GHC.importPaths dflags+  let infer dir = liftIO $ walkSuffix ".hs" dir+  nub . concat <$> traverse infer paths++showGhc :: (Outputable a) => a -> String+showGhc = showPpr unsafeGlobalDynFlags  getTargetModules :: GHC.GhcMonad m => m (Set GHC.ModuleName) getTargetModules = do

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}  module HsInspect.Workarounds where @@ -9,7 +10,6 @@ import Data.List (delete, intercalate, isSuffixOf) import Data.Set (Set) import qualified Data.Set as Set-import DriverPhases (HscSource(..), Phase(..)) import DriverPipeline (preprocess) import DynFlags (parseDynamicFilePragma) import FastString@@ -24,16 +24,17 @@ import SrcLoc import StringBuffer import System.Directory (getModificationTime, removeFile)++#if MIN_VERSION_GLASGOW_HASKELL(8,8,2,0)+import Data.Maybe (fromJust, fromMaybe)+import OccName (emptyOccEnv)+#else import TcRnTypes (tcg_rdr_env)+#endif --- TODO avoid this codepath in 8.8.2+--- WORKAROUND https://gitlab.haskell.org/ghc/ghc/merge_requests/1541-importsOnly :: GHC.GhcMonad m => Set GHC.ModuleName -> FilePath -> m (Maybe GHC.ModuleName, Target)-importsOnly homes file = do+parseHeader' :: GHC.GhcMonad m => FilePath -> m ([String], GHC.HsModule GHC.GhcPs)+parseHeader' file = do   sess <- GHC.getSession-  -- NOTE: the behaviour of preprocess changed in 8.8.1 and it no longer reads-  -- and sets LANGUAGE pragamas from in header of the file. Since this function-  -- is no longer needed in 8.8.2 we don't bother fixing this. #if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)   pp <- liftIO $ preprocess sess file Nothing Nothing   let (dflags, tmp) = case pp of@@ -47,38 +48,57 @@     liftIO . removeFile $ tmp   let pragmas = getOptions dflags full file       loc  = mkRealSrcLoc (mkFastString file) 1 1-      allowed (L _ (ImportDecl{ideclName})) = Set.notMember (unLoc ideclName) homes+  (dflags', _, _) <- parseDynamicFilePragma dflags pragmas+  case unP parseHeader (mkPState dflags' full loc) of+    POk _ (L _ hsmod) -> pure (unLoc <$> pragmas, hsmod)+    _ -> error $ "parseHeader failed for " <> file++importsOnly :: GHC.GhcMonad m => Set GHC.ModuleName -> FilePath -> m (Maybe GHC.ModuleName, Target)+importsOnly homes file = do+  dflags <- GHC.getSessionDynFlags+  (pragmas, hsmod) <- parseHeader' file+  let allowed (L _ (ImportDecl{ideclName})) = Set.notMember (unLoc ideclName) homes #if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)       allowed (L _ (XImportDecl _)) = False #endif-  (dflags', _, _) <- parseDynamicFilePragma dflags pragmas-  (modname, trimmed) <- case unP parseHeader (mkPState dflags' full loc) of-    POk _ (L _ hsmod) -> do-      let modname = unLoc <$> GHC.hsmodName hsmod-          extra =-            if modname == Nothing || modname == (Just $ GHC.mkModuleName "Main")-            then "\nmain = return ()"-            else ""-          imps = filter allowed $ GHC.hsmodImports hsmod-          -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/issues/17066-          --            cannot use CPP in combination with targetContents-          pragmas' = delete "-XCPP" (unLoc <$> pragmas)-          contents =-            "{-# OPTIONS_GHC " <> (intercalate " " pragmas') <> " #-}\n" <>-            showPpr dflags' (hsmod { GHC.hsmodExports = Nothing-                                   , GHC.hsmodImports = imps }) <>-            extra-      pure (modname, stringToStringBuffer contents)-    _ -> error  $ "parseHeader failed for " <> file+      modname = unLoc <$> GHC.hsmodName hsmod+      extra =+        if modname == Nothing || modname == (Just $ GHC.mkModuleName "Main")+        then "\nmain = return ()"+        else ""+      imps = filter allowed $ GHC.hsmodImports hsmod+      -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/issues/17066+      --            cannot use CPP in combination with targetContents+      pragmas' = delete "-XCPP" pragmas+      contents =+        "{-# OPTIONS_GHC " <> (intercalate " " pragmas') <> " #-}\n" <>+        showPpr dflags (hsmod { GHC.hsmodExports = Nothing+                               , GHC.hsmodImports = imps }) <>+        extra+      trimmed = stringToStringBuffer contents    ts <- liftIO $ getModificationTime file-  pure $ (modname, Target (TargetFile file (Just $ Hsc HsSrcFile)) False (Just (trimmed, ts)))+  -- since 0f9ec9d1ff can't use Phase+  pure $ (modname, Target (TargetFile file Nothing) False (Just (trimmed, ts))) +parseModuleName' :: GHC.GhcMonad m => FilePath -> m (Maybe GHC.ModuleName)+parseModuleName' file = do+  (_, hsmod) <- parseHeader' file+  pure $ unLoc <$> GHC.hsmodName hsmod+ -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/merge_requests/1541 minf_rdr_env' :: GHC.GhcMonad m => GHC.ModuleName -> m GlobalRdrEnv minf_rdr_env' m = do+#if MIN_VERSION_GLASGOW_HASKELL(8,8,2,0)+  mo <- GHC.findModule m Nothing+  (fromJust -> mi) <- GHC.getModuleInfo mo+  pure . fromMaybe emptyOccEnv $ GHC.modInfoRdrEnv mi+#else   modSum <- GHC.getModSummary m   pmod <- GHC.parseModule modSum   tmod <- GHC.typecheckModule pmod   let (tc_gbl_env, _) = GHC.tm_internals_ tmod   pure $ tcg_rdr_env tc_gbl_env+#endif++