diff options
| -rw-r--r-- | src/Text/Pandoc/App.hs | 17 | ||||
| -rw-r--r-- | src/Text/Pandoc/Class.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Error.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Shared.hs | 9 |
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" |