4 import Data.Maybe (fromJust)
15 import Test.HUnit (Assertion, assertEqual)
16 import Test.Framework (Test, testGroup)
17 import Test.Framework.Providers.HUnit (testCase)
18 import Text.Regex.Posix
20 -- Distinguish between URLs (Strings) and URIs as provided by the
21 -- Network.URI module.
25 -- | Is this URI's scheme plain HTTP?
27 http uri = (uriScheme uri) == "http:"
29 -- | Is this URI's scheme (secure) HTTPS?
31 https uri = (uriScheme uri) == "https:"
33 -- | Does this URI use an HTTP-compatible port?
34 http_port :: URI -> Bool
39 (uriPort auth) `elem` ["", ":80"]
41 parse_result = uriAuthority uri
44 -- | Does this URI use an HTTPS-compatible port?
45 https_port :: URI -> Bool
50 (uriPort auth) `elem` ["", ":443"]
52 parse_result = uriAuthority uri
55 -- | Does this URL have one of the LWN hostnames?
56 lwn_host :: URI -> Bool
61 (uriRegName auth) `elem` ["lwn.net", "www.lwn.net"]
63 parse_result = uriAuthority uri
66 -- | Is the protocol portion of this URI one of the ones that LWN
68 lwn_proto :: URI -> Bool
70 ((http u) && (http_port u)) || ((https u) && (https_port u))
72 -- | Is the server/port to which we're connecting an LWN server?
73 lwn_server :: URI -> Bool
75 lwn_proto u && lwn_host u
77 -- | Is this URI's path for an LWN article?
78 lwn_article_path :: URI -> Bool
79 lwn_article_path uri =
80 path =~ "^/current(/bigpage)?/?$" ||
81 path =~ "^/Articles/[0-9]+(/bigpage)?/?$"
85 -- | Is this URI's query one that the LWN uses? The only query string
86 -- that the LWN articles use is the printable page one.
87 lwn_query :: URI -> Bool
89 query `elem` ["", "?format=printable"]
93 -- | Combine all of the other URI tests to determine if this 'URL'
94 -- belongs to an LWN article.
95 is_lwn_url :: URL -> Bool
99 Just uri -> (lwn_server uri) && (lwn_article_path uri) && (lwn_query uri)
101 parse_result = parseAbsoluteURI s
104 -- | A List of LWN URLs to use during testing.
106 lwn_urls = [ proto ++ www ++ "lwn.net" ++ path ++ bigpage ++ query |
107 proto <- ["http://", "https://"],
109 bigpage <- ["", "/bigpage"],
110 query <- ["", "?format=printable"],
111 path <- [ "/current",
113 "/Articles/502371" ] ]
115 test_lwn_urls_matched :: Assertion
116 test_lwn_urls_matched =
117 assertEqual "All LWN URLs matched" True (all is_lwn_url lwn_urls)
119 test_http_uris_matched :: Assertion
120 test_http_uris_matched =
121 assertEqual (url ++ " is HTTP") True (http uri)
123 url = "http://lwn.net/Articles/500844/bigpage"
124 uri = fromJust $ parseAbsoluteURI url
126 test_https_uris_matched :: Assertion
127 test_https_uris_matched =
128 assertEqual (url ++ " is HTTPS") True (https uri)
130 url = "https://lwn.net/Articles/500844/bigpage"
131 uri = fromJust $ parseAbsoluteURI url
135 testGroup "URI Tests" [
136 testCase "HTTP URIs matched" test_http_uris_matched,
137 testCase "HTTPS URIs matched" test_https_uris_matched,
138 testCase "LWN URLs matched" test_lwn_urls_matched ]