Filter RTS arguments from 'ghc-options' arguments (#725)

This fixes #666.

1 files changed, 15 insertions, 2 deletions

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 3f5e5298..23fefb3b 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -439,13 +439,26 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do
   _ <- setSessionDynFlags dynflags''
   ghcActs dynflags''
   where
+
+    -- ignore sublists of flags that start with "+RTS" and end in "-RTS"
+    --
+    -- See https://github.com/haskell/haddock/issues/666
+    filterRtsFlags :: [String] -> [String]
+    filterRtsFlags flgs = foldr go (const []) flgs True
+      where go "-RTS" func _ = func True
+            go "+RTS" func _ = func False
+            go _      func False = func False
+            go arg    func True = arg : func True
+
+
     parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags
     parseGhcFlags dynflags = do
       -- TODO: handle warnings?
 
-      (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags)
+      let flags' = filterRtsFlags flags
+      (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc flags')
       if not (null rest)
-        then throwE ("Couldn't parse GHC options: " ++ unwords flags)
+        then throwE ("Couldn't parse GHC options: " ++ unwords flags')
         else return dynflags'
 
 unsetPatternMatchWarnings :: DynFlags -> DynFlags