module LWN.URI
where
+import Data.List (isSuffixOf)
import Data.Maybe (fromJust)
import Data.String.Utils (split)
import Network.URI (
parse_result = parseURIReference url
+add_trailing_slash :: URL -> URL
+add_trailing_slash url =
+ case parse_result of
+ Nothing -> url -- Shrug?
+ Just uri ->
+ let old_path = uriPath uri in
+ if (isSuffixOf "/" old_path) || (isSuffixOf "bigpage" old_path) then
+ -- It already had a trailing slash, or it's a 'bigpage' URL.
+ -- Trailing slashes after 'bigpage' don't work.
+ url
+ else
+ show $ uri { uriPath = old_path ++ "/" }
+ where
+ parse_result = parseURIReference url
+
+
-- | Does this URI use an HTTPS-compatible port?
https_port :: URI -> Bool
https_port uri =
make_absolute_url :: URL -> Maybe URL
-make_absolute_url relative_url =
+make_absolute_url relative_url =
case parse_result of
Nothing -> Nothing
Just relative_uri ->
actual = fromJust $ make_absolute_url url
+
+test_make_https :: Assertion
+test_make_https =
+ assertEqual "HTTP URL is made HTTPS" expected actual
+ where
+ url = "http://lwn.net/current"
+ expected = "https://lwn.net/current"
+ actual = make_https url
+
+
+test_add_trailing_slash :: Assertion
+test_add_trailing_slash =
+ assertEqual "Trailing slashes get added" expected actual
+ where
+ url = "https://lwn.net/current"
+ expected = "https://lwn.net/current/"
+ actual = add_trailing_slash url
+
+
uri_tests :: Test
uri_tests =
testGroup "URI Tests" [
testGroup "Relative -> Absolute Conversion" [
testCase "Empty URL converted to lwn.net" test_empty_url_conversion,
- testCase "Normal URL made absolute" test_normal_url_conversion ]]
+ testCase "Normal URL made absolute" test_normal_url_conversion ],
+
+ testGroup "URL Mangling" [
+ testCase "HTTP URLs are made HTTPS" test_make_https,
+ testCase "Trailing slashes get added" test_add_trailing_slash ]
+ ]