hsinspect 0.0.13 → 0.0.14

raw patch · 10 files changed

+222/−109 lines, 10 filesdep +filepathdep +textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath, text

API changes (from Hackage documentation)

Files

• exe/Main.hs +7/−7
• hsinspect.cabal +4/−1
• library/HsInspect/Imports.hs +12/−13
• library/HsInspect/Index.hs +44/−52
• library/HsInspect/Json.hs +6/−3
• library/HsInspect/Packages.hs +4/−5
• library/HsInspect/Sexp.hs +28/−16
• library/HsInspect/TypeParser.hs +88/−0
• library/HsInspect/Util.hs +14/−1
• library/HsInspect/Workarounds.hs +15/−11

@@ -9,6 +9,7 @@ import Data.List (find, isPrefixOf) import qualified Data.List as L import Data.Maybe (catMaybes)+import qualified Data.Text.IO as T import DynFlags (parseDynamicFlagsCmdLine, updOptLevel) import qualified EnumSet as EnumSet import qualified GHC as GHC@@ -39,10 +40,8 @@   "  index                    - list all dependency packages, modules, terms and types.\n" ++   "  packages /path/to/dir    - list all packages that are referenced by sources in this dir.\n" --- Possible backends:------ https://github.com/mpickering/hie-bios--- http://hackage.haskell.org/package/cabal-helper+-- TODO support an option to search for .ghc.{flags, path} files and use them+ main :: IO () main = do   (break ("--" ==) -> (args, filterFlags -> flags)) <- getArgs@@ -73,12 +72,12 @@     homeModules <- inferHomeModules     GHC.setTargets $ mkTarget <$> homeModules -    let respond rest (S.filterNil . S.toSexp -> a) = liftIO . putStrLn $+    let respond rest (S.filterNil . S.toSexp -> a) = liftIO $           if (elem "--json" rest)           then case sexpToJson a of             Left err -> error err-            Right j -> encodeJson dflags' j-          else S.render a+            Right j -> putStrLn $ encodeJson dflags' j+          else T.putStrLn $ S.render a     case args of       "imports" : file : rest -> do         quals <- imports file@@ -89,6 +88,7 @@       "packages" : rest -> do         hits <- packages         respond rest hits+      -- TODO make parseTypes available on the command line       _ ->         liftIO $ error "invalid parameters" 

@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          hsinspect-version:       0.0.13+version:       0.0.14 synopsis:      Inspect Haskell source files. license:       GPL-3.0-or-later license-file:  LICENSE@@ -27,8 +27,10 @@     , base        >=4.11 && <5     , containers     , directory+    , filepath     , ghc     , ghc-boot+    , text     , time    ghc-options:      -Wall -Werror=missing-home-modules -Werror=orphans@@ -56,5 +58,6 @@     HsInspect.Json     HsInspect.Packages     HsInspect.Sexp+    HsInspect.TypeParser     HsInspect.Util     HsInspect.Workarounds

@@ -10,6 +10,8 @@  import Data.List (sort) import Data.Maybe (fromJust)+import Data.Text (Text)+import qualified Data.Text as T import qualified GHC as GHC import HscTypes (TargetId(..)) import HsInspect.Sexp@@ -41,12 +43,12 @@       let ln =             if is_qual               then Nothing-              else Just $ showGhc gre_name+              else Just . T.pack $ showGhc gre_name           lqn =             if is_mod == is_as               then Nothing-              else Just $ showGhc is_as ++ "." ++ showGhc gre_name-          fqn = showGhc is_mod ++ "." ++ showGhc gre_name+              else Just . T.pack $ showGhc is_as ++ "." ++ showGhc gre_name+          fqn = T.pack $ showGhc is_mod ++ "." ++ showGhc gre_name        in Qualified ln lqn fqn  -- 1. local name@@ -54,15 +56,12 @@ -- 3. fully qualified name data Qualified   = Qualified-      (Maybe String)-      (Maybe String)-      String+      (Maybe Text)+      (Maybe Text)+      Text   deriving (Eq, Ord, Show)-+{- BOILERPLATE Qualified ToSexp field=[local,qual,full] -}+{- BOILERPLATE START -} instance ToSexp Qualified where-  toSexp (Qualified ln lqn fqn) =-    alist-      [ ("local", toSexp ln),-        ("qual", toSexp lqn),-        ("full", toSexp fqn)-      ]+  toSexp (Qualified p_1_1 p_1_2 p_1_3) = alist [("local", toSexp p_1_1), ("qual", toSexp p_1_2), ("full", toSexp p_1_3)]+{- BOILERPLATE END -}

