diff options
author | John MacFarlane <fiddlosopher@gmail.com> | 2013-03-26 08:31:45 -0700 |
---|---|---|
committer | John MacFarlane <fiddlosopher@gmail.com> | 2013-03-26 08:32:02 -0700 |
commit | 727645bc1f4f01a2e3f05a23e550b49e09f0c90c (patch) | |
tree | e72f0da0e365b87f07e6221d721576277ce92044 /src/Text/Pandoc | |
parent | 0ee54549af0d012e60a7a750ebc939799125850e (diff) | |
download | pandoc-727645bc1f4f01a2e3f05a23e550b49e09f0c90c.tar.gz |
Shared: openURL now follows redirects.
Closes #701.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Shared.hs | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 410fd5fcc..4cca80eda 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -100,8 +100,9 @@ import System.IO (stderr) import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), renderOptions) import qualified Data.ByteString as B -import Network.HTTP (findHeader, rspBody, simpleHTTP, RequestMethod(..), - HeaderName(..), mkRequest) +import Network.HTTP (findHeader, rspBody, + RequestMethod(..), HeaderName(..), mkRequest) +import Network.Browser (browse, setAllowRedirects, request) #ifdef EMBED_DATA_FILES import Text.Pandoc.Data (dataFiles) #else @@ -562,12 +563,13 @@ fetchItem sourceDir s = -- chart API, e.g. -- | Read from a URL and return raw data and maybe mime type. openURL :: String -> IO (B.ByteString, Maybe String) -openURL u = getBodyAndMimeType =<< simpleHTTP (getReq u) - where getReq v = case parseURI v of - Nothing -> error $ "Could not parse URI: " ++ v - Just u' -> mkRequest GET u' - getBodyAndMimeType (Left e) = fail (show e) - getBodyAndMimeType (Right r) = return (rspBody r, findHeader HdrContentType r) +openURL u = getBodyAndMimeType `fmap` + browse (setAllowRedirects True >> request (getRequest' u)) + where getBodyAndMimeType (_, r) = (rspBody r, findHeader HdrContentType r) + getRequest' uriString = case parseURI uriString of + Nothing -> error ("Not a valid URL: " ++ + uriString) + Just v -> mkRequest GET v -- -- Error reporting |