Only fetch login cookies once.

[dead/lwn-epub.git] / src / LWN / Article.hs

diff --git a/src/LWN/Article.hs b/src/LWN/Article.hs
index 9d4c85868be9f25299eabd79604249e56474f1ca..47e36519858209235829485c6cf099309d1d7963 100644 (file)
--- 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) =
+    "<div>"       ++
     (to_xhtml t)  ++
     (to_xhtml bl) ++
-    (to_xhtml b)
-
+    (to_xhtml b)  ++
+    "</div>"
 
+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
@@ -71,12 +98,14 @@ real_article_path path = do
   where
     abs_current = try_make_absolute_url ("/" ++ path)
     abs_article = try_make_absolute_url ("Articles/" ++ path)
+    abs_full_article = try_make_absolute_url path
 
     check_cases :: String
     check_cases
       | is_lwn_url path = make_https path
       | isPrefixOf "current" path = abs_current
       | path =~ "^[0-9]+$" = abs_article
+      | path =~ "^/Articles/[0-9]+/?$" = abs_full_article
       | otherwise = path -- Give up
 
 
@@ -112,6 +141,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 "<p>Hello, world!</p>"
+    input_article = Article t bl b
+
+
+
 article_tests :: Test
 article_tests =
   testGroup "Article Tests" [
@@ -121,4 +173,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 ]