@@ -14,14 +14,14 @@ import qualified ConLike as GHC import Control.Monad import Control.Monad.IO.Class-import Data.Coerce import Data.List (isInfixOf, sort) import Data.Maybe (catMaybes, mapMaybe, maybeToList) import Data.Set (Set) import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T import qualified DataCon as GHC import qualified DynFlags as GHC-import FastString (unpackFS) import qualified GHC import GHC.PackageDb import qualified GHC.PackageDb as GHC@@ -119,7 +119,7 @@   let entries = sort $ uncurry mkEntries <$> symbols       mkEntries m things = ModuleEntries (moduleName m) (sort $ renderThings things)       renderThings things = catMaybes $ (uncurry $ tyrender dflags unitid) <$> things-  pure $ PackageEntries srcid inplace entries haddocks+  pure $ PackageEntries srcid inplace entries (T.pack <$> haddocks)  -- for a .hi file returns the module and a list of all things (with types -- resolved) in that module and their original module if they are re-exported.@@ -149,8 +149,8 @@ tyrender dflags unitid m' (GHC.AGlobal thing) =   let     m = mkExported dflags unitid <$> m'-    shw :: GHC.Outputable m => m -> String-    shw = showPpr dflags+    shw :: GHC.Outputable m => m -> Text+    shw = T.pack . showPpr dflags    in case thing of     (GHC.AnId var) -> Just $ IdEntry m       (shw $ GHC.idName var)@@ -160,21 +160,43 @@       (shw $ GHC.dataConUserType dc)     (GHC.AConLike (GHC.PatSynCon ps)) -> Just $ PatSynEntry m       (shw $ GHC.getName ps)-      (showSDoc dflags $ GHC.pprPatSynType ps )+      (T.pack . showSDoc dflags $ GHC.pprPatSynType ps )     (GHC.ATyCon tc) -> Just $ TyConEntry m       (shw $ GHC.tyConName tc)       (shw $ GHC.tyConFlavour tc)     _ -> Nothing tyrender _ _ _ _ = Nothing -data Entry = IdEntry (Maybe Exported) String String -- ^ name type-           | ConEntry (Maybe Exported) String String -- ^ name type-           | PatSynEntry (Maybe Exported) String String -- ^ name orig-           | TyConEntry (Maybe Exported) String String -- ^ type flavour+data Entry = IdEntry (Maybe Exported) Text Text -- ^ name type+           | ConEntry (Maybe Exported) Text Text -- ^ name type+           | PatSynEntry (Maybe Exported) Text Text -- ^ name orig+           | TyConEntry (Maybe Exported) Text Text -- ^ type flavour   deriving (Eq, Ord)+{- BOILERPLATE Entry ToSexp+   field={IdEntry:[export,name,type],+          ConEntry:[export,name,type],+          PatSynEntry:[export,name,type],+          TyConEntry:[export,type,flavour]}+   class={IdEntry:id,+          ConEntry:con,+          PatSynEntry:pat,+          TyConEntry:tycon}+-}+{- BOILERPLATE START -}+instance ToSexp Entry where+  toSexp (IdEntry p_1_1 p_1_2 p_1_3) = alist $ ("class", "id") : [("export", toSexp p_1_1), ("name", toSexp p_1_2), ("type", toSexp p_1_3)]+  toSexp (ConEntry p_1_1 p_1_2 p_1_3) = alist $ ("class", "con") : [("export", toSexp p_1_1), ("name", toSexp p_1_2), ("type", toSexp p_1_3)]+  toSexp (PatSynEntry p_1_1 p_1_2 p_1_3) = alist $ ("class", "pat") : [("export", toSexp p_1_1), ("name", toSexp p_1_2), ("type", toSexp p_1_3)]+  toSexp (TyConEntry p_1_1 p_1_2 p_1_3) = alist $ ("class", "tycon") : [("export", toSexp p_1_1), ("type", toSexp p_1_2), ("flavour", toSexp p_1_3)]+{- BOILERPLATE END -}  data ModuleEntries = ModuleEntries GHC.ModuleName [Entry]   deriving (Eq, Ord)+{- BOILERPLATE ModuleEntries ToSexp field=[module,ids] -}+{- BOILERPLATE START -}+instance ToSexp ModuleEntries where+  toSexp (ModuleEntries p_1_1 p_1_2) = alist [("module", toSexp p_1_1), ("ids", toSexp p_1_2)]+{- BOILERPLATE END -}  -- The haddocks serve a dual purpose: not only do they point to where haddocks -- might be, they give a hint to the text editor where the sources for this@@ -182,15 +204,26 @@ -- -- Users should type `cabal haddock --enable-documentation` to populate the docs -- of their dependencies and local projects.-type Haddocks = [FilePath]+type Haddocks = [Text]  -- Bool indicates if this is an -inplace package data PackageEntries = PackageEntries (Maybe SourcePackageId) Bool [ModuleEntries] Haddocks+{- BOILERPLATE PackageEntries ToSexp field=[srcid,inplace,modules,haddocks] -}+{- BOILERPLATE START -}+instance ToSexp PackageEntries where+  toSexp (PackageEntries p_1_1 p_1_2 p_1_3 p_1_4) = alist [("srcid", toSexp p_1_1), ("inplace", toSexp p_1_2), ("modules", toSexp p_1_3), ("haddocks", toSexp p_1_4)]+{- BOILERPLATE END -}  -- srcid is Nothing if it matches the re-export location data Exported = Exported (Maybe SourcePackageId) GHC.ModuleName   deriving (Eq, Ord) +{- BOILERPLATE Exported ToSexp field=[srcid, module] -}+{- BOILERPLATE START -}+instance ToSexp Exported where+  toSexp (Exported p_1_1 p_1_2) = alist [("srcid", toSexp p_1_1), ("module", toSexp p_1_2)]+{- BOILERPLATE END -}+ mkExported :: GHC.DynFlags -> UnitId -> Module -> Exported mkExported dflags unitid m =   let unitid' = moduleUnitId m@@ -200,44 +233,3 @@            else sourcePackageId <$> lookupPackage dflags unitid')         (moduleName m) -instance ToSexp Exported where-  toSexp (Exported srcid name) = alist-    [ ("srcid", toSexp $ unpackFS . coerce <$> srcid),-      ("module", SexpString . moduleNameString $ name) ]--instance ToSexp Entry where-  toSexp (IdEntry m name typ) = alist-    [ ("name", SexpString name),-      ("type", SexpString typ),-      ("class", "id"),-      ("export", toSexp m)]-  toSexp (ConEntry m name typ) = alist-    [ ("name", SexpString name),-      ("type", SexpString typ),-      ("class", "con"),-      ("export", toSexp m) ]-  toSexp (PatSynEntry m name typ) = alist-    [ ("name", SexpString name),-      ("type", SexpString typ),-      ("class", "pat"),-      ("export", toSexp m) ]-  toSexp (TyConEntry m typ flavour) = alist-    [ ("type", SexpString typ),-      ("class", "tycon"),-      ("flavour", SexpString flavour),-      ("export", toSexp m) ]--instance ToSexp ModuleEntries where-  toSexp (ModuleEntries modl entries) =-    alist-      [ ("module", SexpString . moduleNameString $ modl),-        ("ids", toSexp entries)-      ]--instance ToSexp PackageEntries where-  toSexp (PackageEntries srcid inplace modules haddocks) =-    alist-      [ ("srcid", toSexp $ unpackFS . coerce <$> srcid),-        ("inplace", toSexp inplace),-        ("modules", toSexp modules),-        ("haddocks", toSexp haddocks) ]

