X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;ds=sidebyside;f=src%2FLWN%2FXHTML.hs;h=f1a91c249b41608e764f15ca7e8922f06afa2a7c;hb=95784f57c7cdd5f91c4fca86c11165723109f2a9;hp=c54bada32538c97e5e0f6d9c5fe579a37e2a4f77;hpb=ce53d0d1ff76cc45f1f66504976a0549999677c0;p=dead%2Flwn-epub.git
diff --git a/src/LWN/XHTML.hs b/src/LWN/XHTML.hs
index c54bada..f1a91c2 100644
--- a/src/LWN/XHTML.hs
+++ b/src/LWN/XHTML.hs
@@ -16,6 +16,7 @@ module LWN.XHTML (
xml_from_contents)
where
+import Data.String.Utils (replace)
import Text.HandsomeSoup (css)
import Text.XML.HXT.Core (
(>>>),
@@ -25,6 +26,7 @@ import Text.XML.HXT.Core (
SysConfigList,
XmlTree,
changeAttrValue,
+ changeText,
deep,
getAttrValue,
hasAttrValue,
@@ -84,12 +86,27 @@ preprocess =
remove_comment_links
>>>
replace_links_with_spans
+ >>>
+ replace_double_newline_in_pre
is_link :: (ArrowXml a) => a XmlTree XmlTree
is_link =
isElem >>> hasName "a"
+is_pre :: (ArrowXml a) => a XmlTree XmlTree
+is_pre =
+ isElem
+ >>>
+ hasName "pre"
+
+replace_double_newline_in_pre :: (ArrowXml a) => a XmlTree XmlTree
+replace_double_newline_in_pre =
+ processTopDown $ fix_it `when` is_pre
+ where
+ fix_it :: (ArrowXml a) => a XmlTree XmlTree
+ fix_it =
+ changeText $ replace "\n\n" "
"
remove_full_story_paragraphs :: (ArrowXml a) => a XmlTree XmlTree
remove_full_story_paragraphs =