src/LWN/Article.hs

   1 module LWN.Article (
   2   Article(..),
   3   Byline(..),
   4   Title(..),
   5   BodyHtml(..),
   6   article_tests,
   7   real_article_path
   8   )
   9 where
  10
  11 import Data.List (isPrefixOf)
  12 import System.Directory (doesFileExist)
  13 import Test.HUnit (Assertion, assertEqual)
  14 import Test.Framework (Test, testGroup)
  15 import Test.Framework.Providers.HUnit (testCase)
  16 import Text.Regex.Posix ((=~))
  17
  18 import LWN.URI (
  19   add_trailing_slash,
  20   is_lwn_url,
  21   try_make_absolute_url,
  22   make_https)
  23
  24 import LWN.XHTML (XHTML, to_xhtml)
  25
  26 newtype Title    = Title    { getTitle    :: String }
  27 newtype Byline   = Byline   { getByline   :: Maybe String }
  28 newtype BodyHtml = BodyHtml { getBodyHtml :: String }
  29
  30 instance Show Title where
  31   show = getTitle
  32
  33 instance Show Byline where
  34   show (Byline (Just bl)) = bl
  35   show (Byline Nothing  ) = ""
  36
  37 instance Show BodyHtml where
  38   show = getBodyHtml
  39
  40 instance XHTML Title where
  41   to_xhtml (Title t) = "<h2>" ++ t ++ "</h2>"
  42
  43 instance XHTML Byline where
  44   to_xhtml (Byline (Just bl)) = "<p><em>" ++ bl ++ "</em></p>"
  45   to_xhtml (Byline Nothing)   = ""
  46
  47 instance XHTML BodyHtml where
  48   to_xhtml = getBodyHtml
  49
  50 data Article = Article { title     :: Title,
  51                          byline    :: Byline,
  52                          body_html :: BodyHtml }
  53
  54 instance XHTML Article where
  55   to_xhtml (Article t bl b) =
  56     (to_xhtml t)  ++
  57     (to_xhtml bl) ++
  58     (to_xhtml b)
  59
  60
  61
  62 -- | Convert the given article to either a URL or a filesystem
  63 --   path. If the given article exists on the filesystem, we assume
  64 --   it's a file. Otherwise, we check to see if it's a URL. Failing
  65 --   that, we try to construct a URL from what we're given and do our
  66 --   best.
  67 real_article_path :: String -> IO String
  68 real_article_path path = do
  69   is_file <- doesFileExist path
  70   return $ if is_file then path else add_trailing_slash check_cases
  71   where
  72     abs_current = try_make_absolute_url ("/" ++ path)
  73     abs_article = try_make_absolute_url ("Articles/" ++ path)
  74
  75     check_cases :: String
  76     check_cases
  77       | is_lwn_url path = make_https path
  78       | isPrefixOf "current" path = abs_current
  79       | path =~ "^[0-9]+$" = abs_article
  80       | otherwise = path -- Give up
  81
  82
  83
  84 test_current_article_path :: Assertion
  85 test_current_article_path = do
  86   let expected = "https://lwn.net/current/"
  87   actual <- real_article_path "current"
  88   assertEqual "Current article path constructed" expected actual
  89
  90 test_current_bigpage_article_path :: Assertion
  91 test_current_bigpage_article_path = do
  92   let expected = "https://lwn.net/current/bigpage"
  93   actual <- real_article_path "current/bigpage"
  94   assertEqual "Current bigpage article path constructed" expected actual
  95
  96 test_numbered_article_path :: Assertion
  97 test_numbered_article_path = do
  98   let expected = "https://lwn.net/Articles/69/"
  99   actual <- real_article_path "69" -- I'm twelve
 100   assertEqual "Numbered article path constructed" expected actual
 101
 102
 103 test_full_article_path :: Assertion
 104 test_full_article_path = do
 105   let expected = "https://lwn.net/Articles/502979/"
 106   actual <- real_article_path "https://lwn.net/Articles/502979/"
 107   assertEqual "Full article path left alone" expected actual
 108
 109 test_non_https_article_path :: Assertion
 110 test_non_https_article_path = do
 111   let expected = "https://lwn.net/Articles/502979/"
 112   actual <- real_article_path "http://lwn.net/Articles/502979/"
 113   assertEqual "Non-https URL made https" expected actual
 114
 115 article_tests :: Test
 116 article_tests =
 117   testGroup "Article Tests" [
 118     testCase "Current article path constructed" test_current_article_path,
 119     testCase
 120       "Current bigpage article path constructed"
 121       test_current_bigpage_article_path,
 122     testCase "Numbered article path constructed" test_numbered_article_path,
 123     testCase "Full article path left alone" test_full_article_path,
 124     testCase "Non-https URL made https" test_non_https_article_path ]