aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-04 18:06:19 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-22 23:40:26 +0200
commit5cf07eb5041a7947400713f9f1105cc1ebfc6eb6 (patch)
treed8a3aaee0b4b1719bbb8502cda25674e5fc4565c
parent110599220155087d3c02a8a9a2f2d4834c666e47 (diff)
Incorporate old, ugly functions for comparing output files.
-rwxr-xr-xhtml-test/run.hs64
1 files changed, 61 insertions, 3 deletions
diff --git a/html-test/run.hs b/html-test/run.hs
index ace3c6a0..b9e1cc56 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -6,6 +6,7 @@
import Control.Monad
import Data.Maybe
+import Data.List
import Distribution.InstalledPackageInfo
import Distribution.Package
@@ -140,7 +141,7 @@ checkFile file = do
then do
out <- readFile outFile
ref <- readFile refFile
- return $ if haddockEq out ref
+ return $ if haddockEq (outFile, out) (refFile, ref)
then Pass
else Fail
else return NoRef
@@ -285,5 +286,62 @@ mlast :: [a] -> Maybe a
mlast = listToMaybe . reverse
-haddockEq :: String -> String -> Bool
-haddockEq _ _ = True -- TODO.
+-- *** OLD TEST RUNNER UTILITY FUNCTIONS ***
+-- These are considered bad and should be replaced as soon as possible.
+
+
+-- | List of modules in which we don't 'stripLinks'
+preserveLinksModules :: [String]
+preserveLinksModules = ["Bug253"]
+
+
+-- | A rather nasty way to drop the Haddock version string from the
+-- end of the generated HTML files so that we don't have to change
+-- every single test every time we change versions. We rely on the the
+-- last paragraph of the document to be the version. We end up with
+-- malformed HTML but we don't care as we never look at it ourselves.
+dropVersion :: String -> String
+dropVersion = reverse . dropTillP . reverse
+ where
+ dropTillP [] = []
+ dropTillP ('p':'<':xs) = xs
+ dropTillP (_:xs) = dropTillP xs
+
+
+haddockEq :: (FilePath, String) -> (FilePath, String) -> Bool
+haddockEq (fn1, file1) (fn2, file2) =
+ maybeStripLinks fn1 (dropVersion file1)
+ == maybeStripLinks fn2 (dropVersion file2)
+
+
+maybeStripLinks :: FilePath -- ^ Module we're considering for stripping
+ -> String -> String
+maybeStripLinks file
+ | takeBaseName file `elem` preserveLinksModules = id
+ | otherwise = stripLinks
+
+
+stripLinks :: String -> String
+stripLinks str =
+ let prefix = "<a href=\"" in
+ case stripPrefix prefix str of
+ 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