Implement URL filename parsing (with tests) and the save_image function.

[dead/lwn-epub.git] / src / LWN / URI.hs

diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs
index 61ea6ca356044a944e18843f45ba9efcb14af114..0d01e1900852c71dce82e7f75c754fb717be9b76 100644 (file)
--- a/src/LWN/URI.hs
+++ b/src/LWN/URI.hs
@@ -2,9 +2,11 @@ module LWN.URI
 where
 
 import Data.Maybe (fromJust)
+import Data.String.Utils (split)
 import Network.URI (
   URI,
   parseAbsoluteURI,
+  parseURIReference,
   uriAuthority,
   uriPath,
   uriPort,
@@ -101,6 +103,23 @@ is_lwn_url s =
     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
+
+
 -- | A List of LWN URLs to use during testing.
 lwn_urls :: [URL]
 lwn_urls = [ proto ++ www ++ "lwn.net" ++ path ++ bigpage ++ query |
@@ -130,9 +149,39 @@ test_https_uris_matched =
     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
+
+
 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 ] ]