[commit: haddock] master: Make hyperlinker test runner strip local links from generated source. (395a9c3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/395a9c3941f8b8891cffa5c17e1f6ae414edaa79

>---------------------------------------------------------------

commit 395a9c3941f8b8891cffa5c17e1f6ae414edaa79
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Wed Jul 1 00:47:32 2015 +0200

    Make hyperlinker test runner strip local links from generated source.


>---------------------------------------------------------------

395a9c3941f8b8891cffa5c17e1f6ae414edaa79
 hypsrc-test/Utils.hs | 26 ++++++++++++++++++++++++++
 hypsrc-test/run.hs   | 37 +++++++++++++++++++++++++++----------
 2 files changed, 53 insertions(+), 10 deletions(-)

diff --git a/hypsrc-test/Utils.hs b/hypsrc-test/Utils.hs
new file mode 100644
index 0000000..cf3e94e
--- /dev/null
+++ b/hypsrc-test/Utils.hs
@@ -0,0 +1,26 @@
+module Utils
+    ( stripLocalAnchors
+    , stripLocalLinks
+    , stripLocalReferences
+    ) where
+
+
+import Data.List
+
+
+replaceBetween :: Eq a => [a] -> a -> [a] -> [a] -> [a]
+replaceBetween _ _ _ [] = []
+replaceBetween pref end val html@(x:xs') = case stripPrefix pref html of
+    Just strip -> pref ++ val ++ (replaceBetween' . dropWhile (/= end)) strip
+    Nothing -> x:(replaceBetween' xs')
+  where
+    replaceBetween' = replaceBetween pref end val
+
+stripLocalAnchors :: String -> String
+stripLocalAnchors = replaceBetween "<a name=\"local-" '\"' "0"
+
+stripLocalLinks :: String -> String
+stripLocalLinks = replaceBetween "<a href=\"#local-" '\"' "0"
+
+stripLocalReferences :: String -> String
+stripLocalReferences = stripLocalLinks . stripLocalAnchors
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index e9a38c0..5b6b654 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -18,6 +18,8 @@ import System.Process
 import Distribution.Verbosity
 import Distribution.Simple.Utils hiding (die)
 
+import Utils
+
 
 baseDir, rootDir :: FilePath
 baseDir = takeDirectory __FILE__
@@ -64,14 +66,9 @@ check strict mdl = do
     hasReference <- doesFileExist refFile
     if hasReference
     then do
-        out <- readFile outFile
         ref <- readFile refFile
-        if out == ref
-        then putStrLn $ "Pass: " ++ mdl
-        else do
-            putStrLn $ "Fail: " ++ mdl
-            diff refFile outFile
-            when strict $ die "Aborting further tests."
+        out <- readFile outFile
+        compareOutput strict mdl ref out
     else do
         putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
   where
@@ -79,13 +76,33 @@ check strict mdl = do
     outFile = outDir' </> takeBaseName mdl ++ ".html"
 
 
-diff :: FilePath -> FilePath -> IO ()
-diff fileA fileB = do
+compareOutput :: Bool -> FilePath -> String -> String -> IO ()
+compareOutput strict mdl ref out = do
+    if ref' == out'
+    then putStrLn $ "Pass: " ++ mdl
+    else do
+        putStrLn $ "Fail: " ++ mdl
+        diff mdl ref' out'
+        when strict $ die "Aborting further tests."
+  where
+    ref' = stripLocalReferences ref
+    out' = stripLocalReferences out
+
+
+diff :: FilePath -> String -> String -> IO ()
+diff mdl ref out = do
     colorDiffPath <- findProgramLocation silent "colordiff"
     let cmd = fromMaybe "diff" colorDiffPath
 
-    result <- system $ cmd ++ " " ++ fileA ++ " " ++ fileB
+    writeFile refFile ref
+    writeFile outFile out
+
+    result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile
     unless (result == ExitSuccess) $ die "Failed to run `diff` command."
+  where
+    refFile = outDir </> takeFileName mdl </> ".ref.nolinks"
+    outFile = outDir </> takeFileName mdl </> ".nolinks"
+
 
 
 getAllSrcModules :: IO [FilePath]