Move the wrapper div inside the ArticlePage to_xhtml function.

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

diff --git a/src/LWN/Article.hs b/src/LWN/Article.hs
index 2da17354249edd936b4bc74648b1612ebf7ec2a1..ac3d456da8aae0ef43339e66c9bd62d5e92cff44 100644 (file)
--- a/src/LWN/Article.hs
+++ b/src/LWN/Article.hs
@@ -1,14 +1,175 @@
-module LWN.Article
+module LWN.Article (
+  Article(..),
+  Byline(..),
+  Title(..),
+  BodyHtml(..),
+  article_tests,
+  real_article_path
+  )
 where
 
-import XHTML
+import Data.List (isPrefixOf)
+import System.Directory (doesFileExist)
+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)
 
-data Article = Article { headline  :: String,
-                         byline    :: String,
-                         body_html :: String }
+import LWN.URI (
+  add_trailing_slash,
+  is_lwn_url,
+  try_make_absolute_url,
+  make_https)
+
+import LWN.XHTML (XHTML, XML, to_xhtml, to_xml)
+
+newtype Title    = Title    { getTitle    :: String }
+newtype Byline   = Byline   { getByline   :: Maybe String }
+newtype BodyHtml = BodyHtml { getBodyHtml :: String }
+
+instance Show Title where
+  show = getTitle
+
+instance Show Byline where
+  show (Byline (Just bl)) = bl
+  show (Byline Nothing  ) = ""
+
+instance Show BodyHtml where
+  show = getBodyHtml
+
+instance XHTML Title where
+  to_xhtml (Title t) = "<h2>" ++ t ++ "</h2>"
+
+instance XHTML Byline where
+  to_xhtml (Byline (Just bl)) = "<p><em>" ++ bl ++ "</em></p>"
+  to_xhtml (Byline Nothing)   = ""
+
+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 hl bl b) =
-    "<h1>" ++ hl ++ "</h1>\n\n" ++
-    "<h2>" ++ bl ++ "</h2>\n\n" ++
-    b
+  to_xhtml (Article t bl b) =
+    "<div>"       ++
+    (to_xhtml t)  ++
+    (to_xhtml bl) ++
+    (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
+--   it's a file. Otherwise, we check to see if it's a URL. Failing
+--   that, we try to construct a URL from what we're given and do our
+--   best.
+real_article_path :: String -> IO String
+real_article_path path = do
+  is_file <- doesFileExist path
+  return $ if is_file then path else add_trailing_slash check_cases
+  where
+    abs_current = try_make_absolute_url ("/" ++ path)
+    abs_article = try_make_absolute_url ("Articles/" ++ path)
+
+    check_cases :: String
+    check_cases
+      | is_lwn_url path = make_https path
+      | isPrefixOf "current" path = abs_current
+      | path =~ "^[0-9]+$" = abs_article
+      | otherwise = path -- Give up
+
+
+
+test_current_article_path :: Assertion
+test_current_article_path = do
+  let expected = "https://lwn.net/current/"
+  actual <- real_article_path "current"
+  assertEqual "Current article path constructed" expected actual
+
+test_current_bigpage_article_path :: Assertion
+test_current_bigpage_article_path = do
+  let expected = "https://lwn.net/current/bigpage"
+  actual <- real_article_path "current/bigpage"
+  assertEqual "Current bigpage article path constructed" expected actual
+
+test_numbered_article_path :: Assertion
+test_numbered_article_path = do
+  let expected = "https://lwn.net/Articles/69/"
+  actual <- real_article_path "69" -- I'm twelve
+  assertEqual "Numbered article path constructed" expected actual
+
+
+test_full_article_path :: Assertion
+test_full_article_path = do
+  let expected = "https://lwn.net/Articles/502979/"
+  actual <- real_article_path "https://lwn.net/Articles/502979/"
+  assertEqual "Full article path left alone" expected actual
+
+test_non_https_article_path :: Assertion
+test_non_https_article_path = do
+  let expected = "https://lwn.net/Articles/502979/"
+  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" [
+    testCase "Current article path constructed" test_current_article_path,
+    testCase
+      "Current bigpage article path constructed"
+      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 "The to_xml function works on a trivial example" test_to_xml ]