6aff97e · typeable/pandoc

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

@@ -49,8 +49,7 @@ import Data.Maybe (fromMaybe)

4949import qualified Text.Pandoc.UTF8 as UTF8

5050import Text.Pandoc.Definition

5151import Text.Pandoc.Walk (walkM)

52−import Text.Pandoc.Shared (fetchItem', warn, withTempDir, inDirectory,

53− stringify)

52+import Text.Pandoc.Shared (warn, withTempDir, inDirectory, stringify)

5453import Text.Pandoc.Writers.Shared (getField, metaToJSON)

5554import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..))

5655import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)

@@ -61,7 +60,7 @@ import qualified Codec.Picture as JP

6160#ifdef _WINDOWS

6261import Data.List (intercalate)

6362#endif

64−import Text.Pandoc.Class (PandocIO, runIOorExplode)

63+import Text.Pandoc.Class (PandocIO, runIOorExplode, fetchItem, setMediaBag, runIO)

6564

6665#ifdef _WINDOWS

6766changePathSeparators :: FilePath -> FilePath

@@ -123,7 +122,9 @@ handleImage' opts tmpdir (Image attr ils (src,tit)) = do

123122 if exists

124123 then return $ Image attr ils (src,tit)

125124 else do

126− res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

125+ res <- runIO $ do

126+ setMediaBag $ writerMediaBag opts

127+ fetchItem (writerSourceURL opts) src

127128 case res of

128129 Right (contents, Just mime) -> do

129130 let ext = fromMaybe (takeExtension src) $

src/Text/Pandoc/SelfContained.hs+4−2

@@ -41,7 +41,7 @@ import Data.Char (toLower, isAscii, isAlphaNum)

4141import Codec.Compression.GZip as Gzip

4242import qualified Data.ByteString.Lazy as L

4343import Control.Monad.Trans (MonadIO(..))

44−import Text.Pandoc.Shared (renderTags', err, fetchItem', warn, trim)

