Implement image download and replacement.

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

diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs
index 5b8d8fab993363c320956595f2f9e0f1cd6c7449..9e7c7d944963a0a52b51b2b6b48aeb48ef57373d 100644 (file)
--- a/src/LWN/URI.hs
+++ b/src/LWN/URI.hs
@@ -5,10 +5,11 @@ import Data.Maybe (fromJust)
 import Data.String.Utils (split)
 import Network.URI (
   URI(..),
+  URIAuth(..),
   parseAbsoluteURI,
   parseURIReference,
   relativeTo,
-  uriRegName,
+  uriRegName
   )
 import Test.HUnit (Assertion, assertEqual)
 import Test.Framework (Test, testGroup)
@@ -111,7 +112,7 @@ filename url =
       let reverse_components = reverse components in
       case reverse_components of
         []     -> Nothing
-        (x:xs) -> Just x
+        (x:_) -> Just x
   where
     parse_result = parseURIReference url
 
@@ -121,8 +122,11 @@ make_absolute_uri :: URI -> Maybe URI
 make_absolute_uri relative_uri =
   relativeTo relative_uri base_uri
   where
-    base_uri = URI { uriScheme = "https://",
-                     uriAuthority = "lwn.net",
+    base_auth = URIAuth { uriUserInfo = "",
+                          uriRegName = "lwn.net",
+                          uriPort = "" }
+    base_uri = URI { uriScheme = "https:",
+                     uriAuthority = Just base_auth,
                      uriPath = "/",
                      uriQuery = "",
                      uriFragment = "" }
@@ -136,11 +140,17 @@ make_absolute_url relative_url =
       let abs_result = make_absolute_uri relative_uri in
       case abs_result of
         Nothing -> Nothing
-        Just abs_uri -> show abs_uri
+        Just abs_uri -> Just $ show abs_uri
   where
-    parse_result = parseURIReference url
-
+    parse_result = parseURIReference relative_url
 
+-- | Like 'make_absolute_url', except returns its input instead of
+--   'Nothing' if the absolution fails.
+try_make_absolute_url :: URL -> URL
+try_make_absolute_url url =
+  case make_absolute_url url of
+    Nothing -> url
+    Just abs_url -> abs_url
 
 -- | A List of LWN URLs to use during testing.
 lwn_urls :: [URL]