diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 82 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 49 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/FB2.hs | 57 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ICML.hs | 36 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 27 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 13 |
6 files changed, 122 insertions, 142 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 07041f189..36816eaa1 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to docx. -} -module Text.Pandoc.Writers.Docx ( writeDocx, writeDocxPure ) where +module Text.Pandoc.Writers.Docx ( writeDocx ) where import Data.List ( intercalate, isPrefixOf, isSuffixOf ) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -65,8 +65,8 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, import Control.Applicative ((<|>)) import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing) import Data.Char (ord, isSpace, toLower) -import Text.Pandoc.Free (PandocAction, runIO) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class (PandocMonad) +import qualified Text.Pandoc.Class as P data ListMarker = NoMarker | BulletMarker @@ -146,7 +146,7 @@ defaultWriterState = WriterState{ , stDynamicTextProps = [] } -type WS = ReaderT WriterEnv (StateT WriterState (PandocAction)) +type WS m = ReaderT WriterEnv (StateT WriterState m) mknode :: Node t => String -> [(String,String)] -> t -> Element mknode s attrs = @@ -215,17 +215,11 @@ metaValueToInlines _ = [] -writeDocx :: WriterOptions -- ^ Writer options +writeDocx :: (PandocMonad m) + => WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert - -> IO BL.ByteString -writeDocx opts doc = runIO $ writeDocxPure opts doc - - --- | Produce an Docx file from a Pandoc document. -writeDocxPure :: WriterOptions -- ^ Writer options - -> Pandoc -- ^ Document to convert - -> PandocAction BL.ByteString -writeDocxPure opts doc@(Pandoc meta _) = do + -> m BL.ByteString +writeDocx opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let doc' = walk fixDisplayMath $ doc username <- P.lookupEnv "USERNAME" @@ -611,7 +605,7 @@ styleToOpenXml sm style = $ backgroundColor style ) ] -copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> PandocAction Entry +copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry copyChildren refArchive distArchive path timestamp elNames = do ref <- parseXml refArchive distArchive path dist <- parseXml distArchive distArchive path @@ -630,7 +624,7 @@ copyChildren refArchive distArchive path timestamp elNames = do baseListId :: Int baseListId = 1000 -mkNumbering :: [ListMarker] -> PandocAction [Element] +mkNumbering :: (PandocMonad m) => [ListMarker] -> m [Element] mkNumbering lists = do elts <- mapM mkAbstractNum (ordNub lists) return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)] @@ -646,7 +640,7 @@ mkNum marker numid = map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))] $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6] -mkAbstractNum :: ListMarker -> PandocAction Element +mkAbstractNum :: (PandocMonad m) => ListMarker -> m Element mkAbstractNum marker = do gen <- P.newStdGen let (nsid, _) = randomR (0x10000000 :: Integer, 0xFFFFFFFF :: Integer) gen @@ -701,11 +695,11 @@ mkLvl marker lvl = patternFor TwoParens s = "(" ++ s ++ ")" patternFor _ s = s ++ "." -getNumId :: WS Int +getNumId :: (PandocMonad m) => WS m Int getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists -makeTOC :: WriterOptions -> WS [Element] +makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element] makeTOC opts | writerTableOfContents opts = do let depth = "1-"++(show (writerTOCDepth opts)) let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u" @@ -735,7 +729,7 @@ makeTOC _ = return [] -- | Convert Pandoc document to two lists of -- OpenXML elements (the main document and footnotes). -writeOpenXML :: WriterOptions -> Pandoc -> WS ([Element], [Element]) +writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element]) writeOpenXML opts (Pandoc meta blocks) = do let tit = docTitle meta ++ case lookupMeta "subtitle" meta of Just (MetaBlocks [Plain xs]) -> LineBreak : xs @@ -770,13 +764,13 @@ writeOpenXML opts (Pandoc meta blocks) = do return (meta' ++ doc', notes') -- | Convert a list of Pandoc blocks to OpenXML. -blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element] +blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element] blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls pCustomStyle :: String -> Element pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] () -pStyleM :: String -> WS XML.Element +pStyleM :: (PandocMonad m) => String -> WS m XML.Element pStyleM styleName = do styleMaps <- gets stStyleMaps let sty' = getStyleId styleName $ sParaStyleMap styleMaps @@ -785,13 +779,13 @@ pStyleM styleName = do rCustomStyle :: String -> Element rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] () -rStyleM :: String -> WS XML.Element +rStyleM :: (PandocMonad m) => String -> WS m XML.Element rStyleM styleName = do styleMaps <- gets stStyleMaps let sty' = getStyleId styleName $ sCharStyleMap styleMaps return $ mknode "w:rStyle" [("w:val",sty')] () -getUniqueId :: PandocAction String +getUniqueId :: (PandocMonad m) => m String -- the + 20 is to ensure that there are no clashes with the rIds -- already in word/document.xml.rel getUniqueId = (show . (+ 20)) <$> P.newUniqueHash @@ -801,10 +795,10 @@ dynamicStyleKey :: String dynamicStyleKey = "custom-style" -- | Convert a Pandoc block element to OpenXML. -blockToOpenXML :: WriterOptions -> Block -> WS [Element] +blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element] blockToOpenXML opts blk = withDirection $ blockToOpenXML' opts blk -blockToOpenXML' :: WriterOptions -> Block -> WS [Element] +blockToOpenXML' :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element] blockToOpenXML' _ Null = return [] blockToOpenXML' opts (Div (ident,classes,kvs) bs) | Just sty <- lookup dynamicStyleKey kvs = do @@ -955,7 +949,7 @@ blockToOpenXML' opts (DefinitionList items) = do setFirstPara return l -definitionListItemToOpenXML :: WriterOptions -> ([Inline],[[Block]]) -> WS [Element] +definitionListItemToOpenXML :: (PandocMonad m) => WriterOptions -> ([Inline],[[Block]]) -> WS m [Element] definitionListItemToOpenXML opts (term,defs) = do term' <- withParaProp (pCustomStyle "DefinitionTerm") $ blockToOpenXML opts (Para term) @@ -963,12 +957,12 @@ definitionListItemToOpenXML opts (term,defs) = do $ concat `fmap` mapM (blocksToOpenXML opts) defs return $ term' ++ defs' -addList :: ListMarker -> WS () +addList :: (PandocMonad m) => ListMarker -> WS m () addList marker = do lists <- gets stLists modify $ \st -> st{ stLists = lists ++ [marker] } -listItemToOpenXML :: WriterOptions -> Int -> [Block] -> WS [Element] +listItemToOpenXML :: (PandocMonad m) => WriterOptions -> Int -> [Block] -> WS m [Element] listItemToOpenXML _ _ [] = return [] listItemToOpenXML opts numid (first:rest) = do first' <- withNumId numid $ blockToOpenXML opts first @@ -984,30 +978,30 @@ alignmentToString alignment = case alignment of AlignDefault -> "left" -- | Convert a list of inline elements to OpenXML. -inlinesToOpenXML :: WriterOptions -> [Inline] -> WS [Element] +inlinesToOpenXML :: (PandocMonad m) => WriterOptions -> [Inline] -> WS m [Element] inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) lst -withNumId :: Int -> WS a -> WS a +withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a withNumId numid = local $ \env -> env{ envListNumId = numid } -asList :: WS a -> WS a +asList :: (PandocMonad m) => WS m a -> WS m a asList = local $ \env -> env{ envListLevel = envListLevel env + 1 } -getTextProps :: WS [Element] +getTextProps :: (PandocMonad m) => WS m [Element] getTextProps = do props <- asks envTextProperties return $ if null props then [] else [mknode "w:rPr" [] props] -withTextProp :: Element -> WS a -> WS a +withTextProp :: PandocMonad m => Element -> WS m a -> WS m a withTextProp d p = local (\env -> env {envTextProperties = d : envTextProperties env}) p -withTextPropM :: WS Element -> WS a -> WS a +withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a withTextPropM = (. flip withTextProp) . (>>=) -getParaProps :: Bool -> WS [Element] +getParaProps :: PandocMonad m => Bool -> WS m [Element] getParaProps displayMathPara = do props <- asks envParaProperties listLevel <- asks envListLevel @@ -1022,14 +1016,14 @@ getParaProps displayMathPara = do [] -> [] ps -> [mknode "w:pPr" [] ps] -withParaProp :: Element -> WS a -> WS a +withParaProp :: PandocMonad m => Element -> WS m a -> WS m a withParaProp d p = local (\env -> env {envParaProperties = d : envParaProperties env}) p -withParaPropM :: WS Element -> WS a -> WS a +withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a withParaPropM = (. flip withParaProp) . (>>=) -formattedString :: String -> WS [Element] +formattedString :: PandocMonad m => String -> WS m [Element] formattedString str = do props <- getTextProps inDel <- asks envInDel @@ -1038,14 +1032,14 @@ formattedString str = do [ mknode (if inDel then "w:delText" else "w:t") [("xml:space","preserve")] (stripInvalidChars str) ] ] -setFirstPara :: WS () +setFirstPara :: PandocMonad m => WS m () setFirstPara = modify $ \s -> s { stFirstPara = True } -- | Convert an inline element to OpenXML. -inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] +inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Element] inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il -inlineToOpenXML' :: WriterOptions -> Inline -> WS [Element] +inlineToOpenXML' :: PandocMonad m => WriterOptions -> Inline -> WS m [Element] inlineToOpenXML' _ (Str str) = formattedString str inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ") inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ") @@ -1281,7 +1275,7 @@ defaultFootnotes = [ mknode "w:footnote" [ mknode "w:r" [] $ [ mknode "w:continuationSeparator" [] ()]]]] -parseXml :: Archive -> Archive -> String -> PandocAction Element +parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element parseXml refArchive distArchive relpath = case findEntryByPath relpath refArchive `mplus` findEntryByPath relpath distArchive of @@ -1299,7 +1293,7 @@ fitToPage (x, y) pageWidth (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) | otherwise = (floor x, floor y) -withDirection :: WS a -> WS a +withDirection :: PandocMonad m => WS m a -> WS m a withDirection x = do isRTL <- asks envRTL paraProps <- asks envParaProperties diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index a0991e27b..397aa5847 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to EPUB. -} -module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where +module Text.Pandoc.Writers.EPUB ( writeEPUB ) where import qualified Data.Map as M import qualified Data.Set as Set import Data.Maybe ( fromMaybe, catMaybes ) @@ -64,8 +64,8 @@ import Data.Char ( toLower, isDigit, isAlphaNum ) import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType) import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags) -import Text.Pandoc.Free (PandocAction, runIO) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class (PandocMonad) +import qualified Text.Pandoc.Class as P -- A Chapter includes a list of blocks and maybe a section -- number offset. Note, some chapters are unnumbered. The section @@ -76,7 +76,7 @@ data Chapter = Chapter (Maybe [Int]) [Block] data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))] } -type E = StateT EPUBState PandocAction +type E m = StateT EPUBState m data EPUBMetadata = EPUBMetadata{ epubIdentifier :: [Identifier] @@ -145,7 +145,7 @@ removeNote :: Inline -> Inline removeNote (Note _) = Str "" removeNote x = x -getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata +getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata getEPUBMetadata opts meta = do let md = metadataFromMeta opts meta let elts = onlyElems $ parseXML $ writerEpubMetadata opts @@ -335,23 +335,20 @@ metadataFromMeta opts meta = EPUBMetadata{ _ -> Nothing -- | Produce an EPUB file from a Pandoc document. -writeEPUB :: WriterOptions -- ^ Writer options +writeEPUB :: PandocMonad m + => WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert - -> IO B.ByteString -writeEPUB opts doc = runIO $ writeEPUBPure opts doc - -writeEPUBPure :: WriterOptions -- ^ Writer options - -> Pandoc -- ^ Document to convert - -> PandocAction B.ByteString -writeEPUBPure opts doc = + -> m B.ByteString +writeEPUB opts doc = let initState = EPUBState { stMediaPaths = [] } in evalStateT (pandocToEPUB opts doc) initState -pandocToEPUB :: WriterOptions - -> Pandoc - -> E B.ByteString +pandocToEPUB :: PandocMonad m + => WriterOptions + -> Pandoc + -> E m B.ByteString pandocToEPUB opts doc@(Pandoc meta _) = do let version = fromMaybe EPUB2 (writerEpubVersion opts) let epub3 = version == EPUB3 @@ -829,10 +826,11 @@ metadataElement version md currentTime = showDateTimeISO8601 :: UTCTime -> String showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ" -transformTag :: WriterOptions +transformTag :: PandocMonad m + => WriterOptions -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media -> Tag String - -> E (Tag String) + -> E m (Tag String) transformTag opts tag@(TagOpen name attr) | name `elem` ["video", "source", "img", "audio"] && lookup "data-external" attr == Nothing = do @@ -846,9 +844,10 @@ transformTag opts tag@(TagOpen name attr) return $ TagOpen name attr' transformTag _ tag = return tag -modifyMediaRef :: WriterOptions +modifyMediaRef :: PandocMonad m + => WriterOptions -> FilePath - -> E FilePath + -> E m FilePath modifyMediaRef _ "" = return "" modifyMediaRef opts oldsrc = do media <- gets stMediaPaths @@ -872,10 +871,11 @@ modifyMediaRef opts oldsrc = do modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media} return new -transformBlock :: WriterOptions +transformBlock :: PandocMonad m + => WriterOptions -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media -> Block - -> E Block + -> E m Block transformBlock opts (RawBlock fmt raw) | fmt == Format "html" = do let tags = parseTags raw @@ -883,10 +883,11 @@ transformBlock opts (RawBlock fmt raw) return $ RawBlock fmt (renderTags' tags') transformBlock _ b = return b -transformInline :: WriterOptions +transformInline :: PandocMonad m + => WriterOptions -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media -> Inline - -> E Inline + -> E m Inline transformInline opts (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef opts src return $ Image attr lab (newsrc, tit) diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 3c4970e75..58bfe7615 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -25,7 +25,7 @@ FictionBook is an XML-based e-book format. For more information see: <http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1> -} -module Text.Pandoc.Writers.FB2 (writeFB2, writeFB2Pure) where +module Text.Pandoc.Writers.FB2 (writeFB2) where import Control.Monad.State (StateT, evalStateT, get, modify, lift) import Control.Monad.State (liftM) @@ -45,8 +45,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def) import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize, linesToPara) -import Text.Pandoc.Free (PandocAction, runIO) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class (PandocMonad) +import qualified Text.Pandoc.Class as P -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images. @@ -59,7 +59,7 @@ data FbRenderState = FbRenderState } deriving (Show) -- | FictionBook building monad. -type FBM = StateT FbRenderState PandocAction +type FBM m = StateT FbRenderState m newFB :: FbRenderState newFB = FbRenderState { footnotes = [], imagesToFetch = [] @@ -72,19 +72,16 @@ instance Show ImageMode where show InlineImage = "inlineImageType" -- | Produce an FB2 document from a 'Pandoc' document. -writeFB2 :: WriterOptions -- ^ conversion options +writeFB2 :: PandocMonad m + => WriterOptions -- ^ conversion options -> Pandoc -- ^ document to convert - -> IO String -- ^ FictionBook2 document (not encoded yet) -writeFB2 opts doc = runIO $ writeFB2Pure opts doc + -> m String -- ^ FictionBook2 document (not encoded yet) +writeFB2 opts doc = flip evalStateT newFB $ pandocToFB2 opts doc -writeFB2Pure :: WriterOptions - -> Pandoc - -> PandocAction String -writeFB2Pure opts doc = flip evalStateT newFB $ pandocToFB2 opts doc - -pandocToFB2 :: WriterOptions +pandocToFB2 :: PandocMonad m + => WriterOptions -> Pandoc - -> FBM String + -> FBM m String pandocToFB2 opts (Pandoc meta blocks) = do modify (\s -> s { writerOptions = opts { writerOptions = opts } }) desc <- description meta @@ -104,7 +101,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do in [ uattr "xmlns" xmlns , attr ("xmlns", "l") xlink ] -frontpage :: Meta -> FBM [Content] +frontpage :: PandocMonad m => Meta -> FBM m [Content] frontpage meta' = do t <- cMapM toXml . docTitle $ meta' return $ @@ -113,7 +110,7 @@ frontpage meta' = do (docAuthors meta' ++ [docDate meta'])) ] -description :: Meta -> FBM Content +description :: PandocMonad m => Meta -> FBM m Content description meta' = do bt <- booktitle meta' let as = authors meta' @@ -123,7 +120,7 @@ description meta' = do , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version ] -booktitle :: Meta -> FBM [Content] +booktitle :: PandocMonad m => Meta -> FBM m [Content] booktitle meta' = do t <- cMapM toXml . docTitle $ meta' return $ if null t @@ -148,7 +145,7 @@ author ss = ([]) -> [] in list $ el "author" (names ++ email) -docdate :: Meta -> FBM [Content] +docdate :: PandocMonad m => Meta -> FBM m [Content] docdate meta' = do let ss = docDate meta' d <- cMapM toXml ss @@ -158,12 +155,12 @@ docdate meta' = do -- | Divide the stream of blocks into sections and convert to XML -- representation. -renderSections :: Int -> [Block] -> FBM [Content] +renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content] renderSections level blocks = do let secs = splitSections level blocks mapM (renderSection level) secs -renderSection :: Int -> ([Inline], [Block]) -> FBM Content +renderSection :: PandocMonad m => Int -> ([Inline], [Block]) -> FBM m Content renderSection level (ttl, body) = do title <- if null ttl then return [] @@ -210,7 +207,7 @@ splitSections level blocks = reverse $ revSplit (reverse blocks) sameLevel _ = False -- | Make another FictionBook body with footnotes. -renderFootnotes :: FBM [Content] +renderFootnotes :: PandocMonad m => FBM m [Content] renderFootnotes = do fns <- footnotes `liftM` get if null fns @@ -224,14 +221,14 @@ renderFootnotes = do -- | Fetch images and encode them for the FictionBook XML. -- Return image data and a list of hrefs of the missing images. -fetchImages :: [(String,String)] -> PandocAction ([Content],[String]) +fetchImages :: PandocMonad m => [(String,String)] -> m ([Content],[String]) fetchImages links = do imgs <- mapM (uncurry fetchImage) links return $ (rights imgs, lefts imgs) -- | Fetch image data from disk or from network and make a <binary> XML section. -- Return either (Left hrefOfMissingImage) or (Right xmlContent). -fetchImage :: String -> String -> PandocAction (Either String Content) +fetchImage :: PandocMonad m => String -> String -> m (Either String Content) fetchImage href link = do mbimg <- case (isURI link, readDataURI link) of @@ -298,7 +295,7 @@ linkID :: Int -> String linkID i = "l" ++ (show i) -- | Convert a block-level Pandoc's element to FictionBook XML representation. -blockToXml :: Block -> FBM [Content] +blockToXml :: PandocMonad m => Block -> FBM m [Content] blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula -- title beginning with fig: indicates that the image is a figure @@ -362,11 +359,11 @@ blockToXml (Table caption aligns _ headers rows) = do c <- return . el "emphasis" =<< cMapM toXml caption return [el "table" (hd : bd), el "p" c] where - mkrow :: String -> [TableCell] -> [Alignment] -> FBM Content + mkrow :: PandocMonad m => String -> [TableCell] -> [Alignment] -> FBM m Content mkrow tag cells aligns' = (el "tr") `liftM` (mapM (mkcell tag) (zip cells aligns')) -- - mkcell :: String -> (TableCell, Alignment) -> FBM Content + mkcell :: PandocMonad m => String -> (TableCell, Alignment) -> FBM m Content mkcell tag (cell, align) = do cblocks <- cMapM blockToXml cell return $ el tag ([align_attr align], cblocks) @@ -410,7 +407,7 @@ indent = indentBlock in intercalate [LineBreak] $ map ((Str spacer):) lns -- | Convert a Pandoc's Inline element to FictionBook XML representation. -toXml :: Inline -> FBM [Content] +toXml :: PandocMonad m => Inline -> FBM m [Content] toXml (Str s) = return [txt s] toXml (Span _ ils) = cMapM toXml ils toXml (Emph ss) = list `liftM` wrap "emphasis" ss @@ -462,7 +459,7 @@ toXml (Note bs) = do , uattr "type" "note" ] , fn_ref ) -insertMath :: ImageMode -> String -> FBM [Content] +insertMath :: PandocMonad m => ImageMode -> String -> FBM m [Content] insertMath immode formula = do htmlMath <- return . writerHTMLMathMethod . writerOptions =<< get case htmlMath of @@ -473,7 +470,7 @@ insertMath immode formula = do insertImage immode img _ -> return [el "code" formula] -insertImage :: ImageMode -> Inline -> FBM [Content] +insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content] insertImage immode (Image _ alt (url,ttl)) = do images <- imagesToFetch `liftM` get let n = 1 + length images @@ -539,7 +536,7 @@ replaceImagesWithAlt missingHrefs body = -- | Wrap all inlines with an XML tag (given its unqualified name). -wrap :: String -> [Inline] -> FBM Content +wrap :: PandocMonad m => String -> [Inline] -> FBM m Content wrap tagname inlines = el tagname `liftM` cMapM toXml inlines -- " Create a singleton list. diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 186bf0c8d..c82a77452 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -28,8 +28,8 @@ import Data.Text as Text (breakOnAll, pack) import Control.Monad.State import Network.URI (isURI) import qualified Data.Set as Set -import Text.Pandoc.Free (runIO, PandocAction) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class (PandocMonad) +import qualified Text.Pandoc.Class as P type Style = [String] type Hyperlink = [(Int, String)] @@ -42,7 +42,7 @@ data WriterState = WriterState{ , maxListDepth :: Int } -type WS a = StateT WriterState PandocAction a +type WS m = StateT WriterState m defaultWriterState :: WriterState defaultWriterState = WriterState{ @@ -124,12 +124,8 @@ footnoteName = "Footnote" citeName = "Cite" -- | Convert Pandoc document to string in ICML format. -writeICML :: WriterOptions -> Pandoc -> IO String -writeICML opts doc = runIO $ writeICMLPure opts doc - --- | Convert Pandoc document to string in ICML format. -writeICMLPure :: WriterOptions -> Pandoc -> PandocAction String -writeICMLPure opts (Pandoc meta blocks) = do +writeICML :: PandocMonad m => WriterOptions -> Pandoc -> m String +writeICML opts (Pandoc meta blocks) = do let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -288,13 +284,13 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs -- | Convert a list of Pandoc blocks to ICML. -blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc +blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc blocksToICML opts style lst = do docs <- mapM (blockToICML opts style) lst return $ intersperseBrs docs -- | Convert a Pandoc block element to ICML. -blockToICML :: WriterOptions -> Style -> Block -> WS Doc +blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m Doc blockToICML opts style (Plain lst) = parStyle opts style lst -- title beginning with fig: indicates that the image is a figure blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do @@ -364,7 +360,7 @@ blockToICML opts style (Div _ lst) = blocksToICML opts style lst blockToICML _ _ Null = return empty -- | Convert a list of lists of blocks to ICML list items. -listItemsToICML :: WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS Doc +listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m Doc listItemsToICML _ _ _ _ [] = return empty listItemsToICML opts listType style attribs (first:rest) = do st <- get @@ -379,7 +375,7 @@ listItemsToICML opts listType style attribs (first:rest) = do return $ intersperseBrs docs -- | Convert a list of blocks to ICML list items. -listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc +listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m Doc listItemToICML opts style isFirst attribs item = let makeNumbStart (Just (beginsWith, numbStl, _)) = let doN DefaultStyle = [] @@ -406,7 +402,7 @@ listItemToICML opts style isFirst attribs item = return $ intersperseBrs (f : r) else blocksToICML opts stl' item -definitionListItemToICML :: WriterOptions -> Style -> ([Inline],[[Block]]) -> WS Doc +definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m Doc definitionListItemToICML opts style (term,defs) = do term' <- parStyle opts (defListTermName:style) term defs' <- mapM (blocksToICML opts (defListDefName:style)) defs @@ -414,11 +410,11 @@ definitionListItemToICML opts style (term,defs) = do -- | Convert a list of inline elements to ICML. -inlinesToICML :: WriterOptions -> Style -> [Inline] -> WS Doc +inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc inlinesToICML opts style lst = vcat `fmap` mapM (inlineToICML opts style) (mergeSpaces lst) -- | Convert an inline element to ICML. -inlineToICML :: WriterOptions -> Style -> Inline -> WS Doc +inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m Doc inlineToICML _ style (Str str) = charStyle style $ text $ escapeStringForXML str inlineToICML opts style (Emph lst) = inlinesToICML opts (emphName:style) lst inlineToICML opts style (Strong lst) = inlinesToICML opts (strongName:style) lst @@ -458,7 +454,7 @@ inlineToICML opts style (Note lst) = footnoteToICML opts style lst inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst -- | Convert a list of block elements to an ICML footnote. -footnoteToICML :: WriterOptions -> Style -> [Block] -> WS Doc +footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc footnoteToICML opts style lst = let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ (Str "\t"):ls insertTab block = blockToICML opts (footnoteName:style) block @@ -489,7 +485,7 @@ intersperseBrs :: [Doc] -> Doc intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty) -- | Wrap a list of inline elements in an ICML Paragraph Style -parStyle :: WriterOptions -> Style -> [Inline] -> WS Doc +parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc parStyle opts style lst = let slipIn x y = if null y then x @@ -513,7 +509,7 @@ parStyle opts style lst = state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st }) -- | Wrap a Doc in an ICML Character Style. -charStyle :: Style -> Doc -> WS Doc +charStyle :: PandocMonad m => Style -> Doc -> WS m Doc charStyle style content = let (stlStr, attrs) = styleToStrAttr style doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content @@ -535,7 +531,7 @@ styleToStrAttr style = in (stlStr, attrs) -- | Assemble an ICML Image. -imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc +imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc imageICML opts style attr (src, _) = do res <- lift $ P.fetchItem (writerSourceURL opts) src imgS <- case res of diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index abd403cc9..8013763c2 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to ODT. -} -module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where +module Text.Pandoc.Writers.ODT ( writeODT ) where import Data.List ( isPrefixOf ) import Data.Maybe ( fromMaybe ) import Text.XML.Light.Output @@ -49,33 +49,30 @@ import Text.Pandoc.XML import Text.Pandoc.Pretty import qualified Control.Exception as E import System.FilePath ( takeExtension, takeDirectory, (<.>)) -import Text.Pandoc.Free ( PandocAction, runIO ) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class ( PandocMonad ) +import qualified Text.Pandoc.Class as P data ODTState = ODTState { stEntries :: [Entry] } -type O = StateT ODTState PandocAction +type O m = StateT ODTState m -- | Produce an ODT file from a Pandoc document. -writeODT :: WriterOptions -- ^ Writer options +writeODT :: PandocMonad m + => WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert - -> IO B.ByteString -writeODT opts doc = runIO $ writeODTPure opts doc - -writeODTPure :: WriterOptions - -> Pandoc - -> PandocAction B.ByteString -writeODTPure opts doc = + -> m B.ByteString +writeODT opts doc = let initState = ODTState{ stEntries = [] } in evalStateT (pandocToODT opts doc) initState -- | Produce an ODT file from a Pandoc document. -pandocToODT :: WriterOptions -- ^ Writer options +pandocToODT :: PandocMonad m + => WriterOptions -- ^ Writer options -> Pandoc -- ^ Document to convert - -> O B.ByteString + -> O m B.ByteString pandocToODT opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let title = docTitle meta @@ -145,7 +142,7 @@ pandocToODT opts doc@(Pandoc meta _) = do return $ fromArchive archive'' -- | transform both Image and Math elements -transformPicMath :: WriterOptions ->Inline -> O Inline +transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 8d7c643e0..75b97a648 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -29,7 +29,6 @@ Conversion of 'Pandoc' documents to RTF (rich text format). -} module Text.Pandoc.Writers.RTF ( writeRTF , writeRTFWithEmbeddedImages - , writeRTFWithEmbeddedImagesPure ) where import Text.Pandoc.Definition import Text.Pandoc.Options @@ -44,13 +43,13 @@ import qualified Data.ByteString as B import qualified Data.Map as M import Text.Printf ( printf ) import Text.Pandoc.ImageSize -import Text.Pandoc.Free (PandocAction, runIO) -import qualified Text.Pandoc.Free as P +import Text.Pandoc.Class (PandocMonad) +import qualified Text.Pandoc.Class as P -- | Convert Image inlines into a raw RTF embedded image, read from a file, -- or a MediaBag, or the internet. -- If file not found or filetype not jpeg or png, leave the inline unchanged. -rtfEmbedImage :: WriterOptions -> Inline -> PandocAction Inline +rtfEmbedImage :: PandocMonad m => WriterOptions -> Inline -> m Inline rtfEmbedImage opts x@(Image attr _ (src,_)) = do result <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case result of @@ -83,12 +82,8 @@ rtfEmbedImage _ x = return x -- | Convert Pandoc to a string in rich text format, with -- images embedded as encoded binary data. -writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String +writeRTFWithEmbeddedImages :: PandocMonad m => WriterOptions -> Pandoc -> m String writeRTFWithEmbeddedImages options doc = - runIO $ writeRTF options `fmap` walkM (rtfEmbedImage options) doc - -writeRTFWithEmbeddedImagesPure :: WriterOptions -> Pandoc -> PandocAction String -writeRTFWithEmbeddedImagesPure options doc = writeRTF options `fmap` walkM (rtfEmbedImage options) doc -- | Convert Pandoc to a string in rich text format. |