From 27876dc77ff259e27a71ea6f30662a668adfd134 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Tue, 3 Sep 2013 19:14:08 +0200
Subject: Don't append newline to parseString input

We also check that we have parsed everything with endOfInput.
---
 html-test/run.lhs | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

(limited to 'html-test/run.lhs')

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
-- 
cgit v1.2.3