aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/App.hs17
-rw-r--r--src/Text/Pandoc/Class.hs5
-rw-r--r--src/Text/Pandoc/Error.hs4
-rw-r--r--src/Text/Pandoc/Shared.hs9
4 files changed, 26 insertions, 9 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 2efa69944..a1691c5e2 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -376,7 +376,7 @@ convertWithOpts opts = do
then 0
else optTabStop opts)
- readSources :: (Functor m, MonadIO m) => [FilePath] -> m String
+ readSources :: [FilePath] -> PandocIO String
readSources srcs = convertTabs . intercalate "\n" <$>
mapM readSource srcs
@@ -751,6 +751,11 @@ fillMedia sourceURL d = walkM handleImage d
"replacing image with description"
-- emit alt text
return $ Span ("",["image"],[]) lab
+ PandocHttpError u er -> do
+ report $ CouldNotFetchResource u
+ (show er ++ "\rReplacing image with description.")
+ -- emit alt text
+ return $ Span ("",["image"],[]) lab
_ -> throwError e)
handleImage x = return x
@@ -800,7 +805,7 @@ applyFilters mbDatadir filters args d = do
expandedFilters <- mapM (expandFilterPath mbDatadir) filters
foldrM ($) d $ map (flip externalFilter args) expandedFilters
-readSource :: MonadIO m => FilePath -> m String
+readSource :: FilePath -> PandocIO String
readSource "-" = liftIO UTF8.getContents
readSource src = case parseURI src of
Just u | uriScheme u `elem` ["http:","https:"] ->
@@ -809,8 +814,12 @@ readSource src = case parseURI src of
liftIO $ UTF8.readFile (uriPath u)
_ -> liftIO $ UTF8.readFile src
-readURI :: MonadIO m => FilePath -> m String
-readURI src = liftIO $ (UTF8.toString . fst) <$> openURL src
+readURI :: FilePath -> PandocIO String
+readURI src = do
+ res <- liftIO $ openURL src
+ case res of
+ Left e -> throwError $ PandocHttpError src e
+ Right (contents, _) -> return $ UTF8.toString contents
readFile' :: MonadIO m => FilePath -> m B.ByteString
readFile' "-" = liftIO B.getContents
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index ad9901125..939e0bd18 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -242,7 +242,10 @@ instance PandocMonad PandocIO where
newUniqueHash = hashUnique <$> (liftIO IO.newUnique)
openURL u = do
report $ Fetching u
- liftIOError IO.openURL u
+ res <- liftIO (IO.openURL u)
+ case res of
+ Right r -> return r
+ Left e -> throwError $ PandocHttpError u e
readFileLazy s = liftIOError BL.readFile s
readFileStrict s = liftIOError B.readFile s
readDataFile mfp fname = liftIOError (IO.readDataFile mfp) fname
diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs
index a6db5e047..9b3f1b902 100644
--- a/src/Text/Pandoc/Error.hs
+++ b/src/Text/Pandoc/Error.hs
@@ -42,10 +42,12 @@ import Text.Parsec.Pos hiding (Line)
import qualified Text.Pandoc.UTF8 as UTF8
import System.Exit (exitWith, ExitCode(..))
import System.IO (stderr)
+import Network.HTTP.Client (HttpException)
type Input = String
data PandocError = PandocIOError String IOError
+ | PandocHttpError String HttpException
| PandocShouldNeverHappenError String
| PandocSomeError String
| PandocParseError String
@@ -70,6 +72,8 @@ handleError (Right r) = return r
handleError (Left e) =
case e of
PandocIOError _ err' -> ioError err'
+ PandocHttpError u err' -> err 61 $
+ "Could not fetch " ++ u ++ "\n" ++ show err'
PandocShouldNeverHappenError s -> err 62 s
PandocSomeError s -> err 63 s
PandocParseError s -> err 64 s
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 44a26509b..0ebaf0f89 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -141,7 +141,8 @@ import Text.Pandoc.Data (dataFiles)
import Paths_pandoc (getDataFileName)
#endif
import Network.HTTP.Client (httpLbs, responseBody, responseHeaders,
- Request(port,host,requestHeaders))
+ Request(port,host,requestHeaders),
+ HttpException)
import Network.HTTP.Client (parseRequest)
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.Internal (addProxy)
@@ -702,13 +703,13 @@ readDataFileUTF8 userDir fname =
UTF8.toString `fmap` readDataFile userDir fname
-- | Read from a URL and return raw data and maybe mime type.
-openURL :: String -> IO (BS.ByteString, Maybe MimeType)
+openURL :: String -> IO (Either HttpException (BS.ByteString, Maybe MimeType))
openURL u
| Just u'' <- stripPrefix "data:" u =
let mime = takeWhile (/=',') u''
contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u''
- in return (decodeLenient contents, Just mime)
- | otherwise = withSocketsDo $ do
+ in return $ Right (decodeLenient contents, Just mime)
+ | otherwise = E.try $ withSocketsDo $ do
let parseReq = parseRequest
(proxy :: Either IOError String) <-
tryIOError $ getEnv "http_proxy"