4 import Data.Maybe (fromJust)
5 import Data.String.Utils (split)
14 import Test.HUnit (Assertion, assertEqual)
15 import Test.Framework (Test, testGroup)
16 import Test.Framework.Providers.HUnit (testCase)
17 import Text.Regex.Posix
19 -- Distinguish between URLs (Strings) and URIs as provided by the
20 -- Network.URI module.
24 -- | Is this URI's scheme plain HTTP?
26 http uri = (uriScheme uri) == "http:"
28 -- | Is this URI's scheme (secure) HTTPS?
30 https uri = (uriScheme uri) == "https:"
32 -- | Does this URI use an HTTP-compatible port?
33 http_port :: URI -> Bool
38 (uriPort auth) `elem` ["", ":80"]
40 parse_result = uriAuthority uri
43 -- | Does this URI use an HTTPS-compatible port?
44 https_port :: URI -> Bool
49 (uriPort auth) `elem` ["", ":443"]
51 parse_result = uriAuthority uri
54 -- | Does this URL have one of the LWN hostnames?
55 lwn_host :: URI -> Bool
60 (uriRegName auth) `elem` ["lwn.net", "www.lwn.net"]
62 parse_result = uriAuthority uri
65 -- | Is the protocol portion of this URI one of the ones that LWN
67 lwn_proto :: URI -> Bool
69 ((http u) && (http_port u)) || ((https u) && (https_port u))
71 -- | Is the server/port to which we're connecting an LWN server?
72 lwn_server :: URI -> Bool
74 lwn_proto u && lwn_host u
76 -- | Is this URI's path for an LWN article?
77 lwn_article_path :: URI -> Bool
78 lwn_article_path uri =
79 path =~ "^/current(/bigpage)?/?$" ||
80 path =~ "^/Articles/[0-9]+(/bigpage)?/?$"
84 -- | Is this URI's query one that the LWN uses? The only query string
85 -- that the LWN articles use is the printable page one.
86 lwn_query :: URI -> Bool
88 query `elem` ["", "?format=printable"]
92 -- | Combine all of the other URI tests to determine if this 'URL'
93 -- belongs to an LWN article.
94 is_lwn_url :: URL -> Bool
98 Just uri -> (lwn_server uri) && (lwn_article_path uri) && (lwn_query uri)
100 parse_result = parseAbsoluteURI s
104 filename :: URL -> Maybe String
109 let components = split "/" (uriPath uri) in
110 -- Reverse them so that the filename comes first for easier
112 let reverse_components = reverse components in
113 case reverse_components of
117 parse_result = parseURIReference url
121 make_absolute_uri :: URI -> Maybe URI
122 make_absolute_uri relative_uri =
123 relativeTo relative_uri base_uri
125 base_auth = URIAuth { uriUserInfo = "",
126 uriRegName = "lwn.net",
128 base_uri = URI { uriScheme = "https:",
129 uriAuthority = Just base_auth,
135 make_absolute_url :: URL -> Maybe URL
136 make_absolute_url relative_url =
140 let abs_result = make_absolute_uri relative_uri in
143 Just abs_uri -> Just $ show abs_uri
145 parse_result = parseURIReference relative_url
149 -- | A List of LWN URLs to use during testing.
151 lwn_urls = [ proto ++ www ++ "lwn.net" ++ path ++ bigpage ++ query |
152 proto <- ["http://", "https://"],
154 bigpage <- ["", "/bigpage"],
155 query <- ["", "?format=printable"],
156 path <- [ "/current",
158 "/Articles/502371" ] ]
160 test_lwn_urls_matched :: Assertion
161 test_lwn_urls_matched =
162 assertEqual "All LWN URLs matched" True (all is_lwn_url lwn_urls)
164 test_http_uris_matched :: Assertion
165 test_http_uris_matched =
166 assertEqual (url ++ " is HTTP") True (http uri)
168 url = "http://lwn.net/Articles/500844/bigpage"
169 uri = fromJust $ parseAbsoluteURI url
171 test_https_uris_matched :: Assertion
172 test_https_uris_matched =
173 assertEqual (url ++ " is HTTPS") True (https uri)
175 url = "https://lwn.net/Articles/500844/bigpage"
176 uri = fromJust $ parseAbsoluteURI url
179 test_bare_filename_parsed :: Assertion
180 test_bare_filename_parsed =
181 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
184 actual_result = fromJust $ filename url
186 test_absolute_filename_parsed :: Assertion
187 test_absolute_filename_parsed =
188 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
190 url = "http://lwn.net/one/two/example.jpg"
191 actual_result = fromJust $ filename url
193 test_relative_filename_parsed :: Assertion
194 test_relative_filename_parsed =
195 assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
197 url = "/one/two/example.jpg"
198 actual_result = fromJust $ filename url
201 test_empty_url_conversion :: Assertion
202 test_empty_url_conversion =
203 assertEqual "'' converted to lwn.net" expected actual
205 expected = "https://lwn.net/"
206 actual = fromJust $ make_absolute_url ""
209 test_normal_url_conversion :: Assertion
210 test_normal_url_conversion =
211 assertEqual "Image URL is made absolute" expected actual
213 url = "/images/2012/lcj-coughlan-lattimer-sm.jpg"
214 expected = "https://lwn.net/images/2012/lcj-coughlan-lattimer-sm.jpg"
215 actual = fromJust $ make_absolute_url url
220 testGroup "URI Tests" [
222 testGroup "URI Matching" [
223 testCase "HTTP URIs matched" test_http_uris_matched,
224 testCase "HTTPS URIs matched" test_https_uris_matched,
225 testCase "LWN URLs matched" test_lwn_urls_matched ],
227 testGroup "Filename Parsing" [
228 testCase "Bare filename parsed" test_bare_filename_parsed,
229 testCase "Absolute filename parsed" test_absolute_filename_parsed,
230 testCase "Relative filename parsed" test_relative_filename_parsed ],
232 testGroup "Relative -> Absolute Conversion" [
233 testCase "Empty URL converted to lwn.net" test_empty_url_conversion,
234 testCase "Normal URL made absolute" test_normal_url_conversion ]]