44+import Text.Pandoc.Shared (renderTags', err, warn, trim)

4545import Text.Pandoc.MediaBag (MediaBag)

4646import Text.Pandoc.MIME (MimeType)

4747import Text.Pandoc.UTF8 (toString)

@@ -51,6 +51,7 @@ import Control.Applicative ((<|>))

5151import Text.Parsec (runParserT, ParsecT)

5252import qualified Text.Parsec as P

5353import Control.Monad.Trans (lift)

54+import Text.Pandoc.Class (fetchItem, runIO, setMediaBag)

5455

5556isOk :: Char -> Bool

5657isOk c = isAscii c && isAlphaNum c

@@ -144,7 +145,8 @@ getDataURI :: MediaBag -> Maybe String -> MimeType -> String

144145getDataURI _ _ _ src@('d':'a':'t':'a':':':_) = return src -- already data: uri

145146getDataURI media sourceURL mimetype src = do

146147 let ext = map toLower $ takeExtension src

147− fetchResult <- fetchItem' media sourceURL src

148+ fetchResult <- runIO $ do setMediaBag media

149+ fetchItem sourceURL src

148150 (raw, respMime) <- case fetchResult of

149151 Left msg -> err 67 $ "Could not fetch " ++ src ++

150152 "\n" ++ show msg

src/Text/Pandoc/Shared.hs+3−66

@@ -79,8 +79,6 @@ module Text.Pandoc.Shared (

7979 getDefaultReferenceODT,

8080 readDataFile,

8181 readDataFileUTF8,

82− fetchItem,

83− fetchItem',

8482 openURL,

8583 collapseFilePath,

8684 filteredFilesFromArchive,

@@ -100,7 +98,6 @@ module Text.Pandoc.Shared (

10098

10199import Text.Pandoc.Definition

102100import Text.Pandoc.Walk

103−import Text.Pandoc.MediaBag (MediaBag, lookupMedia)

104101import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))

105102import qualified Text.Pandoc.Builder as B

106103import qualified Text.Pandoc.UTF8 as UTF8

@@ -111,15 +108,13 @@ import Data.List ( find, stripPrefix, intercalate )

111108import Data.Maybe (mapMaybe)

112109import Data.Version ( showVersion )

113110import qualified Data.Map as M

114−import Network.URI ( escapeURIString, nonStrictRelativeTo,

115− unEscapeString, parseURIReference, isAllowedInURI,

116− parseURI, URI(..) )

111+import Network.URI ( escapeURIString, unEscapeString )

117112import qualified Data.Set as Set

118113import System.Directory

119114import System.FilePath (splitDirectories, isPathSeparator)

120115import qualified System.FilePath.Posix as Posix

121−import Text.Pandoc.MIME (MimeType, getMimeType)

122−import System.FilePath ( (</>), takeExtension, dropExtension)

116+import Text.Pandoc.MIME (MimeType)

117+import System.FilePath ( (</>) )

123118import Data.Generics (Typeable, Data)

124119import qualified Control.Monad.State as S

125120import Control.Monad.Trans (MonadIO (..))

@@ -752,64 +747,6 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String

752747readDataFileUTF8 userDir fname =

753748 UTF8.toString `fmap` readDataFile userDir fname

754749

755−-- | Specialized version of parseURIReference that disallows

756−-- single-letter schemes. Reason: these are usually windows absolute

757−-- paths.

758−parseURIReference' :: String -> Maybe URI

759−parseURIReference' s =

760− case parseURIReference s of

761− Just u

762− | length (uriScheme u) > 2 -> Just u

763− | null (uriScheme u) -> Just u -- protocol-relative

764− _ -> Nothing

765−

766−-- | Fetch an image or other item from the local filesystem or the net.

767−-- Returns raw content and maybe mime type.

768−fetchItem :: Maybe String -> String

769− -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

770−fetchItem sourceURL s =

771− case (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped s) of

772− (Just u, s') -> -- try fetching from relative path at source

773− case parseURIReference' s' of

774− Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u

775− Nothing -> openURL s' -- will throw error

776− (Nothing, s'@('/':'/':_)) -> -- protocol-relative URI

777− case parseURIReference' s' of

778− Just u' -> openURL $ show $ u' `nonStrictRelativeTo` httpcolon

779− Nothing -> openURL s' -- will throw error

780− (Nothing, s') ->

781− case parseURI s' of -- requires absolute URI

782− -- We don't want to treat C:/ as a scheme:

783− Just u' | length (uriScheme u') > 2 -> openURL (show u')

784− Just u' | uriScheme u' == "file:" ->

785− E.try $ readLocalFile $ dropWhile (=='/') (uriPath u')

786− _ -> E.try $ readLocalFile fp -- get from local file system

787− where readLocalFile f = do

788− cont <- BS.readFile f

789− return (cont, mime)

790− httpcolon = URI{ uriScheme = "http:",

791− uriAuthority = Nothing,

792− uriPath = "",

793− uriQuery = "",

794− uriFragment = "" }

795− dropFragmentAndQuery = takeWhile (\c -> c /= '?' && c /= '#')

796− fp = unEscapeString $ dropFragmentAndQuery s

797− mime = case takeExtension fp of

798− ".gz" -> getMimeType $ dropExtension fp

799− ".svgz" -> getMimeType $ dropExtension fp ++ ".svg"

800− x -> getMimeType x

801− ensureEscaped = escapeURIString isAllowedInURI . map convertSlash

802− convertSlash '\\' = '/'

803− convertSlash x = x

804−

805−-- | Like 'fetchItem', but also looks for items in a 'MediaBag'.

806−fetchItem' :: MediaBag -> Maybe String -> String

807− -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

808−fetchItem' media sourceURL s = do

809− case lookupMedia s media of

810− Nothing -> fetchItem sourceURL s

811− Just (mime, bs) -> return $ Right (BS.concat $ toChunks bs, Just mime)

812−

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

814751openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

815752openURL u

src/Text/Pandoc/Writers/Docx.hs+5−4

@@ -48,6 +48,7 @@ import Text.Pandoc.Options

4848import Text.Pandoc.Writers.Math

4949import Text.Pandoc.Highlighting ( highlight )

5050import Text.Pandoc.Walk

51+import Text.Pandoc.Error (PandocError)

5152import Text.XML.Light as XML

5253import Text.TeXMath

5354import Text.Pandoc.Readers.Docx.StyleMap

@@ -55,9 +56,9 @@ import Text.Pandoc.Readers.Docx.Util (elemName)

5556import Control.Monad.Reader

5657import Control.Monad.State

5758import Skylighting

59+import Control.Monad.Except (runExceptT)

5860import System.Random (randomR)

5961import Text.Printf (printf)

60−import qualified Control.Exception as E

6162import Data.Monoid ((<>))

6263import qualified Data.Text as T

6364import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,

@@ -1180,10 +1181,10 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do

11801181 case M.lookup src imgs of

11811182 Just (_,_,_,elt,_) -> return [elt]

11821183 Nothing -> do

1183− res <- (lift . lift) $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

1184+ res <- runExceptT $ lift (P.fetchItem (writerSourceURL opts) src)

11841185 case res of

1185− Left (_ :: E.SomeException) -> do

1186− (lift . lift) $ P.warning ("Could not find image `" ++ src ++ "', skipping...")

1186+ Left (_ :: PandocError) -> do

1187+ P.warning ("Could not find image `" ++ src ++ "', skipping...")

11871188 -- emit alt text

11881189 inlinesToOpenXML opts alt

11891190 Right (img, mt) -> do

src/Text/Pandoc/Writers/EPUB.hs+15−18

@@ -64,7 +64,7 @@ import Data.Char ( toLower, isDigit, isAlphaNum )

6464import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)

6565import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

6666import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)

67−import Control.Monad.Except (throwError)

67+import Control.Monad.Except (throwError, catchError)

6868import Text.Pandoc.Error

6969import Text.Pandoc.Class (PandocMonad)

7070import qualified Text.Pandoc.Class as P

@@ -858,23 +858,20 @@ modifyMediaRef opts oldsrc = do

858858 media <- gets stMediaPaths

859859 case lookup oldsrc media of

860860 Just (n,_) -> return n

861− Nothing -> do

862− res <- lift $ P.fetchItem' (writerMediaBag opts)

863− (writerSourceURL opts) oldsrc

864− (new, mbEntry) <-

865− case res of

866− Left _ -> do

867− lift $ P.warning $ "Could not find media `" ++ oldsrc ++ "', skipping..."

868− return (oldsrc, Nothing)

869− Right (img,mbMime) -> do

870− let new = "media/file" ++ show (length media) ++

871− fromMaybe (takeExtension (takeWhile (/='?') oldsrc))

872− (('.':) <$> (mbMime >>= extensionFromMimeType))

873− epochtime <- floor `fmap` lift P.getPOSIXTime

874− let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img

875− return (new, Just entry)

876− modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}

877− return new

861+ Nothing -> catchError

862+ (do (img, mbMime) <- P.fetchItem (writerSourceURL opts) oldsrc

863+ let new = "media/file" ++ show (length media) ++

864+ fromMaybe (takeExtension (takeWhile (/='?') oldsrc))

865+ (('.':) <$> (mbMime >>= extensionFromMimeType))

866+ epochtime <- floor `fmap` lift P.getPOSIXTime

867+ let entry = toEntry new epochtime $ B.fromChunks . (:[]) $ img

868+ modify $ \st -> st{ stMediaPaths =

869+ (oldsrc, (new, Just entry)):media}

870+ return new)

871+ (\e -> do

872+ P.warning $ "Could not find media `" ++ oldsrc ++

873+ "', skipping...\n" ++ show e

874+ return oldsrc)

878875

879876transformBlock :: PandocMonad m

880877 => WriterOptions

src/Text/Pandoc/Writers/FB2.hs+13−5

@@ -39,7 +39,7 @@ import Text.XML.Light

3939import qualified Text.XML.Light as X

4040import qualified Text.XML.Light.Cursor as XC

4141import qualified Data.ByteString.Char8 as B8

42−import Control.Monad.Except (throwError)

42+import Control.Monad.Except (throwError, catchError)

4343

4444

4545import Text.Pandoc.Definition

@@ -241,10 +241,18 @@ fetchImage href link = do

241241 else return Nothing

242242 (True, Just _) -> return Nothing -- not base64-encoded

243243 _ -> do

244− response <- P.fetchItem Nothing link

245− case response of

246− Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs)

247− _ -> return $ Nothing

244+ catchError (do (bs, mbmime) <- P.fetchItem Nothing link

245+ case mbmime of

246+ Nothing -> do

247+ P.warning ("Could not determine mime type for "

248+ ++ link)

249+ return Nothing

250+ Just mime -> return $ Just (mime,

251+ B8.unpack $ encode bs))

252+ (\e ->

253+ do P.warning ("Could not fetch " ++ link ++

254+ ":\n" ++ show e)

255+ return Nothing)

248256 case mbimg of

249257 Just (imgtype, imgdata) -> do

250258 return . Right $ el "binary"

src/Text/Pandoc/Writers/ICML.hs+5−3

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

1+{-# LANGUAGE OverloadedStrings, FlexibleContexts, ScopedTypeVariables #-}

22

33{- |

44 Module : Text.Pandoc.Writers.ICML

@@ -15,6 +15,7 @@ into InDesign with File -> Place.

1515-}

1616module Text.Pandoc.Writers.ICML (writeICML) where

1717import Text.Pandoc.Definition

18+import Text.Pandoc.Error (PandocError)

1819import Text.Pandoc.XML

1920import Text.Pandoc.Writers.Math (texMathToInlines)

2021import Text.Pandoc.Writers.Shared

@@ -26,6 +27,7 @@ import Text.Pandoc.ImageSize

2627import Data.List (isPrefixOf, isInfixOf, stripPrefix, intersperse)

2728import Data.Text as Text (breakOnAll, pack)

2829import Control.Monad.State

30+import Control.Monad.Except (runExceptT)

2931import Network.URI (isURI)

3032import qualified Data.Set as Set

3133import Text.Pandoc.Class (PandocMonad)

@@ -534,9 +536,9 @@ styleToStrAttr style =

534536-- | Assemble an ICML Image.

535537imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc

536538imageICML opts style attr (src, _) = do

537− res <- lift $ P.fetchItem (writerSourceURL opts) src

539+ res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src

538540 imgS <- case res of

539− Left (_) -> do

541+ Left (_ :: PandocError) -> do

540542 lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..."

541543 return def

542544 Right (img, _) -> do

src/Text/Pandoc/Writers/ODT.hs+4−3

@@ -45,9 +45,10 @@ import Text.Pandoc.Walk

4545import Text.Pandoc.Writers.Shared ( fixDisplayMath )

4646import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )

4747import Control.Monad.State

48+import Control.Monad.Except (runExceptT)

49+import Text.Pandoc.Error (PandocError)

4850import Text.Pandoc.XML

4951import Text.Pandoc.Pretty

50−import qualified Control.Exception as E

5152import System.FilePath ( takeExtension, takeDirectory, (<.>))

5253import Text.Pandoc.Class ( PandocMonad )

5354import qualified Text.Pandoc.Class as P

@@ -145,9 +146,9 @@ pandocToODT opts doc@(Pandoc meta _) = do

145146-- | transform both Image and Math elements

146147transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline

147148transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do

148− res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

149+ res <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src

149150 case res of

150− Left (_ :: E.SomeException) -> do

151+ Left (_ :: PandocError) -> do

151152 lift $ P.warning $ "Could not find image `" ++ src ++ "', skipping..."

152153 return $ Emph lab

153154 Right (img, mbMimeType) -> do

src/Text/Pandoc/Writers/RTF.hs+4−3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12{-

34

@@ -43,7 +44,7 @@ import qualified Data.ByteString as B

4344import qualified Data.Map as M

4445import Text.Printf ( printf )

4546import Text.Pandoc.ImageSize

46−import Control.Monad.Except (throwError)

47+import Control.Monad.Except (throwError, runExceptT, lift)

4748import Text.Pandoc.Error

4849import Text.Pandoc.Class (PandocMonad)

4950import qualified Text.Pandoc.Class as P

@@ -53,7 +54,7 @@ import qualified Text.Pandoc.Class as P

5354-- If file not found or filetype not jpeg or png, leave the inline unchanged.

5455rtfEmbedImage :: PandocMonad m => WriterOptions -> Inline -> m Inline

5556rtfEmbedImage opts x@(Image attr _ (src,_)) = do

56− result <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src

57+ result <- runExceptT $ lift $ P.fetchItem (writerSourceURL opts) src

5758 case result of

5859 Right (imgdata, Just mime)

5960 | mime == "image/jpeg" || mime == "image/png" -> do

@@ -87,7 +88,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do

8788 Right (_, Nothing) -> do

8889 warning $ "Could not determine image type for " ++ src ++ ", skipping."

8990 return x

90− Left e -> do

91+ Left ( e :: PandocError ) -> do

9192 warning $ "Could not fetch image " ++ src ++ "\n" ++ show e

9293 return x

9394rtfEmbedImage _ x = return x