1{-# LANGUAGE CPP #-} 2 3 4import Data.Char 5import Data.Function (on) 6 7import System.Environment 8import System.FilePath 9 10import Test.Haddock 11import Test.Haddock.Xhtml 12 13 14checkConfig :: CheckConfig Xml 15checkConfig = CheckConfig 16 { ccfgRead = parseXml 17 , ccfgClean = stripIfRequired 18 , ccfgDump = dumpXml 19 , ccfgEqual = (==) `on` dumpXml 20 } 21 22 23dirConfig :: DirConfig 24dirConfig = (defaultDirConfig $ takeDirectory __FILE__) 25 { dcfgCheckIgnore = checkIgnore 26 } 27 28 29main :: IO () 30main = do 31 cfg <- parseArgs checkConfig dirConfig =<< getArgs 32 runAndCheck $ cfg 33 { cfgHaddockArgs = cfgHaddockArgs cfg ++ ["--pretty-html", "--html"] 34 } 35 36 37stripIfRequired :: String -> Xml -> Xml 38stripIfRequired mdl = 39 stripLinks' . stripFooter 40 where 41 stripLinks' 42 | mdl `elem` preserveLinksModules = id 43 | otherwise = stripLinks 44 45 46-- | List of modules in which we don't 'stripLinks' 47preserveLinksModules :: [String] 48preserveLinksModules = ["Bug253.html", "NamespacedIdentifiers.html"] 49 50ingoredTests :: [FilePath] 51ingoredTests = 52 [ 53 -- Currently some declarations are exported twice 54 -- we need a reliable way to deduplicate here. 55 -- Happens since PR #688. 56 "B" 57 ] 58 59checkIgnore :: FilePath -> Bool 60checkIgnore file | takeBaseName file `elem` ingoredTests = True 61checkIgnore file@(c:_) | takeExtension file == ".html" && isUpper c = False 62checkIgnore _ = True 63