import Data.String.Utils (split, strip)
import Data.Maybe (catMaybes, fromJust, isNothing)
import Data.Tree.NTree.TypeDefs (NTree)
+import Test.HUnit (Assertion, assertEqual)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
import Text.XML.HXT.Core (
ArrowXml,
IOSArrow,
getText,
hasAttrValue,
hasName,
+ mkName,
none,
+ processAttrl,
processTopDown,
runX,
+ setElemName,
xshow,
when
)
processTopDown ((none) `when` is_image)
+is_link :: (ArrowXml a) => a XmlTree XmlTree
+is_link =
+ hasName "a"
+
+replace_links_with_spans :: (ArrowXml a) => a XmlTree XmlTree
+replace_links_with_spans =
+ processTopDown $ (make_span >>> remove_attrs) `when` is_link
+ where
+ make_span = setElemName $ mkName "span"
+ remove_attrs = processAttrl none
+
-- | Preprocessing common to both page types.
preprocess :: IOSArrow XmlTree (NTree XNode) -> IOSArrow XmlTree (NTree XNode)
preprocess xml =
- xml >>>remove_images
+ xml >>> remove_images >>> replace_links_with_spans
parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page)
is_image =
hasName "img"
-
remove_title :: (ArrowXml a) => a XmlTree XmlTree
remove_title =
processTopDown ((none) `when` is_title)
my_writer_options = defaultWriterOptions { writerEPUBMetadata = epmd }
write_epub = writeEPUB Nothing [] my_writer_options
read_html = readHtml defaultParserState
+
+
+
+
+test_preprocess_links :: Assertion
+test_preprocess_links = do
+ actual_xml' <- runX $ (preprocess input_xml) >>> css "body"
+ let actual_xml = actual_xml' !! 0
+
+ expected_xml' <- runX $ expected_xml'' >>> css "body"
+ let expected_xml = expected_xml' !! 0
+
+ assertEqual
+ "Links are replaced with spans"
+ expected_xml
+ actual_xml
+ where
+ input_html = "<body><a href=\"#\">Hello, world!</a></body>"
+ input_xml = parseHtml input_html
+ expected_html = "<body><span>Hello, world!</span></body>"
+ expected_xml'' = parseHtml expected_html
+
+page_tests :: Test
+page_tests =
+ testGroup "Page Tests" [
+ testCase "Links are replaced with spans" test_preprocess_links ]