Merge remote-tracking branch 'mrhania/testing-framework-improvements' into ghc-head

1 files changed, 50 insertions, 0 deletions

diff --git a/hypsrc-test/Main.hs b/hypsrc-test/Main.hs
new file mode 100644
index 00000000..0490be47
--- /dev/null
+++ b/hypsrc-test/Main.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE CPP #-}
+
+
+import Data.Char
+import Data.List
+
+import System.Environment
+import System.FilePath
+
+import Test.Haddock
+import Test.Haddock.Xhtml
+
+
+checkConfig :: CheckConfig Xml
+checkConfig = CheckConfig
+    { ccfgRead = \_ input -> strip <$> parseXml input
+    , ccfgDump = dumpXml
+    , ccfgEqual = (==)
+    }
+  where
+    strip = stripAnchors' . stripLinks' . stripFooter
+    stripLinks' = stripLinksWhen $ \href -> "#local-" `isPrefixOf` href
+    stripAnchors' = stripAnchorsWhen $ \name -> "local-" `isPrefixOf` name
+
+
+dirConfig :: DirConfig
+dirConfig = (defaultDirConfig $ takeDirectory __FILE__)
+    { dcfgCheckIgnore = checkIgnore
+    }
+
+
+main :: IO ()
+main = do
+    cfg <- parseArgs checkConfig dirConfig =<< getArgs
+    runAndCheck $ cfg
+        { cfgHaddockArgs = cfgHaddockArgs cfg ++
+            [ "--pretty-html"
+            , "--hyperlinked-source"
+            ]
+        }
+
+
+checkIgnore :: FilePath -> Bool
+checkIgnore file
+    | and . map ($ file) $ [isHtmlFile, isSourceFile, isModuleFile] = False
+  where
+    isHtmlFile = (== ".html") . takeExtension
+    isSourceFile = (== "src") . takeDirectory
+    isModuleFile = isUpper . head . takeBaseName
+checkIgnore _ = True