4 import Data.Maybe (fromJust)
5 import Data.String.Utils (split)
13 import Test.HUnit (Assertion, assertEqual)
14 import Test.Framework (Test, testGroup)
15 import Test.Framework.Providers.HUnit (testCase)
16 import Text.Regex.Posix
18 -- Distinguish between URLs (Strings) and URIs as provided by the
19 -- Network.URI module.
23 -- | Is this URI's scheme plain HTTP?
25 http uri = (uriScheme uri) == "http:"
27 -- | Is this URI's scheme (secure) HTTPS?
29 https uri = (uriScheme uri) == "https:"
31 -- | Does this URI use an HTTP-compatible port?
32 http_port :: URI -> Bool
37 (uriPort auth) `elem` ["", ":80"]
39 parse_result = uriAuthority uri
42 -- | Does this URI use an HTTPS-compatible port?
43 https_port :: URI -> Bool
48 (uriPort auth) `elem` ["", ":443"]
50 parse_result = uriAuthority uri
53 -- | Does this URL have one of the LWN hostnames?
54 lwn_host :: URI -> Bool
59 (uriRegName auth) `elem` ["lwn.net", "www.lwn.net"]
61 parse_result = uriAuthority uri
64 -- | Is the protocol portion of this URI one of the ones that LWN
66 lwn_proto :: URI -> Bool
68 ((http u) && (http_port u)) || ((https u) && (https_port u))
70 -- | Is the server/port to which we're connecting an LWN server?
71 lwn_server :: URI -> Bool
73 lwn_proto u && lwn_host u
75 -- | Is this URI's path for an LWN article?
76 lwn_article_path :: URI -> Bool
77 lwn_article_path uri =
78 path =~ "^/current(/bigpage)?/?$" ||
79 path =~ "^/Articles/[0-9]+(/bigpage)?/?$"
83 -- | Is this URI's query one that the LWN uses? The only query string
84 -- that the LWN articles use is the printable page one.
85 lwn_query :: URI -> Bool
87 query `elem` ["", "?format=printable"]
91 -- | Combine all of the other URI tests to determine if this 'URL'
92 -- belongs to an LWN article.
93 is_lwn_url :: URL -> Bool
97 Just uri -> (lwn_server uri) && (lwn_article_path uri) && (lwn_query uri)
99 parse_result = parseAbsoluteURI s
103 filename :: URL -> Maybe String
108 let components = split "/" (uriPath uri) in
109 -- Reverse them so that the filename comes first for easier
111 let reverse_components = reverse components in
112 case reverse_components of
116 parse_result = parseURIReference url
120 make_absolute_uri :: URI -> Maybe URI
121 make_absolute_uri relative_uri =
122 relativeTo relative_uri base_uri
124 base_uri = URI { uriScheme = "https://",
125 uriAuthority = "lwn.net",
131 make_absolute_url :: URL -> Maybe URL
132 make_absolute_url relative_url =
136 let abs_result = make_absolute_uri relative_uri in
139 Just abs_uri -> show abs_uri
141 parse_result = parseURIReference url
145 -- | A List of LWN URLs to use during testing.
147 lwn_urls = [ proto ++ www ++ "lwn.net" ++ path ++ bigpage ++ query |
148 proto <- ["http://", "https://"],
150 bigpage <- ["", "/bigpage"],
151 query <- ["", "?format=printable"],
152 path <- [ "/current",
154 "/Articles/502371" ] ]
156 test_lwn_urls_matched :: Assertion
157 test_lwn_urls_matched =
158 assertEqual "All LWN URLs matched" True (all is_lwn_url lwn_urls)
160 test_http_uris_matched :: Assertion
161 test_http_uris_matched =
162 assertEqual (url ++ " is HTTP") True (http uri)
164 url = "http://lwn.net/Articles/500844/bigpage"
165 uri = fromJust $ parseAbsoluteURI url
167 test_https_uris_matched :: Assertion
168 test_https_uris_matched =
169 assertEqual (url ++ " is HTTPS") True (https uri)
171 url = "https://lwn.net/Articles/500844/bigpage"
172 uri = fromJust $ parseAbsoluteURI url
175 test_bare_filename_parsed :: Assertion
176 test_bare_filename_parsed =
177 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
180 actual_result = fromJust $ filename url
182 test_absolute_filename_parsed :: Assertion
183 test_absolute_filename_parsed =
184 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
186 url = "http://lwn.net/one/two/example.jpg"
187 actual_result = fromJust $ filename url
189 test_relative_filename_parsed :: Assertion
190 test_relative_filename_parsed =
191 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
193 url = "/one/two/example.jpg"
194 actual_result = fromJust $ filename url
197 test_empty_url_conversion :: Assertion
198 test_empty_url_conversion =
199 assertEqual "'' converted to lwn.net" expected actual
201 expected = "https://lwn.net/"
202 actual = fromJust $ make_absolute_url ""
205 test_normal_url_conversion :: Assertion
206 test_normal_url_conversion =
207 assertEqual "Image URL is made absolute" expected actual
209 url = "/images/2012/lcj-coughlan-lattimer-sm.jpg"
210 expected = "https://lwn.net/images/2012/lcj-coughlan-lattimer-sm.jpg"
211 actual = fromJust $ make_absolute_url url
216 testGroup "URI Tests" [
218 testGroup "URI Matching" [
219 testCase "HTTP URIs matched" test_http_uris_matched,
220 testCase "HTTPS URIs matched" test_https_uris_matched,
221 testCase "LWN URLs matched" test_lwn_urls_matched ],
223 testGroup "Filename Parsing" [
224 testCase "Bare filename parsed" test_bare_filename_parsed,
225 testCase "Absolute filename parsed" test_absolute_filename_parsed,
226 testCase "Relative filename parsed" test_relative_filename_parsed ],
228 testGroup "Relative -> Absolute Conversion" [
229 testCase "Empty URL converted to lwn.net" test_empty_url_conversion,
230 testCase "Normal URL made absolute" test_normal_url_conversion ]]