Have GHC parsing respect dynamic pragmas

This post about Handling GHC parse errors shows that using qualified in postpostive position is a syntax error unless the ImportQualifiedPost language extension is enabled. In that post, it is explained that the program

module M where
import Data.List qualified

is invalid whereas,

{#- LANGUAGE ImportQualifiedPost -#}
module M where
import Data.List qualified

which enables the extension via a "dynamic pragma", is legit.

Perhaps surprisingly, running the second of these programs through the parsing code presented in that post continues to generate the error

     Found `qualified' in postpositive position.
     To allow this, enable language extension 'ImportQualifiedPost'

Evidently, our parse-fu needs an upgrade to respect dynamic pragmas and that's what this post provides.

This code exercises the GHC API to parse a module.

parse :: String -> DynFlags -> String -> ParseResult (Located (HsModule GhcPs))
parse filename flags str =
  unP Parser.parseModule parseState
  where
    location = mkRealSrcLoc (mkFastString filename) 1 1
    buffer = stringToStringBuffer str
    parseState = mkPState flags buffer location

Note in the above, the second argument flags :: DynFlags. In order for parse to take into account extensions enabled by pragmas in the source argument str, then flags must be set up to do so a priori. That is, before jumping into parse, a "first pass" must be made to sniff out flags. There is a GHC API for that. It's called parseDynamicFilePragma.

Here's a function to harvest flags from pragmas that makes that call to parseDynamicFilePragma.

parsePragmasIntoDynFlags :: DynFlags -> FilePath -> String -> IO (Maybe DynFlags)
parsePragmasIntoDynFlags flags filepath str =
  catchErrors $ do
    let opts = getOptions flags (stringToStringBuffer str) filepath
    (flags, _, _) <- parseDynamicFilePragma flags opts
    return $ Just flags
  where
    catchErrors :: IO (Maybe DynFlags) -> IO (Maybe DynFlags)
    catchErrors act = handleGhcException reportErr
                        (handleSourceError reportErr act)
    reportErr e = do putStrLn $ "error : " ++ show e; return Nothing

The main contribution of this function is to account for the complication that parseDynamicFilePragma can throw two kinds of exceptions : GhcException and SourceError. The GHC API functions handleGhcException and handleSourceError are the means to achieve that.

Putting it all together then, here's an outline of how to parse in the presence of dynamic pragmas.

      s <- readFile' file
      flags <-
        parsePragmasIntoDynFlags
          (defaultDynFlags fakeSettings fakeLlvmConfig) file s
      whenJust flags $ \flags ->
         case parse file flags s of
            PFailed s ->
              report flags $ snd (getMessages s flags)
            POk s m -> do
              let (wrns, errs) = getMessages s flags
              report flags wrns
              report flags errs
              when (null errs) $ analyzeModule flags m

For a complete working program that utilizes this function, see this example in the ghc-lib repo.