blob: 35f5910a7a06e791baa6b086690cc46e537d4c21 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Test.Haddock.Xhtml where
import Control.Monad
import Data.Generics.Aliases
import Data.Generics.Schemes
import Text.XML.Light
deriving instance Eq Content
deriving instance Eq Element
deriving instance Eq CData
readXml :: FilePath -> IO (Maybe Element)
readXml = liftM parseXMLDoc . readFile
strip :: Element -> Element
strip = stripFooter . stripLinks
stripLinks :: Element -> Element
stripLinks =
everywhere (mkT unlink)
where
unlink attr@(Attr { attrKey = key })
| qName key == "href" = attr { attrVal = "#" }
| otherwise = attr
stripFooter :: Element -> Element
stripFooter =
everywhere (mkT defoot)
where
defoot elem
| isFooter elem = elem { elContent = [] }
| otherwise = elem
isFooter elem = any isFooterAttr $ elAttribs elem
isFooterAttr (Attr { .. }) = and
[ qName attrKey == "id"
, attrVal == "footer"
]
|
