X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FArticle.hs;h=ac3d456da8aae0ef43339e66c9bd62d5e92cff44;hp=2820d54f93393a94fbd59b6928405c34f9598af1;hb=2953924e2016393a1ffb9e2e82b4c90c8c57dfd3;hpb=5cb0170a5ab418147e3403fb141797f2282b78f4 diff --git a/src/LWN/Article.hs b/src/LWN/Article.hs index 2820d54..ac3d456 100644 --- 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 { title :: 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) = "
" ++ 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 t bl b) = - "" ++ bl ++ "
\n\n" ++ - b + "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 ]