where
import Data.Maybe (fromJust)
+import Data.String.Utils (split)
import Network.URI (
- URI,
+ URI(..),
+ URIAuth(..),
parseAbsoluteURI,
- uriAuthority,
- uriPath,
- uriPort,
- uriQuery,
- uriRegName,
- uriScheme
+ parseURIReference,
+ relativeTo,
+ uriRegName
)
import Test.HUnit (Assertion, assertEqual)
import Test.Framework (Test, testGroup)
parse_result = parseAbsoluteURI s
+
+filename :: URL -> Maybe String
+filename url =
+ case parse_result of
+ Nothing -> Nothing
+ Just uri ->
+ let components = split "/" (uriPath uri) in
+ -- Reverse them so that the filename comes first for easier
+ -- pattern-matching.
+ let reverse_components = reverse components in
+ case reverse_components of
+ [] -> Nothing
+ (x:xs) -> Just x
+ where
+ parse_result = parseURIReference url
+
+
+
+make_absolute_uri :: URI -> Maybe URI
+make_absolute_uri relative_uri =
+ relativeTo relative_uri base_uri
+ where
+ base_auth = URIAuth { uriUserInfo = "",
+ uriRegName = "lwn.net",
+ uriPort = "" }
+ base_uri = URI { uriScheme = "https:",
+ uriAuthority = Just base_auth,
+ uriPath = "/",
+ uriQuery = "",
+ uriFragment = "" }
+
+
+make_absolute_url :: URL -> Maybe URL
+make_absolute_url relative_url =
+ case parse_result of
+ Nothing -> Nothing
+ Just relative_uri ->
+ let abs_result = make_absolute_uri relative_uri in
+ case abs_result of
+ Nothing -> Nothing
+ Just abs_uri -> Just $ show abs_uri
+ where
+ parse_result = parseURIReference relative_url
+
+
+
-- | A List of LWN URLs to use during testing.
lwn_urls :: [URL]
lwn_urls = [ proto ++ www ++ "lwn.net" ++ path ++ bigpage ++ query |
url = "https://lwn.net/Articles/500844/bigpage"
uri = fromJust $ parseAbsoluteURI url
+
+test_bare_filename_parsed :: Assertion
+test_bare_filename_parsed =
+ assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
+ where
+ url = "example.jpg"
+ actual_result = fromJust $ filename url
+
+test_absolute_filename_parsed :: Assertion
+test_absolute_filename_parsed =
+ assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
+ where
+ url = "http://lwn.net/one/two/example.jpg"
+ actual_result = fromJust $ filename url
+
+test_relative_filename_parsed :: Assertion
+test_relative_filename_parsed =
+ assertEqual "Filename is 'example.jpg'" "example.jpg" actual_result
+ where
+ url = "/one/two/example.jpg"
+ actual_result = fromJust $ filename url
+
+
+test_empty_url_conversion :: Assertion
+test_empty_url_conversion =
+ assertEqual "'' converted to lwn.net" expected actual
+ where
+ expected = "https://lwn.net/"
+ actual = fromJust $ make_absolute_url ""
+
+
+test_normal_url_conversion :: Assertion
+test_normal_url_conversion =
+ assertEqual "Image URL is made absolute" expected actual
+ where
+ url = "/images/2012/lcj-coughlan-lattimer-sm.jpg"
+ expected = "https://lwn.net/images/2012/lcj-coughlan-lattimer-sm.jpg"
+ actual = fromJust $ make_absolute_url url
+
+
uri_tests :: Test
uri_tests =
testGroup "URI Tests" [
- testCase "HTTP URIs matched" test_http_uris_matched,
- testCase "HTTPS URIs matched" test_https_uris_matched,
- testCase "LWN URLs matched" test_lwn_urls_matched ]
+
+ testGroup "URI Matching" [
+ testCase "HTTP URIs matched" test_http_uris_matched,
+ testCase "HTTPS URIs matched" test_https_uris_matched,
+ testCase "LWN URLs matched" test_lwn_urls_matched ],
+
+ testGroup "Filename Parsing" [
+ testCase "Bare filename parsed" test_bare_filename_parsed,
+ testCase "Absolute filename parsed" test_absolute_filename_parsed,
+ testCase "Relative filename parsed" test_relative_filename_parsed ],
+
+ testGroup "Relative -> Absolute Conversion" [
+ testCase "Empty URL converted to lwn.net" test_empty_url_conversion,
+ testCase "Normal URL made absolute" test_normal_url_conversion ]]