aboutsummaryrefslogtreecommitdiff
path: root/html-test
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-05 17:58:08 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-22 23:40:27 +0200
commit8af6bdb677b6fc91752a5276e8f7a7c17f5881e7 (patch)
tree40dfb00e96617ed990054664c68d0a9bce6fdaad /html-test
parentb816a40ecb60ee04ab63558cd17373907e9bf4c4 (diff)
Incorporate link stripping to output diffing mechanism.
Diffstat (limited to 'html-test')
-rwxr-xr-xhtml-test/run.hs20
1 files changed, 11 insertions, 9 deletions
diff --git a/html-test/run.hs b/html-test/run.hs
index f416f07c..06f20ee6 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -168,18 +168,16 @@ checkModule mdl = do
then Pass
else Fail
else return NoRef
- where
- readXml = liftM Xml.parseXMLDoc . readFile
diffModule :: FilePath -> String -> IO ()
diffModule diff mdl = do
- out <- readFile $ outFile mdl
- ref <- readFile $ refFile mdl
- let out' = stripLinks . dropVersion $ out
- let ref' = stripLinks . dropVersion $ ref
- writeFile outFile' out'
- writeFile refFile' ref'
+ Just outXml <- readXml $ outFile mdl
+ Just refXml <- readXml $ refFile mdl
+ let outXml' = strip outXml
+ let refXml' = strip refXml
+ writeFile outFile' $ Xml.ppElement outXml'
+ writeFile refFile' $ Xml.ppElement refXml'
putStrLn $ "Diff for module " ++ show mdl ++ ":"
handle <- runProcess' diff $ processConfig
@@ -265,12 +263,16 @@ deriving instance Eq Xml.Element
deriving instance Eq Xml.CData
+readXml :: FilePath -> IO (Maybe Xml.Element)
+readXml = liftM Xml.parseXMLDoc . readFile
+
+
strip :: Xml.Element -> Xml.Element
strip =
everywhere (mkT unlink)
where
unlink attr@(Xml.Attr { attrKey = key })
- | Xml.qName key == "href" = attr { Xml.attrVal = "" }
+ | Xml.qName key == "href" = attr { Xml.attrVal = "#" }
| otherwise = attr