module LWN.Article (
  Article(..),
  Byline(..),
  Title(..),
  BodyHtml(..),
  article_tests,
  real_article_path
  )
where

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)

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 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)
    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 "<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 ]