" ++ (show $ LWN.Article.title a) ++ "

From 2953924e2016393a1ffb9e2e82b4c90c8c57dfd3 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sun, 8 Jul 2012 17:25:34 -0400 Subject: [PATCH] Move the wrapper div inside the ArticlePage to_xhtml function. Add an XML class and implement to_xml for Articles. --- src/LWN/Article.hs | 59 ++++++++++++++++++++++++++++++++++++++++++---- src/LWN/Page.hs | 2 -- src/LWN/XHTML.hs | 9 +++++-- 3 files changed, 62 insertions(+), 8 deletions(-) diff --git a/src/LWN/Article.hs b/src/LWN/Article.hs index 9d4c858..ac3d456 100644 --- a/src/LWN/Article.hs +++ b/src/LWN/Article.hs @@ -14,6 +14,15 @@ import Test.HUnit (Assertion, assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Text.Regex.Posix ((=~)) +import Text.XML.HXT.Core ( + (>>>), + arr, + hread, + selem, + none, + runX, + txt, + xshow) import LWN.URI ( add_trailing_slash, @@ -21,7 +30,7 @@ import LWN.URI ( try_make_absolute_url, make_https) -import LWN.XHTML (XHTML, to_xhtml) +import LWN.XHTML (XHTML, XML, to_xhtml, to_xml) newtype Title = Title { getTitle :: String } newtype Byline = Byline { getByline :: Maybe String } @@ -47,17 +56,35 @@ instance XHTML Byline where instance XHTML BodyHtml where to_xhtml = getBodyHtml + +instance XML Title where + to_xml (Title t) = + selem "h2" [ txt t ] + +instance XML Byline where + to_xml (Byline (Just bl)) = + selem "p" [ selem "em" [ txt bl ] ] + to_xml (Byline Nothing) = none + +instance XML BodyHtml where + to_xml (BodyHtml bh) = + (arr $ const bh) >>> hread + data Article = Article { title :: Title, byline :: Byline, body_html :: BodyHtml } instance XHTML Article where to_xhtml (Article t bl b) = + "

" ++ (to_xhtml t) ++ (to_xhtml bl) ++ - (to_xhtml b) - + (to_xhtml b) ++ + "

" +instance XML Article where + to_xml (Article t bl b) = + selem "div" [to_xml t, to_xml bl, to_xml b] -- | Convert the given article to either a URL or a filesystem -- path. If the given article exists on the filesystem, we assume @@ -112,6 +139,29 @@ test_non_https_article_path = do actual <- real_article_path "http://lwn.net/Articles/502979/" assertEqual "Non-https URL made https" expected actual + + +-- | Compares the output of (xshow . to_xml) and to_xhtml; they should +-- match. +test_to_xml :: Assertion +test_to_xml = do + actual_xml' <- runX . xshow $ to_xml input_article + let actual_xml = actual_xml' !! 0 + + let expected_xml = to_xhtml input_article + + assertEqual + "The to_xml function works on a trivial example" + expected_xml + actual_xml + where + t = Title "Hello, world!" + bl = Byline $ Just "Breaking News" + b = BodyHtml "

Hello, world!

" + input_article = Article t bl b + + + article_tests :: Test article_tests = testGroup "Article Tests" [ @@ -121,4 +171,5 @@ article_tests = test_current_bigpage_article_path, testCase "Numbered article path constructed" test_numbered_article_path, testCase "Full article path left alone" test_full_article_path, - testCase "Non-https URL made https" test_non_https_article_path ] + testCase "Non-https URL made https" test_non_https_article_path, + testCase "The to_xml function works on a trivial example" test_to_xml ] diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 3705f3b..3027eae 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -133,9 +133,7 @@ instance XHTML Page where " " ++ (show $ LWN.Article.title a) ++ "" ++ "" ++ "" ++ - "

" ++ (to_xhtml a) ++ - "

" ++ "" ++ "" diff --git a/src/LWN/XHTML.hs b/src/LWN/XHTML.hs index caa7403..f6632db 100644 --- a/src/LWN/XHTML.hs +++ b/src/LWN/XHTML.hs @@ -1,11 +1,15 @@ module LWN.XHTML ( XHTML, + XML, + my_read_opts, parse_lwn, - to_xhtml + to_xhtml, + to_xml ) where import Text.XML.HXT.Core ( + ArrowXml, IOStateArrow, SysConfigList, XmlTree, @@ -20,7 +24,8 @@ import Text.XML.HXT.Core ( class XHTML a where to_xhtml :: a -> String - +class XML a where + to_xml :: (ArrowXml b) => a -> (b XmlTree XmlTree) -- | Options used when parsing HTML. my_read_opts :: SysConfigList -- 2.43.2