6aff97e · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Text.Pandoc.Shared: Removed fetchItem, fetchItem'.

6aff97eJohn MacFarlane10 years ago

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

compare with master

unifiedsplit

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

49import qualified Text.Pandoc.UTF8 as UTF8

50import Text.Pandoc.Definition

51import Text.Pandoc.Walk (walkM)

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

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

53− stringify)

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

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

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

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

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

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

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

61#ifdef _WINDOWS

60#ifdef _WINDOWS

62import Data.List (intercalate)

61import Data.List (intercalate)

63#endif

62#endif

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

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

66#ifdef _WINDOWS

65#ifdef _WINDOWS

67changePathSeparators :: FilePath -> FilePath

66changePathSeparators :: FilePath -> FilePath

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

123 if exists

122 if exists

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

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

125 else do

124 else do

125+ res <- runIO $ do

126+ setMediaBag $ writerMediaBag opts

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

127+ fetchItem (writerSourceURL opts) src

127 case res of

128 case res of

128 Right (contents, Just mime) -> do

129 Right (contents, Just mime) -> do

129 let ext = fromMaybe (takeExtension src) $

130 let ext = fromMaybe (takeExtension src) $

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

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

41import Codec.Compression.GZip as Gzip

42import qualified Data.ByteString.Lazy as L

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

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

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

45import Text.Pandoc.MediaBag (MediaBag)

46import Text.Pandoc.MIME (MimeType)

47import Text.Pandoc.UTF8 (toString)

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

51import Text.Parsec (runParserT, ParsecT)

52import qualified Text.Parsec as P

53import Control.Monad.Trans (lift)

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

55isOk :: Char -> Bool

56isOk :: Char -> Bool

56isOk c = isAscii c && isAlphaNum c

57isOk c = isAscii c && isAlphaNum c

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

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

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

145getDataURI media sourceURL mimetype src = do

146getDataURI media sourceURL mimetype src = do

146 let ext = map toLower $ takeExtension src

147 let ext = map toLower $ takeExtension src

147− fetchResult <- fetchItem' media sourceURL src

148+ fetchResult <- runIO $ do setMediaBag media

149+ fetchItem sourceURL src

148 (raw, respMime) <- case fetchResult of

150 (raw, respMime) <- case fetchResult of

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

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

150 "\n" ++ show msg

152 "\n" ++ show msg

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

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

79 getDefaultReferenceODT,

80 readDataFile,

81 readDataFileUTF8,

82− fetchItem,

83− fetchItem',

84 openURL,

82 openURL,

85 collapseFilePath,

83 collapseFilePath,

86 filteredFilesFromArchive,

84 filteredFilesFromArchive,

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

100

101import Text.Pandoc.Definition

99import Text.Pandoc.Definition

102import Text.Pandoc.Walk

100import Text.Pandoc.Walk

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

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

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

105import qualified Text.Pandoc.Builder as B

102import qualified Text.Pandoc.Builder as B

106import qualified Text.Pandoc.UTF8 as UTF8

103import qualified Text.Pandoc.UTF8 as UTF8

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

111import Data.Maybe (mapMaybe)

108import Data.Maybe (mapMaybe)

112import Data.Version ( showVersion )

109import Data.Version ( showVersion )

113import qualified Data.Map as M

110import qualified Data.Map as M

114−import Network.URI ( escapeURIString, nonStrictRelativeTo,

111+import Network.URI ( escapeURIString, unEscapeString )

115− unEscapeString, parseURIReference, isAllowedInURI,

116− parseURI, URI(..) )

117import qualified Data.Set as Set

112import qualified Data.Set as Set

118import System.Directory

113import System.Directory

119import System.FilePath (splitDirectories, isPathSeparator)

114import System.FilePath (splitDirectories, isPathSeparator)

120import qualified System.FilePath.Posix as Posix

115import qualified System.FilePath.Posix as Posix

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

116+import Text.Pandoc.MIME (MimeType)

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

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

123import Data.Generics (Typeable, Data)

118import Data.Generics (Typeable, Data)

124import qualified Control.Monad.State as S

119import qualified Control.Monad.State as S

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

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

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

752readDataFileUTF8 userDir fname =

747readDataFileUTF8 userDir fname =

753 UTF8.toString `fmap` readDataFile userDir fname

748 UTF8.toString `fmap` readDataFile userDir fname

754

749

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−

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

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

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

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

815openURL u

752openURL u

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

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

48import Text.Pandoc.Writers.Math

49import Text.Pandoc.Highlighting ( highlight )

50import Text.Pandoc.Walk

51+import Text.Pandoc.Error (PandocError)

51import Text.XML.Light as XML

52import Text.XML.Light as XML

52import Text.TeXMath

53import Text.TeXMath

53import Text.Pandoc.Readers.Docx.StyleMap

54import Text.Pandoc.Readers.Docx.StyleMap

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

55import Control.Monad.Reader

56import Control.Monad.Reader

56import Control.Monad.State

57import Control.Monad.State

57import Skylighting

58import Skylighting

59+import Control.Monad.Except (runExceptT)

58import System.Random (randomR)

