9d4c85868be9f25299eabd79604249e56474f1ca
[dead/lwn-epub.git] / 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 ]