@@ -2,19 +2,22 @@  module HsInspect.Json where +import qualified Data.Text as T import qualified GHC as GHC import HsInspect.Sexp import Json import MonadUtils (mapSndM) import Outputable (showSDoc)+import Util (mapFst)  encodeJson :: GHC.DynFlags -> JsonDoc -> String encodeJson dflags j = showSDoc dflags . renderJSON $ j  sexpToJson :: Sexp -> Either String JsonDoc sexpToJson SexpNil = Right JSNull-sexpToJson (toAList -> Just kvs) = JSObject <$> mapSndM sexpToJson kvs+sexpToJson (toAList -> Just kvs) = JSObject . mapFst T.unpack <$> mapSndM sexpToJson kvs sexpToJson (toList -> Just as) = JSArray <$> traverse sexpToJson as sexpToJson (SexpCons _ _) = Left $ "cons cell has no JSON equivalent"-sexpToJson (SexpString s) = Right $ JSString s-sexpToJson (SexpSymbol s) = Right $ JSString s -- nobody said it had to roundtrip+sexpToJson (SexpString s) = Right . JSString $ T.unpack s+sexpToJson (SexpSymbol s) = Right . JSString $ T.unpack s -- nobody said it had to roundtrip+-- TODO write our own JSON repr to avoid a ghc dep and improve perf

