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