packages feed

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 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