e711043 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

FB2 writer: Rewrite image-fetching to use fetchItem.

e711043Jesse Rosenthal10 years ago

src/Text/Pandoc/Writers/FB2.hs+11−43

compare with master

unifiedsplit

@@ -28,26 +28,23 @@ FictionBook is an XML-based e-book format. For more information see:

28module Text.Pandoc.Writers.FB2 (writeFB2) where

30import Control.Monad.State (StateT, evalStateT, get, modify)

31−import Control.Monad.State (liftM, liftM2, liftIO)

31+import Control.Monad.State (liftM, liftIO)

32import Data.ByteString.Base64 (encode)

33import Data.Char (toLower, isSpace, isAscii, isControl)

34import Data.List (intersperse, intercalate, isPrefixOf, stripPrefix)

35import Data.Either (lefts, rights)

36−import Network.Browser (browse, request, setAllowRedirects, setOutHandler)

36+import Network.HTTP (urlEncode)

37−import Network.HTTP (catchIO_, getRequest, getHeaders, getResponseBody)

38−import Network.HTTP (lookupHeader, HeaderName(..), urlEncode)

39−import Network.URI (isURI, unEscapeString)

37+import Network.URI (isURI)

40−import System.FilePath (takeExtension)

41import Text.XML.Light

38import Text.XML.Light

42−import qualified Control.Exception as E

43−import qualified Data.ByteString as B

44import qualified Text.XML.Light as X

39import qualified Text.XML.Light as X

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

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

41+import qualified Data.ByteString.Char8 as B8

42+

47import Text.Pandoc.Definition

44import Text.Pandoc.Definition

48import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)

45import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)

49import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,

46import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,

50− linesToPara)

47+ linesToPara, fetchItem)

52-- | Data to be written at the end of the document:

49-- | Data to be written at the end of the document:

53-- (foot)notes, URLs, references, images.

50-- (foot)notes, URLs, references, images.

@@ -237,16 +234,11 @@ fetchImage href link = do

237 then return (Just (mime',base64))

234 then return (Just (mime',base64))

238 else return Nothing

235 else return Nothing

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

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

240− (True, Nothing) -> fetchURL link

241− (False, _) -> do

237+ _ -> do

242− d <- nothingOnError $ B.readFile (unEscapeString link)

238+ response <- fetchItem Nothing link

243− let t = case map toLower (takeExtension link) of

239+ case response of

244− ".png" -> Just "image/png"

240+ Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs)

245− ".jpg" -> Just "image/jpeg"

241+ _ -> return $ Nothing

246− ".jpeg" -> Just "image/jpeg"

247− ".jpe" -> Just "image/jpeg"

248− _ -> Nothing -- only PNG and JPEG are supported in FB2

249− return $ liftM2 (,) t (liftM (toStr . encode) d)

250 case mbimg of

242 case mbimg of

251 Just (imgtype, imgdata) -> do

243 Just (imgtype, imgdata) -> do

252 return . Right $ el "binary"

244 return . Right $ el "binary"

@@ -256,12 +248,6 @@ fetchImage href link = do

256 _ -> return (Left ('#':href))

248 _ -> return (Left ('#':href))

257

249

258

250

259−nothingOnError :: (IO B.ByteString) -> (IO (Maybe B.ByteString))

260−nothingOnError action = liftM Just action `E.catch` omnihandler

261−

262−omnihandler :: E.SomeException -> IO (Maybe B.ByteString)

263−omnihandler _ = return Nothing

264−

265-- | Extract mime type and encoded data from the Data URI.

251-- | Extract mime type and encoded data from the Data URI.

266readDataURI :: String -- ^ URI

252readDataURI :: String -- ^ URI

267 -> Maybe (String,String,Bool,String)

253 -> Maybe (String,String,Bool,String)

@@ -298,24 +284,6 @@ isMimeType s =

298 valid c = isAscii c && not (isControl c) && not (isSpace c) &&

284 valid c = isAscii c && not (isControl c) && not (isSpace c) &&

299 c `notElem` "()<>@,;:\\\"/[]?="

285 c `notElem` "()<>@,;:\\\"/[]?="

300

286

301−-- | Fetch URL, return its Content-Type and binary data on success.

302−fetchURL :: String -> IO (Maybe (String, String))

303−fetchURL url = do

304− flip catchIO_ (return Nothing) $ do

305− r <- browse $ do

306− setOutHandler (const (return ()))

307− setAllowRedirects True

308− liftM snd . request . getRequest $ url

309− let content_type = lookupHeader HdrContentType (getHeaders r)

310− content <- liftM (Just . toStr . encode . toBS) . getResponseBody $ Right r

311− return $ liftM2 (,) content_type content

312−

313−toBS :: String -> B.ByteString

314−toBS = B.pack . map (toEnum . fromEnum)

315−

316−toStr :: B.ByteString -> String

317−toStr = map (toEnum . fromEnum) . B.unpack

318−

319footnoteID :: Int -> String

287footnoteID :: Int -> String

320footnoteID i = "n" ++ (show i)

288footnoteID i = "n" ++ (show i)

321

289