60import System.Random (randomR)

59import Text.Printf (printf)

61import Text.Printf (printf)

60−import qualified Control.Exception as E

61import Data.Monoid ((<>))

62import Data.Monoid ((<>))

62import qualified Data.Text as T

63import qualified Data.Text as T

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

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

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

1180 case M.lookup src imgs of

1181 case M.lookup src imgs of

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

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

1182 Nothing -> do

1183 Nothing -> do

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

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

1184 case res of

1185 case res of

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

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

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

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

1187 -- emit alt text

1188 -- emit alt text

1188 inlinesToOpenXML opts alt

1189 inlinesToOpenXML opts alt

1189 Right (img, mt) -> do

1190 Right (img, mt) -> do

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

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

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

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

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

67−import Control.Monad.Except (throwError)

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

68import Text.Pandoc.Error

69import Text.Pandoc.Class (PandocMonad)

70import qualified Text.Pandoc.Class as P

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

858 media <- gets stMediaPaths

859 case lookup oldsrc media of

860 Just (n,_) -> return n

861− Nothing -> do

861+ Nothing -> catchError

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

863− (writerSourceURL opts) oldsrc

862+ (do (img, mbMime) <- P.fetchItem (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) ++

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

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

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

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

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

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

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

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

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

875− return (new, Just entry)

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

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

877− return new

874+ return oldsrc)

878

875

879transformBlock :: PandocMonad m

876transformBlock :: PandocMonad m

880 => WriterOptions

877 => WriterOptions

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

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

39import qualified Text.XML.Light as X

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

41import qualified Data.ByteString.Char8 as B8

42−import Control.Monad.Except (throwError)

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

45import Text.Pandoc.Definition

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

241 else return Nothing

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

243 _ -> do

244− response <- P.fetchItem Nothing link

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

245− case response of

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,

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

251+ B8.unpack $ encode bs))

252+ (\e ->

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

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

247− _ -> return $ Nothing

255+ return Nothing)

248 case mbimg of

256 case mbimg of

249 Just (imgtype, imgdata) -> do

257 Just (imgtype, imgdata) -> do

250 return . Right $ el "binary"

258 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 #-}

3{- |

4 Module : Text.Pandoc.Writers.ICML

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

15-}

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

17import Text.Pandoc.Definition

18+import Text.Pandoc.Error (PandocError)

18import Text.Pandoc.XML

19import Text.Pandoc.XML

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

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

20import Text.Pandoc.Writers.Shared

21import Text.Pandoc.Writers.Shared

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

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

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

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

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

28import Control.Monad.State

29import Control.Monad.State

30+import Control.Monad.Except (runExceptT)

29import Network.URI (isURI)

31import Network.URI (isURI)

30import qualified Data.Set as Set

32import qualified Data.Set as Set

31import Text.Pandoc.Class (PandocMonad)

33import Text.Pandoc.Class (PandocMonad)

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

534-- | Assemble an ICML Image.

536-- | Assemble an ICML Image.

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

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

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

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

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

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

538 imgS <- case res of

540 imgS <- case res of

539− Left (_) -> do

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

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

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

541 return def

543 return def

542 Right (img, _) -> do

544 Right (img, _) -> do

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

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

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

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

47import Control.Monad.State

48+import Control.Monad.Except (runExceptT)

49+import Text.Pandoc.Error (PandocError)

48import Text.Pandoc.XML

50import Text.Pandoc.XML

49import Text.Pandoc.Pretty

51import Text.Pandoc.Pretty

50−import qualified Control.Exception as E

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

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

52import Text.Pandoc.Class ( PandocMonad )

53import Text.Pandoc.Class ( PandocMonad )

53import qualified Text.Pandoc.Class as P

54import qualified Text.Pandoc.Class as P

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

145-- | transform both Image and Math elements

146-- | transform both Image and Math elements

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

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

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

148transformPicMath 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

149 case res of

150 case res of

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

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

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

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

152 return $ Emph lab

153 return $ Emph lab

153 Right (img, mbMimeType) -> do

154 Right (img, mbMimeType) -> do

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

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

1+{-# LANGUAGE ScopedTypeVariables #-}

1{-

2{-

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

43import qualified Data.Map as M

44import qualified Data.Map as M

44import Text.Printf ( printf )

45import Text.Printf ( printf )

45import Text.Pandoc.ImageSize

46import Text.Pandoc.ImageSize

46−import Control.Monad.Except (throwError)

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

47import Text.Pandoc.Error

48import Text.Pandoc.Error

48import Text.Pandoc.Class (PandocMonad)

49import Text.Pandoc.Class (PandocMonad)

49import qualified Text.Pandoc.Class as P

50import qualified Text.Pandoc.Class as P

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

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

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

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

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

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

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

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

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

57 case result of

58 case result of

58 Right (imgdata, Just mime)

59 Right (imgdata, Just mime)

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

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

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

87 Right (_, Nothing) -> do

88 Right (_, Nothing) -> do

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

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

89 return x

90 return x

90− Left e -> do

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

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

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

92 return x

93 return x

93rtfEmbedImage _ x = return x

94rtfEmbedImage _ x = return x