Don't append newline to parseString input

We also check that we have parsed everything with endOfInput.

1 files changed, 17 insertions, 4 deletions

diff --git a/html-test/run.lhs b/html-test/run.lhs
index 1ce3e797..e4c83da6 100755
--- a/html-test/run.lhs
+++ b/html-test/run.lhs
@@ -15,12 +15,11 @@ import Distribution.Simple.Program
 import Distribution.Simple.Utils
 import Distribution.Verbosity
 import System.IO
-import System.Cmd
 import System.Directory
 import System.Environment
 import System.Exit
 import System.FilePath
-import System.Process (ProcessHandle, runProcess, waitForProcess)
+import System.Process (ProcessHandle, runProcess, waitForProcess, system)
 
 
 packageRoot, dataDir, haddockPath, baseDir, testDir, outDir :: FilePath
@@ -88,7 +87,7 @@ test = do
 
   putStrLn "Running tests..."
   handle <- runProcess haddockPath
-                       (["-w", "-o", outDir, "-h", "--pretty-html", "--optghc=-fglasgow-exts"
+                       (["-w", "-o", outDir, "-h", "--pretty-html"
                         , "--optghc=-w", base, process, ghcprim] ++ opts ++ mods')
                        Nothing env Nothing
                        Nothing Nothing
@@ -143,12 +142,26 @@ stripLinks :: String -> String
 stripLinks str =
   let prefix = "<a href=\"" in
   case stripPrefix prefix str of
-    Just str' -> prefix ++ stripLinks (dropWhile (/= '"') str')
+    Just str' -> case dropWhile (/= '>') (dropWhile (/= '"') str') of
+      [] -> []
+      x:xs -> stripLinks (stripHrefEnd xs)
     Nothing ->
       case str of
         [] -> []
         x : xs -> x : stripLinks xs
 
+stripHrefEnd :: String -> String
+stripHrefEnd s =
+  let pref = "</a" in
+  case stripPrefix pref s of
+    Just str' -> case dropWhile (/= '>') str' of
+      [] -> []
+      x:xs -> xs
+    Nothing ->
+      case s of
+        [] -> []
+        x : xs -> x : stripHrefEnd xs
+
 programOnPath :: FilePath -> IO Bool
 programOnPath p = do
   result <- findProgramLocation silent p