X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FURI.hs;h=0d01e1900852c71dce82e7f75c754fb717be9b76;hp=61ea6ca356044a944e18843f45ba9efcb14af114;hb=79eb04e3c84bd9514659d0d52c2e862959647aa6;hpb=9f02494ae1d2b23c3e5b2c7bae63328c0702ff21 diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs index 61ea6ca..0d01e19 100644 --- 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 ] ]