diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-01 00:47:32 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-01 00:47:32 +0200 |
commit | 395a9c3941f8b8891cffa5c17e1f6ae414edaa79 (patch) | |
tree | 30c6bad02b7fcf68701e7672503eeff7d335c473 | |
parent | 40d0a050c81ff21949fc7eeede4e0dbb3b1d7c98 (diff) |
Make hyperlinker test runner strip local links from generated source.
-rw-r--r-- | hypsrc-test/Utils.hs | 26 | ||||
-rwxr-xr-x | 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 00000000..cf3e94ea --- /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 e9a38c0c..5b6b6548 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] |