hsinspect 0.0.1 → 0.0.2
raw patch · 3 files changed
+20/−16 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- HsInspect.Imports: workaroundGhc :: GhcMonad m => FilePath -> m Target
+ HsInspect.Imports: workaroundGhc :: GhcMonad m => FilePath -> m (ModuleName, Target)
Files
- exe/Main.hs +5/−2
- hsinspect.cabal +1/−1
- library/HsInspect/Imports.hs +14/−13
exe/Main.hs view
@@ -5,6 +5,7 @@ import Control.Monad import Control.Monad.IO.Class+import Data.Char (isUpper) import DynFlags (parseDynamicFlagsCmdLine) import qualified GHC as GHC import GHC.Paths (libdir)@@ -36,18 +37,20 @@ -- http://hackage.haskell.org/package/cabal-helper main :: IO () main = do- (break ("--" ==) -> (args, _ : flags)) <- getArgs+ (break ("--" ==) -> (args, flags)) <- getArgs when (elem "--help" args) $ (putStrLn help) >> exitWith ExitSuccess when (elem "--version" args) $ (putStrLn version) >> exitWith ExitSuccess GHC.runGhc (Just libdir) $ do dflags <- GHC.getSessionDynFlags- (dflags', _, _) <- liftIO $ parseDynamicFlagsCmdLine dflags (GHC.noLoc <$> flags)+ (dflags', (GHC.unLoc <$>) -> ghcargs, _) <- liftIO $ parseDynamicFlagsCmdLine dflags (GHC.noLoc <$> tail flags) void $ GHC.setSessionDynFlags dflags' { GHC.hscTarget = GHC.HscNothing , GHC.ghcLink = GHC.NoLink }+ let modules = GHC.mkModuleName <$> (filter (isUpper . head) ghcargs)+ GHC.setTargets $ (\m -> GHC.Target (GHC.TargetModule m) False Nothing) <$> modules case args of "imports" : file : rest -> do quals <- imports file
hsinspect.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hsinspect-version: 0.0.1+version: 0.0.2 synopsis: Inspect Haskell source files. license: GPL-3.0-or-later license-file: LICENSE
library/HsInspect/Imports.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} module HsInspect.Imports where @@ -12,7 +13,7 @@ import FastString import qualified GHC as GHC import HeaderInfo (getOptions)-import HscTypes (Target(..), TargetId(..), mgModSummaries)+import HscTypes (Target(..), TargetId(..)) import HsInspect.Sexp import Json import Lexer@@ -32,13 +33,14 @@ imports' :: GHC.GhcMonad m => FilePath -> m [GlobalRdrElt] imports' file = do- target <- workaroundGhc file+ (m, target) <- workaroundGhc file - GHC.setTargets [target]- _ <- GHC.load GHC.LoadAllTargets+ GHC.removeTarget $ TargetModule m+ GHC.addTarget target - graph <- GHC.getModuleGraph- rdr_env <- minf_rdr_env' . GHC.ms_mod_name . head . mgModSummaries $ graph+ _ <- GHC.load $ GHC.LoadUpTo m++ rdr_env <- minf_rdr_env' m pure $ globalRdrEnvElts rdr_env showGhc :: (Outputable a) => a -> String@@ -47,7 +49,7 @@ -- TODO CPP should use the trivial impl in ghc 8.8 -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/merge_requests/1541-workaroundGhc :: GHC.GhcMonad m => FilePath -> m Target+workaroundGhc :: GHC.GhcMonad m => FilePath -> m (GHC.ModuleName, Target) workaroundGhc file = do sess <- GHC.getSession (dflags, tmp) <- liftIO $ preprocess sess (file, Nothing)@@ -57,10 +59,10 @@ let pragmas = getOptions dflags full file loc = mkRealSrcLoc (mkFastString file) 1 1 (dflags', _, _) <- parseDynamicFilePragma dflags pragmas- trimmed <- case unP parseHeader (mkPState dflags' full loc) of- POk _ (L _ hsmod) -> do+ (modname, trimmed) <- case unP parseHeader (mkPState dflags' full loc) of+ POk _ (L _ hsmod@(GHC.hsmodName -> (Just (L _ modname)))) -> do let extra =- if (unLoc <$> GHC.hsmodName hsmod) == (Just $ GHC.mkModuleName "Main")+ if modname == (GHC.mkModuleName "Main") then "\nmain = return ()" -- TODO check that return is imported else "" -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/issues/17066@@ -70,12 +72,11 @@ "{-# OPTIONS_GHC " <> (intercalate " " pragmas') <> " #-}\n" <> showPpr dflags' (hsmod { GHC.hsmodExports = Nothing }) <> extra- -- liftIO . putStrLn $ contents- pure . stringToStringBuffer $ contents+ pure (modname, stringToStringBuffer contents) _ -> error "parseHeader failed" ts <- liftIO $ getModificationTime file- pure $ Target (TargetFile file (Just $ Hsc HsSrcFile)) False (Just (trimmed, ts))+ pure $ (modname, Target (TargetFile file (Just $ Hsc HsSrcFile)) False (Just (trimmed, ts))) -- WORKAROUND https://gitlab.haskell.org/ghc/ghc/merge_requests/1541 minf_rdr_env' :: GHC.GhcMonad m => GHC.ModuleName -> m GlobalRdrEnv