1{-# LANGUAGE CPP #-} 2 3 4import Data.Char 5import Data.List 6import Data.Function (on) 7 8import System.Environment 9import System.FilePath 10 11import Test.Haddock 12import Test.Haddock.Xhtml 13 14 15checkConfig :: CheckConfig Xml 16checkConfig = CheckConfig 17 { ccfgRead = parseXml 18 , ccfgClean = strip 19 , ccfgDump = dumpXml 20 , ccfgEqual = (==) `on` dumpXml 21 } 22 where 23 strip _ = stripAnchors' . stripLinks' . stripIds' . stripFooter 24 25 stripLinks' = stripLinksWhen $ \href -> "#local-" `isPrefixOf` href 26 stripAnchors' = stripAnchorsWhen $ \name -> "local-" `isPrefixOf` name 27 stripIds' = stripIdsWhen $ \name -> "local-" `isPrefixOf` name 28 29 30dirConfig :: DirConfig 31dirConfig = (defaultDirConfig $ takeDirectory __FILE__) 32 { dcfgCheckIgnore = checkIgnore 33 } 34 35 36main :: IO () 37main = do 38 cfg <- parseArgs checkConfig dirConfig =<< getArgs 39 runAndCheck $ cfg 40 { cfgHaddockArgs = cfgHaddockArgs cfg ++ 41 [ "--pretty-html" 42 , "--hyperlinked-source" 43 ] 44 } 45 46 47checkIgnore :: FilePath -> Bool 48checkIgnore file 49 | and . map ($ file) $ [isHtmlFile, isSourceFile, isModuleFile] = False 50 where 51 isHtmlFile = (== ".html") . takeExtension 52 isSourceFile = (== "src") . takeDirectory 53 isModuleFile = isUpper . head . takeBaseName 54checkIgnore _ = True 55