summaryrefslogtreecommitdiff
path: root/utils/check-ppr/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'utils/check-ppr/Main.hs')
-rw-r--r--utils/check-ppr/Main.hs24
1 files changed, 8 insertions, 16 deletions
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index 542a35780e..80828874f6 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -5,11 +5,14 @@
import Data.List
import Data.Data
+import Control.Monad.IO.Class
import GHC.Types.SrcLoc
import GHC hiding (moduleName)
import GHC.Hs.Dump
import GHC.Driver.Session
import GHC.Driver.Ppr
+import GHC.Driver.Make
+import GHC.Unit.Module.ModSummary
import GHC.Utils.Outputable hiding (space)
import System.Environment( getArgs )
import System.Exit
@@ -77,26 +80,15 @@ testOneFile libdir fileName = do
parseOneFile :: FilePath -> FilePath -> IO ParsedModule
parseOneFile libdir fileName = do
- let modByFile m =
- case ml_hs_file $ ms_location m of
- Nothing -> False
- Just fn -> fn == fileName
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
_ <- setSessionDynFlags dflags2
- addTarget Target { targetId = TargetFile fileName Nothing
- , targetAllowObjCode = True
- , targetUnitId = homeUnitId_ dflags
- , targetContents = Nothing }
- _ <- load LoadAllTargets
- graph <- getModuleGraph
- let
- modSum = case filter modByFile (mgModSummaries graph) of
- [x] -> x
- xs -> error $ "Can't find module, got:"
- ++ show (map (ml_hs_file . ms_location) xs)
- parseModule modSum
+ hsc_env <- getSession
+ ms <- liftIO $ summariseFile hsc_env [] fileName Nothing True Nothing
+ case ms of
+ Left _err -> error "parseOneFile"
+ Right ems -> parseModule (emsModSummary ems)
getPragmas :: Located HsModule -> String
getPragmas (L _ (HsModule { hsmodAnn = anns'})) = pragmaStr