@@ -7,7 +7,6 @@  import Control.Monad (join, void) import Control.Monad.IO.Class (liftIO)-import Data.Coerce import Data.List (delete, nub, nubBy, sort, (\\)) import Data.Maybe (catMaybes, mapMaybe) import Data.Set (Set)@@ -75,8 +74,8 @@ data PkgSummary = PkgSummary [GHC.PackageName] [GHC.PackageName]   deriving (Eq, Ord) +{- BOILERPLATE PkgSummary ToSexp field=[used,unused] -}+{- BOILERPLATE START -} instance ToSexp PkgSummary where-  toSexp (PkgSummary used unused) =-    alist [ ("used", toS used)-          , ("unused", toS unused) ]-    where toS ids = toSexp $ unpackFS . coerce <$> ids+  toSexp (PkgSummary p_1_1 p_1_2) = alist [("used", toSexp p_1_1), ("unused", toSexp p_1_2)]+{- BOILERPLATE END -}

@@ -1,20 +1,22 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}  -- | Very minimal ADT for outputting some S-Expressions. module HsInspect.Sexp where -import Data.List (intercalate)-import Data.String+import Data.String (IsString, fromString)+import Data.Text (Text)+import qualified Data.Text as T+import FastString (unpackFS) import Json (escapeJsonString)+import Module (ModuleName, moduleNameString)+import PackageConfig (PackageName(..), SourcePackageId(..))  data Sexp   = SexpCons Sexp Sexp   | SexpNil-  | SexpString String-  | SexpSymbol String+  | SexpString Text+  | SexpSymbol Text  list :: [Sexp] -> Sexp list = foldr SexpCons SexpNil@@ -25,14 +27,14 @@ toList _ = Nothing  instance IsString Sexp where-  fromString = SexpSymbol+  fromString = SexpSymbol . T.pack  alist :: [(Sexp, Sexp)] -> Sexp alist els = list $ mkEl =<< els   where     mkEl (k, v) = [SexpCons k v] -toAList :: Sexp -> Maybe [(String, Sexp)]+toAList :: Sexp -> Maybe [(Text, Sexp)] toAList SexpNil = Just [] toAList (SexpCons (SexpCons (SexpSymbol k) v) rest) = ((k, v) :) <$> toAList rest toAList _ = Nothing@@ -43,8 +45,8 @@ instance ToSexp Sexp where   toSexp = id -instance ToSexp String where-  toSexp s = SexpString s+instance ToSexp Text where+  toSexp = SexpString  instance ToSexp Bool where   toSexp False = SexpNil@@ -57,6 +59,15 @@   toSexp (Just a) = toSexp a   toSexp Nothing = SexpNil +instance ToSexp SourcePackageId where+  toSexp (SourcePackageId fs) = SexpString . T.pack $ unpackFS fs++instance ToSexp ModuleName where+  toSexp = SexpString . T.pack . moduleNameString++instance ToSexp PackageName where+  toSexp (PackageName fs) = SexpString . T.pack $ unpackFS fs+ filterNil :: Sexp -> Sexp filterNil SexpNil = SexpNil filterNil (SexpCons (SexpCons (SexpSymbol _) SexpNil) rest) = filterNil rest@@ -64,9 +75,10 @@ filterNil (SexpString s) = SexpString s filterNil (SexpSymbol s) = SexpSymbol s -render :: Sexp -> String+render :: Sexp -> Text render SexpNil = "nil"-render (toList -> Just ss) = "(" ++ (intercalate " " $ render <$> ss) ++ ")\n"-render (SexpCons a b) = "(" ++ render a ++ " . " ++ render b ++ ")\n"-render (SexpString s) = "\"" ++ escapeJsonString s ++ "\""-render (SexpSymbol a) = escapeJsonString a+render (toList -> Just ss) = "(" <> (T.intercalate " " $ render <$> ss) <> ")\n"+render (SexpCons a b) = "(" <> render a <> " . " <> render b <> ")\n"+render (SexpString s) = "\"" <> (T.pack . escapeJsonString $ T.unpack s) <> "\""+render (SexpSymbol a) = T.pack . escapeJsonString $ T.unpack a+-- TODO write our own escapeString to avoid a ghc dep and improve perf

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module HsInspect.TypeParser where++import Control.Exception (throwIO)+import Data.List (sortOn)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import GHC (HscEnv)+import qualified GHC as GHC+import qualified HsInspect.Util as H+import HsInspect.Workarounds (mkCppState)+import qualified Lexer as GHC+import qualified Outputable as GHC+import qualified Parser++data Type = ProductType Text [Text] Text [Text]  -- ^^ type tparams cons [param types]+          | RecordType Text [Text] Text [(Text, Text)] -- ^^ type tparams cons [(fieldname, param type)]+          | SumType Text [Text] [(Text, [Text])] -- ^^ type tparams [(cons, param types)] (no records)+  deriving (Eq, Show)++-- line, col (1-indexed)+data Pos = Pos Int Int+  deriving (Eq, Ord, Show)++data Comment = Comment Text Pos Pos -- text start end+  deriving (Eq, Show)++parseTypes :: HscEnv -> FilePath -> IO ([Type], [Comment])+parseTypes env file = do+  (pstate, _) <- mkCppState env file+  let showGhc :: GHC.Outputable a => a -> Text+      showGhc = T.pack . H.showGhc+  case GHC.unP Parser.parseModule pstate of+    -- ParseResult (Located (HsModule GhcPs))+    GHC.POk st (GHC.L _ hsmod) -> do+      -- http://hackage.haskell.org/package/ghc-8.8.3/docs/HsDecls.html#t:HsDecl+      -- [Located (HsDecl p)]+      let decls = GHC.hsmodDecls hsmod+          findType (GHC.L _ (GHC.TyClD _ (GHC.DataDecl _ tycon' (GHC.HsQTvs _ tparams') _ ddn))) =+            let+              tycon = showGhc tycon'+              tparams = renderTparam <$> tparams'+              renderField :: GHC.GenLocated l (GHC.ConDeclField GHC.GhcPs) -> (Text, Text)+              renderField (GHC.L _ field) = (showGhc . head $ GHC.cd_fld_names field, showGhc $ GHC.cd_fld_type field)+              renderArg :: GHC.LBangType GHC.GhcPs -> Text+              renderArg (GHC.L _ arg) = showGhc arg+              rhs = do+                (GHC.L _ ddl) <- GHC.dd_cons ddn+                case ddl of+                  GHC.ConDeclH98 _ cons _ _ _ (GHC.RecCon (GHC.L _ fields)) _ -> [(showGhc cons, Left $ renderField <$> fields)]+                  GHC.ConDeclH98 _ cons _ _ _ (GHC.InfixCon a1 a2) _ -> [(showGhc cons, Right $ [renderArg a1, renderArg a2])]+                  GHC.ConDeclH98 _ cons _ _ _ (GHC.PrefixCon args) _ -> [(showGhc cons, Right $ renderArg <$> args)]+                  _ -> [] -- GADTS++             in case rhs of+              [] -> Nothing+              [(cons, Right tpes)] -> Just $ ProductType tycon tparams cons tpes+              [(cons, Left fields)] -> Just $ RecordType tycon tparams cons fields+              mult -> Just . SumType tycon tparams $ render <$> mult+                where+                  render (cons, Right args) = (cons, args)+                  render (cons, Left fargs) = (cons, snd <$> fargs)++          findType _ = Nothing++          renderTparam :: GHC.GenLocated l (GHC.HsTyVarBndr GHC.GhcPs) -> Text+          renderTparam (GHC.L _ (GHC.UserTyVar _ p)) = showGhc p+          renderTparam (GHC.L _ (GHC.KindedTyVar _ p _)) = showGhc p+          renderTparam (GHC.L _ (GHC.XTyVarBndr _)) = "<unsupported>"++          extractComment (GHC.L (GHC.RealSrcSpan pos) c) =+            let start = Pos (GHC.srcSpanStartLine pos) (GHC.srcSpanStartCol pos)+                end = Pos (GHC.srcSpanEndLine pos) (GHC.srcSpanEndCol pos)+             in (\str -> Comment (T.pack str) start end) <$> case c of+            (GHC.AnnLineComment txt) -> Just txt+            (GHC.AnnBlockComment txt) -> Just txt+            _ -> Nothing+          extractComment _ = Nothing++          types = mapMaybe findType decls+          comments = mapMaybe extractComment $ GHC.comment_q st++      pure (types, sortOn (\(Comment _ s _) -> s) comments)++    GHC.PFailed _ _ err -> throwIO . userError $ "unable to parse " <> file <> " due to " <> GHC.showSDocUnsafe err

