aboutsummaryrefslogtreecommitdiff
path: root/hypsrc-test/Main.hs
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2015-12-20 00:54:11 +0100
committerBen Gamari <ben@smart-cactus.org>2015-12-20 00:54:11 +0100
commit1555134703d5b1bb832361abf276fd651eff398c (patch)
tree237e485858d3d62b23ffcc6d2e04cee614c301ee /hypsrc-test/Main.hs
parentfa03f80d76f1511a811a0209ea7a6a8b6c58704f (diff)
parent27ffb2c24b8204d1a06bd509c49d3e3d7d2d7aba (diff)
Merge remote-tracking branch 'mrhania/testing-framework-improvements' into ghc-head
Diffstat (limited to 'hypsrc-test/Main.hs')
-rw-r--r--hypsrc-test/Main.hs50
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