X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FURI.hs;h=7a0a41f026a893881d90b546743e6624ede117c7;hp=3a21413dbf3feab89967ada01da9e13c9bb61531;hb=HEAD;hpb=03360100f3375abab128144b0851d043a96bacbc diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs index 3a21413..7a0a41f 100644 --- a/src/LWN/URI.hs +++ b/src/LWN/URI.hs @@ -54,15 +54,16 @@ make_https url = 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 then - url -- It already had a trailing slash + 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 @@ -130,6 +131,7 @@ is_lwn_url s = +-- Bug here, doesn't work on unicode paths! filename :: URL -> Maybe String filename url = case parse_result of @@ -147,7 +149,7 @@ filename url = -make_absolute_uri :: URI -> Maybe URI +make_absolute_uri :: URI -> URI make_absolute_uri relative_uri = relativeTo relative_uri base_uri where @@ -162,14 +164,11 @@ make_absolute_uri relative_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 -> - let abs_result = make_absolute_uri relative_uri in - case abs_result of - Nothing -> Nothing - Just abs_uri -> Just $ show abs_uri + Just $ show $ make_absolute_uri relative_uri where parse_result = parseURIReference relative_url