@@ -3,7 +3,7 @@ module HsInspect.Util where  import Control.Monad.IO.Class-import Data.List (isSuffixOf, nub)+import Data.List (find, isSuffixOf, nub) import Data.Maybe (catMaybes) import Data.Set (Set) import qualified Data.Set as Set@@ -11,6 +11,7 @@ import qualified GHC as GHC import Outputable (Outputable, showPpr) import System.Directory (doesDirectoryExist, listDirectory, makeAbsolute)+import System.FilePath (takeDirectory, takeFileName, (</>))  homeSources :: GHC.GhcMonad m => m [FilePath] homeSources = do@@ -31,6 +32,18 @@     getModule GHC.Target{GHC.targetId} = case targetId of       GHC.TargetModule m -> Just m       GHC.TargetFile _ _ -> Nothing++-- returns the first file that matches the predicate+locateDominating :: (String -> Bool) -> FilePath -> IO (Maybe FilePath)+locateDominating p dir = do+  files <- listDirectory dir+  let parent = takeDirectory dir+  case find p $ takeFileName <$> files of+    Just file -> pure . Just $ dir </> file+    Nothing ->+      if parent == dir+       then pure Nothing+       else locateDominating p parent  walkSuffix :: String -> FilePath -> IO [FilePath] walkSuffix suffix dir = filter (suffix `isSuffixOf`) <$> walk dir

