Finish pure writer of FB2.
This commit is contained in:
parent
e711043dee
commit
2ea3e77172
1 changed files with 17 additions and 10 deletions
|
@ -25,10 +25,10 @@ FictionBook is an XML-based e-book format. For more information see:
|
||||||
<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>
|
<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>
|
||||||
|
|
||||||
-}
|
-}
|
||||||
module Text.Pandoc.Writers.FB2 (writeFB2) where
|
module Text.Pandoc.Writers.FB2 (writeFB2, writeFB2Pure) where
|
||||||
|
|
||||||
import Control.Monad.State (StateT, evalStateT, get, modify)
|
import Control.Monad.State (StateT, evalStateT, get, modify, lift)
|
||||||
import Control.Monad.State (liftM, liftIO)
|
import Control.Monad.State (liftM)
|
||||||
import Data.ByteString.Base64 (encode)
|
import Data.ByteString.Base64 (encode)
|
||||||
import Data.Char (toLower, isSpace, isAscii, isControl)
|
import Data.Char (toLower, isSpace, isAscii, isControl)
|
||||||
import Data.List (intersperse, intercalate, isPrefixOf, stripPrefix)
|
import Data.List (intersperse, intercalate, isPrefixOf, stripPrefix)
|
||||||
|
@ -44,7 +44,9 @@ import qualified Data.ByteString.Char8 as B8
|
||||||
import Text.Pandoc.Definition
|
import Text.Pandoc.Definition
|
||||||
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
|
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
|
||||||
import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,
|
import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,
|
||||||
linesToPara, fetchItem)
|
linesToPara)
|
||||||
|
import Text.Pandoc.Free (PandocAction, runIO)
|
||||||
|
import qualified Text.Pandoc.Free as P
|
||||||
|
|
||||||
-- | Data to be written at the end of the document:
|
-- | Data to be written at the end of the document:
|
||||||
-- (foot)notes, URLs, references, images.
|
-- (foot)notes, URLs, references, images.
|
||||||
|
@ -57,7 +59,7 @@ data FbRenderState = FbRenderState
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
-- | FictionBook building monad.
|
-- | FictionBook building monad.
|
||||||
type FBM = StateT FbRenderState IO
|
type FBM = StateT FbRenderState PandocAction
|
||||||
|
|
||||||
newFB :: FbRenderState
|
newFB :: FbRenderState
|
||||||
newFB = FbRenderState { footnotes = [], imagesToFetch = []
|
newFB = FbRenderState { footnotes = [], imagesToFetch = []
|
||||||
|
@ -73,7 +75,12 @@ instance Show ImageMode where
|
||||||
writeFB2 :: WriterOptions -- ^ conversion options
|
writeFB2 :: WriterOptions -- ^ conversion options
|
||||||
-> Pandoc -- ^ document to convert
|
-> Pandoc -- ^ document to convert
|
||||||
-> IO String -- ^ FictionBook2 document (not encoded yet)
|
-> IO String -- ^ FictionBook2 document (not encoded yet)
|
||||||
writeFB2 opts doc = flip evalStateT newFB $ pandocToFB2 opts doc
|
writeFB2 opts doc = runIO $ writeFB2Pure opts doc
|
||||||
|
|
||||||
|
writeFB2Pure :: WriterOptions
|
||||||
|
-> Pandoc
|
||||||
|
-> PandocAction String
|
||||||
|
writeFB2Pure opts doc = flip evalStateT newFB $ pandocToFB2 opts doc
|
||||||
|
|
||||||
pandocToFB2 :: WriterOptions
|
pandocToFB2 :: WriterOptions
|
||||||
-> Pandoc
|
-> Pandoc
|
||||||
|
@ -85,7 +92,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
|
||||||
secs <- renderSections 1 blocks
|
secs <- renderSections 1 blocks
|
||||||
let body = el "body" $ fp ++ secs
|
let body = el "body" $ fp ++ secs
|
||||||
notes <- renderFootnotes
|
notes <- renderFootnotes
|
||||||
(imgs,missing) <- liftM imagesToFetch get >>= \s -> liftIO (fetchImages s)
|
(imgs,missing) <- liftM imagesToFetch get >>= \s -> lift (fetchImages s)
|
||||||
let body' = replaceImagesWithAlt missing body
|
let body' = replaceImagesWithAlt missing body
|
||||||
let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
|
let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
|
||||||
return $ xml_head ++ (showContent fb2_xml) ++ "\n"
|
return $ xml_head ++ (showContent fb2_xml) ++ "\n"
|
||||||
|
@ -217,14 +224,14 @@ renderFootnotes = do
|
||||||
|
|
||||||
-- | Fetch images and encode them for the FictionBook XML.
|
-- | Fetch images and encode them for the FictionBook XML.
|
||||||
-- Return image data and a list of hrefs of the missing images.
|
-- Return image data and a list of hrefs of the missing images.
|
||||||
fetchImages :: [(String,String)] -> IO ([Content],[String])
|
fetchImages :: [(String,String)] -> PandocAction ([Content],[String])
|
||||||
fetchImages links = do
|
fetchImages links = do
|
||||||
imgs <- mapM (uncurry fetchImage) links
|
imgs <- mapM (uncurry fetchImage) links
|
||||||
return $ (rights imgs, lefts imgs)
|
return $ (rights imgs, lefts imgs)
|
||||||
|
|
||||||
-- | Fetch image data from disk or from network and make a <binary> XML section.
|
-- | Fetch image data from disk or from network and make a <binary> XML section.
|
||||||
-- Return either (Left hrefOfMissingImage) or (Right xmlContent).
|
-- Return either (Left hrefOfMissingImage) or (Right xmlContent).
|
||||||
fetchImage :: String -> String -> IO (Either String Content)
|
fetchImage :: String -> String -> PandocAction (Either String Content)
|
||||||
fetchImage href link = do
|
fetchImage href link = do
|
||||||
mbimg <-
|
mbimg <-
|
||||||
case (isURI link, readDataURI link) of
|
case (isURI link, readDataURI link) of
|
||||||
|
@ -235,7 +242,7 @@ fetchImage href link = do
|
||||||
else return Nothing
|
else return Nothing
|
||||||
(True, Just _) -> return Nothing -- not base64-encoded
|
(True, Just _) -> return Nothing -- not base64-encoded
|
||||||
_ -> do
|
_ -> do
|
||||||
response <- fetchItem Nothing link
|
response <- P.fetchItem Nothing link
|
||||||
case response of
|
case response of
|
||||||
Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs)
|
Right (bs, Just mime) -> return $ Just (mime, B8.unpack $ encode bs)
|
||||||
_ -> return $ Nothing
|
_ -> return $ Nothing
|
||||||
|
|
Loading…
Reference in a new issue