99be906 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Added PandocHttpException, trap exceptions in fetching from URLs.

99be906John MacFarlane10 years ago

src/Text/Pandoc/App.hs+13−4

compare with master

unifiedsplit

@@ -376,7 +376,7 @@ convertWithOpts opts = do

376 then 0

377 else optTabStop opts)

378

379− readSources :: (Functor m, MonadIO m) => [FilePath] -> m String

379+ readSources :: [FilePath] -> PandocIO String

380 readSources srcs = convertTabs . intercalate "\n" <$>

381 mapM readSource srcs

382

@@ -751,6 +751,11 @@ fillMedia sourceURL d = walkM handleImage d

751 "replacing image with description"

752 -- emit alt text

753 return $ Span ("",["image"],[]) lab

754+ PandocHttpError u er -> do

755+ report $ CouldNotFetchResource u

756+ (show er ++ "\rReplacing image with description.")

757+ -- emit alt text

758+ return $ Span ("",["image"],[]) lab

754 _ -> throwError e)

759 _ -> throwError e)

755 handleImage x = return x

760 handleImage x = return x

756

761

@@ -800,7 +805,7 @@ applyFilters mbDatadir filters args d = do

800 expandedFilters <- mapM (expandFilterPath mbDatadir) filters

805 expandedFilters <- mapM (expandFilterPath mbDatadir) filters

801 foldrM ($) d $ map (flip externalFilter args) expandedFilters

806 foldrM ($) d $ map (flip externalFilter args) expandedFilters

802

807

803−readSource :: MonadIO m => FilePath -> m String

808+readSource :: FilePath -> PandocIO String

804readSource "-" = liftIO UTF8.getContents

809readSource "-" = liftIO UTF8.getContents

805readSource src = case parseURI src of

810readSource src = case parseURI src of

806 Just u | uriScheme u `elem` ["http:","https:"] ->

811 Just u | uriScheme u `elem` ["http:","https:"] ->

@@ -809,8 +814,12 @@ readSource src = case parseURI src of

809 liftIO $ UTF8.readFile (uriPath u)

814 liftIO $ UTF8.readFile (uriPath u)

810 _ -> liftIO $ UTF8.readFile src

815 _ -> liftIO $ UTF8.readFile src

811

816

812−readURI :: MonadIO m => FilePath -> m String

817+readURI :: FilePath -> PandocIO String

813−readURI src = liftIO $ (UTF8.toString . fst) <$> openURL src

818+readURI src = do

819+ res <- liftIO $ openURL src

820+ case res of

821+ Left e -> throwError $ PandocHttpError src e

822+ Right (contents, _) -> return $ UTF8.toString contents

814

823

815readFile' :: MonadIO m => FilePath -> m B.ByteString

824readFile' :: MonadIO m => FilePath -> m B.ByteString

816readFile' "-" = liftIO B.getContents

825readFile' "-" = liftIO B.getContents

src/Text/Pandoc/Class.hs+4−1

@@ -242,7 +242,10 @@ instance PandocMonad PandocIO where

242 newUniqueHash = hashUnique <$> (liftIO IO.newUnique)

243 openURL u = do

244 report $ Fetching u

245− liftIOError IO.openURL u

245+ res <- liftIO (IO.openURL u)

246+ case res of

247+ Right r -> return r

248+ Left e -> throwError $ PandocHttpError u e

246 readFileLazy s = liftIOError BL.readFile s

249 readFileLazy s = liftIOError BL.readFile s

247 readFileStrict s = liftIOError B.readFile s

250 readFileStrict s = liftIOError B.readFile s

248 readDataFile mfp fname = liftIOError (IO.readDataFile mfp) fname

251 readDataFile mfp fname = liftIOError (IO.readDataFile mfp) fname

src/Text/Pandoc/Error.hs+4

@@ -42,10 +42,12 @@ import Text.Parsec.Pos hiding (Line)

42import qualified Text.Pandoc.UTF8 as UTF8

43import System.Exit (exitWith, ExitCode(..))

44import System.IO (stderr)

45+import Network.HTTP.Client (HttpException)

46type Input = String

47type Input = String

48data PandocError = PandocIOError String IOError

49data PandocError = PandocIOError String IOError

50+ | PandocHttpError String HttpException

49 | PandocShouldNeverHappenError String

51 | PandocShouldNeverHappenError String

50 | PandocSomeError String

52 | PandocSomeError String

51 | PandocParseError String

53 | PandocParseError String

@@ -70,6 +72,8 @@ handleError (Right r) = return r

70handleError (Left e) =

72handleError (Left e) =

71 case e of

73 case e of

72 PandocIOError _ err' -> ioError err'

74 PandocIOError _ err' -> ioError err'

75+ PandocHttpError u err' -> err 61 $

76+ "Could not fetch " ++ u ++ "\n" ++ show err'

73 PandocShouldNeverHappenError s -> err 62 s

77 PandocShouldNeverHappenError s -> err 62 s

74 PandocSomeError s -> err 63 s

78 PandocSomeError s -> err 63 s

75 PandocParseError s -> err 64 s

79 PandocParseError s -> err 64 s

src/Text/Pandoc/Shared.hs+5−4

@@ -141,7 +141,8 @@ import Text.Pandoc.Data (dataFiles)

141import Paths_pandoc (getDataFileName)

142#endif

143import Network.HTTP.Client (httpLbs, responseBody, responseHeaders,

144− Request(port,host,requestHeaders))

144+ Request(port,host,requestHeaders),

145+ HttpException)

145import Network.HTTP.Client (parseRequest)

146import Network.HTTP.Client (parseRequest)

146import Network.HTTP.Client (newManager)

147import Network.HTTP.Client (newManager)

147import Network.HTTP.Client.Internal (addProxy)

148import Network.HTTP.Client.Internal (addProxy)

@@ -702,13 +703,13 @@ readDataFileUTF8 userDir fname =

702 UTF8.toString `fmap` readDataFile userDir fname

703 UTF8.toString `fmap` readDataFile userDir fname

703

704

704-- | Read from a URL and return raw data and maybe mime type.

705-- | Read from a URL and return raw data and maybe mime type.

705−openURL :: String -> IO (BS.ByteString, Maybe MimeType)

706+openURL :: String -> IO (Either HttpException (BS.ByteString, Maybe MimeType))

706openURL u

707openURL u

707 | Just u'' <- stripPrefix "data:" u =

708 | Just u'' <- stripPrefix "data:" u =

708 let mime = takeWhile (/=',') u''

709 let mime = takeWhile (/=',') u''

709 contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u''

710 contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u''

710− in return (decodeLenient contents, Just mime)

711+ in return $ Right (decodeLenient contents, Just mime)

711− | otherwise = withSocketsDo $ do

712+ | otherwise = E.try $ withSocketsDo $ do

712 let parseReq = parseRequest

713 let parseReq = parseRequest

713 (proxy :: Either IOError String) <-

714 (proxy :: Either IOError String) <-

714 tryIOError $ getEnv "http_proxy"

715 tryIOError $ getEnv "http_proxy"