@@ -15,7 +15,7 @@ import FastString import qualified GHC as GHC import HeaderInfo (getOptions)-import HscTypes (Target(..), TargetId(..))+import HscTypes (HscEnv, Target(..), TargetId(..)) #if MIN_VERSION_GLASGOW_HASKELL(8,10,1,0) import GHC.Hs.ImpExp (ImportDecl(..)) #else@@ -36,27 +36,31 @@ import TcRnTypes (tcg_rdr_env) #endif -parseHeader' :: GHC.GhcMonad m => FilePath -> m ([String], GHC.HsModule GHC.GhcPs)-parseHeader' file = do-  sess <- GHC.getSession+-- applies CPP rules to the input file and extracts the pragmas,+-- a more portable alternative to GHC.hGetStringBuffer+mkCppState :: HscEnv -> FilePath -> IO (PState, [Located String])+mkCppState sess file = do #if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)-  pp <- liftIO $ preprocess sess file Nothing Nothing+  pp <- preprocess sess file Nothing Nothing   let (dflags, tmp) = case pp of         Left _ -> error $ "preprocessing failed " <> show file         Right success -> success #else-  (dflags, tmp) <- liftIO $ preprocess sess (file, Nothing)+  (dflags, tmp) <- preprocess sess (file, Nothing) #endif-  full <- liftIO $ hGetStringBuffer tmp+  full <- hGetStringBuffer tmp   when (".hscpp" `isSuffixOf` tmp) $     liftIO . removeFile $ tmp   let pragmas = getOptions dflags full file       loc  = mkRealSrcLoc (mkFastString file) 1 1-  -- FIXME strip out any GHC_OPTIONS that use -pgmF so we don't call external-  --       tools. This also means we can lose the .ghc.path feature from the-  --       plugin.   (dflags', _, _) <- parseDynamicFilePragma dflags pragmas-  case unP parseHeader (mkPState dflags' full loc) of+  pure $ (mkPState dflags' full loc, pragmas)++parseHeader' :: GHC.GhcMonad m => FilePath -> m ([String], GHC.HsModule GHC.GhcPs)+parseHeader' file = do+  sess <- GHC.getSession+  (pstate, pragmas) <- liftIO $ mkCppState sess file+  case unP parseHeader pstate of     POk _ (L _ hsmod) -> pure (unLoc <$> pragmas, hsmod)     _ -> error $ "parseHeader failed for " <> file