X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;ds=inline;f=src%2FLWN%2FArticle.hs;h=47e36519858209235829485c6cf099309d1d7963;hb=68bab2c1cc272e99c94447afb93678e2b4d4bc72;hp=2da17354249edd936b4bc74648b1612ebf7ec2a1;hpb=b591d5f5c3c47d253c24144beae1edf8648cd94b;p=dead%2Flwn-epub.git
diff --git a/src/LWN/Article.hs b/src/LWN/Article.hs
index 2da1735..47e3651 100644
--- a/src/LWN/Article.hs
+++ b/src/LWN/Article.hs
@@ -1,14 +1,177 @@
-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) = "
" ++ t ++ "
"
+
+instance XHTML Byline where
+ to_xhtml (Byline (Just bl)) = "" ++ bl ++ "
"
+ 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) =
- "" ++ hl ++ "
\n\n" ++
- "" ++ bl ++ "
\n\n" ++
- b
+ to_xhtml (Article t bl b) =
+ "" ++
+ (to_xhtml t) ++
+ (to_xhtml bl) ++
+ (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
+-- 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)
+ 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
+
+
+
+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 "Hello, world!
"
+ 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 ]