diff options
| author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-21 19:32:37 +0200 |
|---|---|---|
| committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-22 23:40:28 +0200 |
| commit | 391225eea26bb2484cbf49d0ca5964ab3176b974 (patch) | |
| tree | 410ae3e356151bc67f2b82443633e0155399105e /haddock-test | |
| parent | 3378ef409170ae1f319c934876d2b9e1a14bb9a8 (diff) | |
Create helper function for conversion between XML and XHTML.
Diffstat (limited to 'haddock-test')
| -rw-r--r-- | haddock-test/haddock-test.cabal | 2 | ||||
| -rw-r--r-- | haddock-test/src/Test/Haddock/Xhtml.hs | 19 |
2 files changed, 20 insertions, 1 deletions
diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal index 18c9d28b..0394da8f 100644 --- a/haddock-test/haddock-test.cabal +++ b/haddock-test/haddock-test.cabal @@ -16,7 +16,7 @@ library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - build-depends: base, directory, process, filepath, Cabal, xml, syb + build-depends: base, directory, process, filepath, Cabal, xml, xhtml, syb exposed-modules: Test.Haddock diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs index d8c26249..21fda36d 100644 --- a/haddock-test/src/Test/Haddock/Xhtml.hs +++ b/haddock-test/src/Test/Haddock/Xhtml.hs @@ -13,6 +13,7 @@ import Data.Generics.Aliases import Data.Generics.Schemes import Text.XML.Light +import Text.XHtml newtype Xhtml = Xhtml @@ -72,3 +73,21 @@ stripFooter = [ qName attrKey == "id" , attrVal == "footer" ] + + +xmlElementToXhtml :: Element -> Html +xmlElementToXhtml (Element { .. }) = + tag (qName elName) contents ! attrs + where + contents = mconcat $ map xmlContentToXhtml elContent + attrs = map xmlAttrToXhtml elAttribs + + +xmlContentToXhtml :: Content -> Html +xmlContentToXhtml (Elem el) = xmlElementToXhtml el +xmlContentToXhtml (Text text) = toHtml $ cdData text +xmlContentToXhtml (CRef cref) = noHtml + + +xmlAttrToXhtml :: Attr -> HtmlAttr +xmlAttrToXhtml (Attr { .. }) = strAttr (qName attrKey) attrVal |