git.iko.soy/typeable/pandoc
on master help sign in
Convert writers to use PandocMonad typeclass.

Instead of Free Monad with runIO

commit957eee24ec9037a31574503fa1ca939567f23a90 authorJesse Rosenthal <jrosenthal@jhu.edu> dateMon 21 Nov 2016, 10:12 (10 years ago) parent239880f
6 files changed+122−142
compare with master
unifiedsplit
src/Text/Pandoc/Writers/Docx.hs+38−44 src/Text/Pandoc/Writers/EPUB.hs+25−24 src/Text/Pandoc/Writers/FB2.hs+27−30 src/Text/Pandoc/Writers/ICML.hs+16−20 src/Text/Pandoc/Writers/ODT.hs+12−15 src/Text/Pandoc/Writers/RTF.hs+4−9
src/Text/Pandoc/Writers/Docx.hs+38−44
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2828
2929Conversion of 'Pandoc' documents to docx.
3030-}
31−module Text.Pandoc.Writers.Docx ( writeDocx, writeDocxPure ) where
31+module Text.Pandoc.Writers.Docx ( writeDocx ) where
3232import Data.List ( intercalate, isPrefixOf, isSuffixOf )
3333import qualified Data.ByteString as B
3434import qualified Data.ByteString.Lazy as BL
@@ -65,8 +65,8 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
6565import Control.Applicative ((<|>))
6666import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)
6767import Data.Char (ord, isSpace, toLower)
68−import Text.Pandoc.Free (PandocAction, runIO)
69−import qualified Text.Pandoc.Free as P
68+import Text.Pandoc.Class (PandocMonad)
69+import qualified Text.Pandoc.Class as P
7070
7171data ListMarker = NoMarker
7272 | BulletMarker
@@ -146,7 +146,7 @@ defaultWriterState = WriterState{
146146 , stDynamicTextProps = []
147147 }
148148
149−type WS = ReaderT WriterEnv (StateT WriterState (PandocAction))
149+type WS m = ReaderT WriterEnv (StateT WriterState m)
150150
151151mknode :: Node t => String -> [(String,String)] -> t -> Element
152152mknode s attrs =
@@ -215,17 +215,11 @@ metaValueToInlines _ = []
215215
216216
217217
218−writeDocx :: WriterOptions -- ^ Writer options
218+writeDocx :: (PandocMonad m)
219+ => WriterOptions -- ^ Writer options
219220 -> Pandoc -- ^ Document to convert
220− -> IO BL.ByteString
221−writeDocx opts doc = runIO $ writeDocxPure opts doc
222−
223−
224−-- | Produce an Docx file from a Pandoc document.
225−writeDocxPure :: WriterOptions -- ^ Writer options
226− -> Pandoc -- ^ Document to convert
227− -> PandocAction BL.ByteString
228−writeDocxPure opts doc@(Pandoc meta _) = do
221+ -> m BL.ByteString
222+writeDocx opts doc@(Pandoc meta _) = do
229223 let datadir = writerUserDataDir opts
230224 let doc' = walk fixDisplayMath $ doc
231225 username <- P.lookupEnv "USERNAME"
@@ -611,7 +605,7 @@ styleToOpenXml sm style =
611605 $ backgroundColor style )
612606 ]
613607
614−copyChildren :: Archive -> Archive -> String -> Integer -> [String] -> PandocAction Entry
608+copyChildren :: (PandocMonad m) => Archive -> Archive -> String -> Integer -> [String] -> m Entry
615609copyChildren refArchive distArchive path timestamp elNames = do
616610 ref <- parseXml refArchive distArchive path
617611 dist <- parseXml distArchive distArchive path
@@ -630,7 +624,7 @@ copyChildren refArchive distArchive path timestamp elNames = do
630624baseListId :: Int
631625baseListId = 1000
632626
633−mkNumbering :: [ListMarker] -> PandocAction [Element]
627+mkNumbering :: (PandocMonad m) => [ListMarker] -> m [Element]
634628mkNumbering lists = do
635629 elts <- mapM mkAbstractNum (ordNub lists)
636630 return $ elts ++ zipWith mkNum lists [baseListId..(baseListId + length lists - 1)]
@@ -646,7 +640,7 @@ mkNum marker numid =
646640 map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",show (lvl :: Int))]
647641 $ mknode "w:startOverride" [("w:val",show start)] ()) [0..6]
648642
649−mkAbstractNum :: ListMarker -> PandocAction Element
643+mkAbstractNum :: (PandocMonad m) => ListMarker -> m Element
650644mkAbstractNum marker = do
651645 gen <- P.newStdGen
652646 let (nsid, _) = randomR (0x10000000 :: Integer, 0xFFFFFFFF :: Integer) gen
@@ -701,11 +695,11 @@ mkLvl marker lvl =
701695 patternFor TwoParens s = "(" ++ s ++ ")"
702696 patternFor _ s = s ++ "."
703697
704−getNumId :: WS Int
698+getNumId :: (PandocMonad m) => WS m Int
705699getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
706700
707701
708−makeTOC :: WriterOptions -> WS [Element]
702+makeTOC :: (PandocMonad m) => WriterOptions -> WS m [Element]
709703makeTOC opts | writerTableOfContents opts = do
710704 let depth = "1-"++(show (writerTOCDepth opts))
711705 let tocCmd = "TOC \\o \""++depth++"\" \\h \\z \\u"
@@ -735,7 +729,7 @@ makeTOC _ = return []
735729
736730-- | Convert Pandoc document to two lists of
737731-- OpenXML elements (the main document and footnotes).
738−writeOpenXML :: WriterOptions -> Pandoc -> WS ([Element], [Element])
732+writeOpenXML :: (PandocMonad m) => WriterOptions -> Pandoc -> WS m ([Element], [Element])
739733writeOpenXML opts (Pandoc meta blocks) = do
740734 let tit = docTitle meta ++ case lookupMeta "subtitle" meta of
741735 Just (MetaBlocks [Plain xs]) -> LineBreak : xs
@@ -770,13 +764,13 @@ writeOpenXML opts (Pandoc meta blocks) = do
770764 return (meta' ++ doc', notes')
771765
772766-- | Convert a list of Pandoc blocks to OpenXML.
773−blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
767+blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element]
774768blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls
775769
776770pCustomStyle :: String -> Element
777771pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
778772
779−pStyleM :: String -> WS XML.Element
773+pStyleM :: (PandocMonad m) => String -> WS m XML.Element
780774pStyleM styleName = do
781775 styleMaps <- gets stStyleMaps
782776 let sty' = getStyleId styleName $ sParaStyleMap styleMaps
@@ -785,13 +779,13 @@ pStyleM styleName = do
785779rCustomStyle :: String -> Element
786780rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
787781
788−rStyleM :: String -> WS XML.Element
782+rStyleM :: (PandocMonad m) => String -> WS m XML.Element
789783rStyleM styleName = do
790784 styleMaps <- gets stStyleMaps
791785 let sty' = getStyleId styleName $ sCharStyleMap styleMaps
792786 return $ mknode "w:rStyle" [("w:val",sty')] ()
793787
794−getUniqueId :: PandocAction String
788+getUniqueId :: (PandocMonad m) => m String
795789-- the + 20 is to ensure that there are no clashes with the rIds
796790-- already in word/document.xml.rel
797791getUniqueId = (show . (+ 20)) <$> P.newUniqueHash
@@ -801,10 +795,10 @@ dynamicStyleKey :: String
801795dynamicStyleKey = "custom-style"
802796
803797-- | Convert a Pandoc block element to OpenXML.
804−blockToOpenXML :: WriterOptions -> Block -> WS [Element]
798+blockToOpenXML :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element]
805799blockToOpenXML opts blk = withDirection $ blockToOpenXML' opts blk
806800
807−blockToOpenXML' :: WriterOptions -> Block -> WS [Element]
801+blockToOpenXML' :: (PandocMonad m) => WriterOptions -> Block -> WS m [Element]
808802blockToOpenXML' _ Null = return []
809803blockToOpenXML' opts (Div (ident,classes,kvs) bs)
810804 | Just sty <- lookup dynamicStyleKey kvs = do
@@ -955,7 +949,7 @@ blockToOpenXML' opts (DefinitionList items) = do
955949 setFirstPara
956950 return l
957951
958−definitionListItemToOpenXML :: WriterOptions -> ([Inline],[[Block]]) -> WS [Element]
952+definitionListItemToOpenXML :: (PandocMonad m) => WriterOptions -> ([Inline],[[Block]]) -> WS m [Element]
959953definitionListItemToOpenXML opts (term,defs) = do
960954 term' <- withParaProp (pCustomStyle "DefinitionTerm")
961955 $ blockToOpenXML opts (Para term)
@@ -963,12 +957,12 @@ definitionListItemToOpenXML opts (term,defs) = do
963957 $ concat `fmap` mapM (blocksToOpenXML opts) defs
964958 return $ term' ++ defs'
965959
966−addList :: ListMarker -> WS ()
960+addList :: (PandocMonad m) => ListMarker -> WS m ()
967961addList marker = do
968962 lists <- gets stLists
969963 modify $ \st -> st{ stLists = lists ++ [marker] }
970964
971−listItemToOpenXML :: WriterOptions -> Int -> [Block] -> WS [Element]
965+listItemToOpenXML :: (PandocMonad m) => WriterOptions -> Int -> [Block] -> WS m [Element]
972966listItemToOpenXML _ _ [] = return []
973967listItemToOpenXML opts numid (first:rest) = do
974968 first' <- withNumId numid $ blockToOpenXML opts first
@@ -984,30 +978,30 @@ alignmentToString alignment = case alignment of
984978 AlignDefault -> "left"
985979
986980-- | Convert a list of inline elements to OpenXML.
987−inlinesToOpenXML :: WriterOptions -> [Inline] -> WS [Element]
981+inlinesToOpenXML :: (PandocMonad m) => WriterOptions -> [Inline] -> WS m [Element]
988982inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) lst
989983
990−withNumId :: Int -> WS a -> WS a
984+withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
991985withNumId numid = local $ \env -> env{ envListNumId = numid }
992986
993−asList :: WS a -> WS a
987+asList :: (PandocMonad m) => WS m a -> WS m a
994988asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
995989
996−getTextProps :: WS [Element]
990+getTextProps :: (PandocMonad m) => WS m [Element]
997991getTextProps = do
998992 props <- asks envTextProperties
999993 return $ if null props
1000994 then []
1001995 else [mknode "w:rPr" [] props]
1002996
1003−withTextProp :: Element -> WS a -> WS a
997+withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
1004998withTextProp d p =
1005999 local (\env -> env {envTextProperties = d : envTextProperties env}) p
10061000
1007−withTextPropM :: WS Element -> WS a -> WS a
1001+withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
10081002withTextPropM = (. flip withTextProp) . (>>=)
10091003
1010−getParaProps :: Bool -> WS [Element]
1004+getParaProps :: PandocMonad m => Bool -> WS m [Element]
10111005getParaProps displayMathPara = do
10121006 props <- asks envParaProperties
10131007 listLevel <- asks envListLevel
@@ -1022,14 +1016,14 @@ getParaProps displayMathPara = do
10221016 [] -> []
10231017 ps -> [mknode "w:pPr" [] ps]
10241018
1025−withParaProp :: Element -> WS a -> WS a
1019+withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
10261020withParaProp d p =
10271021 local (\env -> env {envParaProperties = d : envParaProperties env}) p
10281022
1029−withParaPropM :: WS Element -> WS a -> WS a
1023+withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
10301024withParaPropM = (. flip withParaProp) . (>>=)
10311025
1032−formattedString :: String -> WS [Element]
1026+formattedString :: PandocMonad m => String -> WS m [Element]
10331027formattedString str = do
10341028 props <- getTextProps
10351029 inDel <- asks envInDel
@@ -1038,14 +1032,14 @@ formattedString str = do
10381032 [ mknode (if inDel then "w:delText" else "w:t")
10391033 [("xml:space","preserve")] (stripInvalidChars str) ] ]
10401034
1041−setFirstPara :: WS ()
1035+setFirstPara :: PandocMonad m => WS m ()
10421036setFirstPara = modify $ \s -> s { stFirstPara = True }
10431037
10441038-- | Convert an inline element to OpenXML.
1045−inlineToOpenXML :: WriterOptions -> Inline -> WS [Element]
1039+inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Element]
10461040inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
10471041
1048−inlineToOpenXML' :: WriterOptions -> Inline -> WS [Element]
1042+inlineToOpenXML' :: PandocMonad m => WriterOptions -> Inline -> WS m [Element]
10491043inlineToOpenXML' _ (Str str) = formattedString str
10501044inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ")
10511045inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ")
@@ -1281,7 +1275,7 @@ defaultFootnotes = [ mknode "w:footnote"
12811275 [ mknode "w:r" [] $
12821276 [ mknode "w:continuationSeparator" [] ()]]]]
12831277
1284−parseXml :: Archive -> Archive -> String -> PandocAction Element
1278+parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element
12851279parseXml refArchive distArchive relpath =
12861280 case findEntryByPath relpath refArchive `mplus`
12871281 findEntryByPath relpath distArchive of
@@ -1299,7 +1293,7 @@ fitToPage (x, y) pageWidth
12991293 (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
13001294 | otherwise = (floor x, floor y)
13011295
1302−withDirection :: WS a -> WS a
1296+withDirection :: PandocMonad m => WS m a -> WS m a
13031297withDirection x = do
13041298 isRTL <- asks envRTL
13051299 paraProps <- asks envParaProperties
src/Text/Pandoc/Writers/EPUB.hs+25−24
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2828
2929Conversion of 'Pandoc' documents to EPUB.
3030-}
31−module Text.Pandoc.Writers.EPUB ( writeEPUB, writeEPUBPure ) where
31+module Text.Pandoc.Writers.EPUB ( writeEPUB ) where
3232import qualified Data.Map as M
3333import qualified Data.Set as Set
3434import Data.Maybe ( fromMaybe, catMaybes )
@@ -64,8 +64,8 @@ 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 Text.Pandoc.Free (PandocAction, runIO)
68−import qualified Text.Pandoc.Free as P
67+import Text.Pandoc.Class (PandocMonad)
68+import qualified Text.Pandoc.Class as P
6969
7070-- A Chapter includes a list of blocks and maybe a section
7171-- number offset. Note, some chapters are unnumbered. The section
@@ -76,7 +76,7 @@ data Chapter = Chapter (Maybe [Int]) [Block]
7676data EPUBState = EPUBState { stMediaPaths :: [(FilePath, (FilePath, Maybe Entry))]
7777 }
7878
79−type E = StateT EPUBState PandocAction
79+type E m = StateT EPUBState m
8080
8181data EPUBMetadata = EPUBMetadata{
8282 epubIdentifier :: [Identifier]
@@ -145,7 +145,7 @@ removeNote :: Inline -> Inline
145145removeNote (Note _) = Str ""
146146removeNote x = x
147147
148−getEPUBMetadata :: WriterOptions -> Meta -> E EPUBMetadata
148+getEPUBMetadata :: PandocMonad m => WriterOptions -> Meta -> E m EPUBMetadata
149149getEPUBMetadata opts meta = do
150150 let md = metadataFromMeta opts meta
151151 let elts = onlyElems $ parseXML $ writerEpubMetadata opts
@@ -335,23 +335,20 @@ metadataFromMeta opts meta = EPUBMetadata{
335335 _ -> Nothing
336336
337337-- | Produce an EPUB file from a Pandoc document.
338−writeEPUB :: WriterOptions -- ^ Writer options
338+writeEPUB :: PandocMonad m
339+ => WriterOptions -- ^ Writer options
339340 -> Pandoc -- ^ Document to convert
340− -> IO B.ByteString
341−writeEPUB opts doc = runIO $ writeEPUBPure opts doc
342−
343−writeEPUBPure :: WriterOptions -- ^ Writer options
344− -> Pandoc -- ^ Document to convert
345− -> PandocAction B.ByteString
346−writeEPUBPure opts doc =
341+ -> m B.ByteString
342+writeEPUB opts doc =
347343 let initState = EPUBState { stMediaPaths = []
348344 }
349345 in
350346 evalStateT (pandocToEPUB opts doc) initState
351347
352−pandocToEPUB :: WriterOptions
353− -> Pandoc
354− -> E B.ByteString
348+pandocToEPUB :: PandocMonad m
349+ => WriterOptions
350+ -> Pandoc
351+ -> E m B.ByteString
355352pandocToEPUB opts doc@(Pandoc meta _) = do
356353 let version = fromMaybe EPUB2 (writerEpubVersion opts)
357354 let epub3 = version == EPUB3
@@ -829,10 +826,11 @@ metadataElement version md currentTime =
829826showDateTimeISO8601 :: UTCTime -> String
830827showDateTimeISO8601 = formatTime defaultTimeLocale "%FT%TZ"
831828
832−transformTag :: WriterOptions
829+transformTag :: PandocMonad m
830+ => WriterOptions
833831 -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
834832 -> Tag String
835− -> E (Tag String)
833+ -> E m (Tag String)
836834transformTag opts tag@(TagOpen name attr)
837835 | name `elem` ["video", "source", "img", "audio"] &&
838836 lookup "data-external" attr == Nothing = do
@@ -846,9 +844,10 @@ transformTag opts tag@(TagOpen name attr)
846844 return $ TagOpen name attr'
847845transformTag _ tag = return tag
848846
849−modifyMediaRef :: WriterOptions
847+modifyMediaRef :: PandocMonad m
848+ => WriterOptions
850849 -> FilePath
851− -> E FilePath
850+ -> E m FilePath
852851modifyMediaRef _ "" = return ""
853852modifyMediaRef opts oldsrc = do
854853 media <- gets stMediaPaths
@@ -872,10 +871,11 @@ modifyMediaRef opts oldsrc = do
872871 modify $ \st -> st{ stMediaPaths = (oldsrc, (new, mbEntry)):media}
873872 return new
874873
875−transformBlock :: WriterOptions
874+transformBlock :: PandocMonad m
875+ => WriterOptions
876876 -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath, entry) media
877877 -> Block
878− -> E Block
878+ -> E m Block
879879transformBlock opts (RawBlock fmt raw)
880880 | fmt == Format "html" = do
881881 let tags = parseTags raw
@@ -883,10 +883,11 @@ transformBlock opts (RawBlock fmt raw)
883883 return $ RawBlock fmt (renderTags' tags')
884884transformBlock _ b = return b
885885
886−transformInline :: WriterOptions
886+transformInline :: PandocMonad m
887+ => WriterOptions
887888 -- -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media
888889 -> Inline
889− -> E Inline
890+ -> E m Inline
890891transformInline opts (Image attr lab (src,tit)) = do
891892 newsrc <- modifyMediaRef opts src
892893 return $ Image attr lab (newsrc, tit)
src/Text/Pandoc/Writers/FB2.hs+27−30
@@ -25,7 +25,7 @@ FictionBook is an XML-based e-book format. For more information see:
2525<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1>
2626
2727-}
28−module Text.Pandoc.Writers.FB2 (writeFB2, writeFB2Pure) where
28+module Text.Pandoc.Writers.FB2 (writeFB2) where
2929
3030import Control.Monad.State (StateT, evalStateT, get, modify, lift)
3131import Control.Monad.State (liftM)
@@ -45,8 +45,8 @@ import Text.Pandoc.Definition
4545import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
4646import Text.Pandoc.Shared (orderedListMarkers, isHeaderBlock, capitalize,
4747 linesToPara)
48−import Text.Pandoc.Free (PandocAction, runIO)
49−import qualified Text.Pandoc.Free as P
48+import Text.Pandoc.Class (PandocMonad)
49+import qualified Text.Pandoc.Class as P
5050
5151-- | Data to be written at the end of the document:
5252-- (foot)notes, URLs, references, images.
@@ -59,7 +59,7 @@ data FbRenderState = FbRenderState
5959 } deriving (Show)
6060
6161-- | FictionBook building monad.
62−type FBM = StateT FbRenderState PandocAction
62+type FBM m = StateT FbRenderState m
6363
6464newFB :: FbRenderState
6565newFB = FbRenderState { footnotes = [], imagesToFetch = []
@@ -72,19 +72,16 @@ instance Show ImageMode where
7272 show InlineImage = "inlineImageType"
7373
7474-- | Produce an FB2 document from a 'Pandoc' document.
75−writeFB2 :: WriterOptions -- ^ conversion options
75+writeFB2 :: PandocMonad m
76+ => WriterOptions -- ^ conversion options
7677 -> Pandoc -- ^ document to convert
77− -> IO String -- ^ FictionBook2 document (not encoded yet)
78−writeFB2 opts doc = runIO $ writeFB2Pure opts doc
78+ -> m String -- ^ FictionBook2 document (not encoded yet)
79+writeFB2 opts doc = flip evalStateT newFB $ pandocToFB2 opts doc
7980
80−writeFB2Pure :: WriterOptions
81− -> Pandoc
82− -> PandocAction String
83−writeFB2Pure opts doc = flip evalStateT newFB $ pandocToFB2 opts doc
84−
85−pandocToFB2 :: WriterOptions
81+pandocToFB2 :: PandocMonad m
82+ => WriterOptions
8683 -> Pandoc
87− -> FBM String
84+ -> FBM m String
8885pandocToFB2 opts (Pandoc meta blocks) = do
8986 modify (\s -> s { writerOptions = opts { writerOptions = opts } })
9087 desc <- description meta
@@ -104,7 +101,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
104101 in [ uattr "xmlns" xmlns
105102 , attr ("xmlns", "l") xlink ]
106103
107−frontpage :: Meta -> FBM [Content]
104+frontpage :: PandocMonad m => Meta -> FBM m [Content]
108105frontpage meta' = do
109106 t <- cMapM toXml . docTitle $ meta'
110107 return $
@@ -113,7 +110,7 @@ frontpage meta' = do
113110 (docAuthors meta' ++ [docDate meta']))
114111 ]
115112
116−description :: Meta -> FBM Content
113+description :: PandocMonad m => Meta -> FBM m Content
117114description meta' = do
118115 bt <- booktitle meta'
119116 let as = authors meta'
@@ -123,7 +120,7 @@ description meta' = do
123120 , el "document-info" [ el "program-used" "pandoc" ] -- FIXME: +version
124121 ]
125122
126−booktitle :: Meta -> FBM [Content]
123+booktitle :: PandocMonad m => Meta -> FBM m [Content]
127124booktitle meta' = do
128125 t <- cMapM toXml . docTitle $ meta'
129126 return $ if null t
@@ -148,7 +145,7 @@ author ss =
148145 ([]) -> []
149146 in list $ el "author" (names ++ email)
150147
151−docdate :: Meta -> FBM [Content]
148+docdate :: PandocMonad m => Meta -> FBM m [Content]
152149docdate meta' = do
153150 let ss = docDate meta'
154151 d <- cMapM toXml ss
@@ -158,12 +155,12 @@ docdate meta' = do
158155
159156-- | Divide the stream of blocks into sections and convert to XML
160157-- representation.
161−renderSections :: Int -> [Block] -> FBM [Content]
158+renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content]
162159renderSections level blocks = do
163160 let secs = splitSections level blocks
164161 mapM (renderSection level) secs
165162
166−renderSection :: Int -> ([Inline], [Block]) -> FBM Content
163+renderSection :: PandocMonad m => Int -> ([Inline], [Block]) -> FBM m Content
167164renderSection level (ttl, body) = do
168165 title <- if null ttl
169166 then return []
@@ -210,7 +207,7 @@ splitSections level blocks = reverse $ revSplit (reverse blocks)
210207 sameLevel _ = False
211208
212209-- | Make another FictionBook body with footnotes.
213−renderFootnotes :: FBM [Content]
210+renderFootnotes :: PandocMonad m => FBM m [Content]
214211renderFootnotes = do
215212 fns <- footnotes `liftM` get
216213 if null fns
@@ -224,14 +221,14 @@ renderFootnotes = do
224221
225222-- | Fetch images and encode them for the FictionBook XML.
226223-- Return image data and a list of hrefs of the missing images.
227−fetchImages :: [(String,String)] -> PandocAction ([Content],[String])
224+fetchImages :: PandocMonad m => [(String,String)] -> m ([Content],[String])
228225fetchImages links = do
229226 imgs <- mapM (uncurry fetchImage) links
230227 return $ (rights imgs, lefts imgs)
231228
232229-- | Fetch image data from disk or from network and make a <binary> XML section.
233230-- Return either (Left hrefOfMissingImage) or (Right xmlContent).
234−fetchImage :: String -> String -> PandocAction (Either String Content)
231+fetchImage :: PandocMonad m => String -> String -> m (Either String Content)
235232fetchImage href link = do
236233 mbimg <-
237234 case (isURI link, readDataURI link) of
@@ -298,7 +295,7 @@ linkID :: Int -> String
298295linkID i = "l" ++ (show i)
299296
300297-- | Convert a block-level Pandoc's element to FictionBook XML representation.
301−blockToXml :: Block -> FBM [Content]
298+blockToXml :: PandocMonad m => Block -> FBM m [Content]
302299blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2
303300blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula
304301-- title beginning with fig: indicates that the image is a figure
@@ -362,11 +359,11 @@ blockToXml (Table caption aligns _ headers rows) = do
362359 c <- return . el "emphasis" =<< cMapM toXml caption
363360 return [el "table" (hd : bd), el "p" c]
364361 where
365− mkrow :: String -> [TableCell] -> [Alignment] -> FBM Content
362+ mkrow :: PandocMonad m => String -> [TableCell] -> [Alignment] -> FBM m Content
366363 mkrow tag cells aligns' =
367364 (el "tr") `liftM` (mapM (mkcell tag) (zip cells aligns'))
368365 --
369− mkcell :: String -> (TableCell, Alignment) -> FBM Content
366+ mkcell :: PandocMonad m => String -> (TableCell, Alignment) -> FBM m Content
370367 mkcell tag (cell, align) = do
371368 cblocks <- cMapM blockToXml cell
372369 return $ el tag ([align_attr align], cblocks)
@@ -410,7 +407,7 @@ indent = indentBlock
410407 in intercalate [LineBreak] $ map ((Str spacer):) lns
411408
412409-- | Convert a Pandoc's Inline element to FictionBook XML representation.
413−toXml :: Inline -> FBM [Content]
410+toXml :: PandocMonad m => Inline -> FBM m [Content]
414411toXml (Str s) = return [txt s]
415412toXml (Span _ ils) = cMapM toXml ils
416413toXml (Emph ss) = list `liftM` wrap "emphasis" ss
@@ -462,7 +459,7 @@ toXml (Note bs) = do
462459 , uattr "type" "note" ]
463460 , fn_ref )
464461
465−insertMath :: ImageMode -> String -> FBM [Content]
462+insertMath :: PandocMonad m => ImageMode -> String -> FBM m [Content]
466463insertMath immode formula = do
467464 htmlMath <- return . writerHTMLMathMethod . writerOptions =<< get
468465 case htmlMath of
@@ -473,7 +470,7 @@ insertMath immode formula = do
473470 insertImage immode img
474471 _ -> return [el "code" formula]
475472
476−insertImage :: ImageMode -> Inline -> FBM [Content]
473+insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content]
477474insertImage immode (Image _ alt (url,ttl)) = do
478475 images <- imagesToFetch `liftM` get
479476 let n = 1 + length images
@@ -539,7 +536,7 @@ replaceImagesWithAlt missingHrefs body =
539536
540537
541538-- | Wrap all inlines with an XML tag (given its unqualified name).
542−wrap :: String -> [Inline] -> FBM Content
539+wrap :: PandocMonad m => String -> [Inline] -> FBM m Content
543540wrap tagname inlines = el tagname `liftM` cMapM toXml inlines
544541
545542-- " Create a singleton list.
src/Text/Pandoc/Writers/ICML.hs+16−20
@@ -28,8 +28,8 @@ import Data.Text as Text (breakOnAll, pack)
2828import Control.Monad.State
2929import Network.URI (isURI)
3030import qualified Data.Set as Set
31−import Text.Pandoc.Free (runIO, PandocAction)
32−import qualified Text.Pandoc.Free as P
31+import Text.Pandoc.Class (PandocMonad)
32+import qualified Text.Pandoc.Class as P
3333
3434type Style = [String]
3535type Hyperlink = [(Int, String)]
@@ -42,7 +42,7 @@ data WriterState = WriterState{
4242 , maxListDepth :: Int
4343 }
4444
45−type WS a = StateT WriterState PandocAction a
45+type WS m = StateT WriterState m
4646
4747defaultWriterState :: WriterState
4848defaultWriterState = WriterState{
@@ -124,12 +124,8 @@ footnoteName = "Footnote"
124124citeName = "Cite"
125125
126126-- | Convert Pandoc document to string in ICML format.
127−writeICML :: WriterOptions -> Pandoc -> IO String
128−writeICML opts doc = runIO $ writeICMLPure opts doc
129−
130−-- | Convert Pandoc document to string in ICML format.
131−writeICMLPure :: WriterOptions -> Pandoc -> PandocAction String
132−writeICMLPure opts (Pandoc meta blocks) = do
127+writeICML :: PandocMonad m => WriterOptions -> Pandoc -> m String
128+writeICML opts (Pandoc meta blocks) = do
133129 let colwidth = if writerWrapText opts == WrapAuto
134130 then Just $ writerColumns opts
135131 else Nothing
@@ -288,13 +284,13 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs
288284
289285
290286-- | Convert a list of Pandoc blocks to ICML.
291−blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc
287+blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
292288blocksToICML opts style lst = do
293289 docs <- mapM (blockToICML opts style) lst
294290 return $ intersperseBrs docs
295291
296292-- | Convert a Pandoc block element to ICML.
297−blockToICML :: WriterOptions -> Style -> Block -> WS Doc
293+blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m Doc
298294blockToICML opts style (Plain lst) = parStyle opts style lst
299295-- title beginning with fig: indicates that the image is a figure
300296blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do
@@ -364,7 +360,7 @@ blockToICML opts style (Div _ lst) = blocksToICML opts style lst
364360blockToICML _ _ Null = return empty
365361
366362-- | Convert a list of lists of blocks to ICML list items.
367−listItemsToICML :: WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS Doc
363+listItemsToICML :: PandocMonad m => WriterOptions -> String -> Style -> Maybe ListAttributes -> [[Block]] -> WS m Doc
368364listItemsToICML _ _ _ _ [] = return empty
369365listItemsToICML opts listType style attribs (first:rest) = do
370366 st <- get
@@ -379,7 +375,7 @@ listItemsToICML opts listType style attribs (first:rest) = do
379375 return $ intersperseBrs docs
380376
381377-- | Convert a list of blocks to ICML list items.
382−listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc
378+listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m Doc
383379listItemToICML opts style isFirst attribs item =
384380 let makeNumbStart (Just (beginsWith, numbStl, _)) =
385381 let doN DefaultStyle = []
@@ -406,7 +402,7 @@ listItemToICML opts style isFirst attribs item =
406402 return $ intersperseBrs (f : r)
407403 else blocksToICML opts stl' item
408404
409−definitionListItemToICML :: WriterOptions -> Style -> ([Inline],[[Block]]) -> WS Doc
405+definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m Doc
410406definitionListItemToICML opts style (term,defs) = do
411407 term' <- parStyle opts (defListTermName:style) term
412408 defs' <- mapM (blocksToICML opts (defListDefName:style)) defs
@@ -414,11 +410,11 @@ definitionListItemToICML opts style (term,defs) = do
414410
415411
416412-- | Convert a list of inline elements to ICML.
417−inlinesToICML :: WriterOptions -> Style -> [Inline] -> WS Doc
413+inlinesToICML :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
418414inlinesToICML opts style lst = vcat `fmap` mapM (inlineToICML opts style) (mergeSpaces lst)
419415
420416-- | Convert an inline element to ICML.
421−inlineToICML :: WriterOptions -> Style -> Inline -> WS Doc
417+inlineToICML :: PandocMonad m => WriterOptions -> Style -> Inline -> WS m Doc
422418inlineToICML _ style (Str str) = charStyle style $ text $ escapeStringForXML str
423419inlineToICML opts style (Emph lst) = inlinesToICML opts (emphName:style) lst
424420inlineToICML opts style (Strong lst) = inlinesToICML opts (strongName:style) lst
@@ -458,7 +454,7 @@ inlineToICML opts style (Note lst) = footnoteToICML opts style lst
458454inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst
459455
460456-- | Convert a list of block elements to an ICML footnote.
461−footnoteToICML :: WriterOptions -> Style -> [Block] -> WS Doc
457+footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m Doc
462458footnoteToICML opts style lst =
463459 let insertTab (Para ls) = blockToICML opts (footnoteName:style) $ Para $ (Str "\t"):ls
464460 insertTab block = blockToICML opts (footnoteName:style) block
@@ -489,7 +485,7 @@ intersperseBrs :: [Doc] -> Doc
489485intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty)
490486
491487-- | Wrap a list of inline elements in an ICML Paragraph Style
492−parStyle :: WriterOptions -> Style -> [Inline] -> WS Doc
488+parStyle :: PandocMonad m => WriterOptions -> Style -> [Inline] -> WS m Doc
493489parStyle opts style lst =
494490 let slipIn x y = if null y
495491 then x
@@ -513,7 +509,7 @@ parStyle opts style lst =
513509 state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st })
514510
515511-- | Wrap a Doc in an ICML Character Style.
516−charStyle :: Style -> Doc -> WS Doc
512+charStyle :: PandocMonad m => Style -> Doc -> WS m Doc
517513charStyle style content =
518514 let (stlStr, attrs) = styleToStrAttr style
519515 doc = inTags True "CharacterStyleRange" attrs $ inTagsSimple "Content" $ flush content
@@ -535,7 +531,7 @@ styleToStrAttr style =
535531 in (stlStr, attrs)
536532
537533-- | Assemble an ICML Image.
538−imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc
534+imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m Doc
539535imageICML opts style attr (src, _) = do
540536 res <- lift $ P.fetchItem (writerSourceURL opts) src
541537 imgS <- case res of
src/Text/Pandoc/Writers/ODT.hs+12−15
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2828
2929Conversion of 'Pandoc' documents to ODT.
3030-}
31−module Text.Pandoc.Writers.ODT ( writeODTPure, writeODT ) where
31+module Text.Pandoc.Writers.ODT ( writeODT ) where
3232import Data.List ( isPrefixOf )
3333import Data.Maybe ( fromMaybe )
3434import Text.XML.Light.Output
@@ -49,33 +49,30 @@ import Text.Pandoc.XML
4949import Text.Pandoc.Pretty
5050import qualified Control.Exception as E
5151import System.FilePath ( takeExtension, takeDirectory, (<.>))
52−import Text.Pandoc.Free ( PandocAction, runIO )
53−import qualified Text.Pandoc.Free as P
52+import Text.Pandoc.Class ( PandocMonad )
53+import qualified Text.Pandoc.Class as P
5454
5555data ODTState = ODTState { stEntries :: [Entry]
5656 }
5757
58−type O = StateT ODTState PandocAction
58+type O m = StateT ODTState m
5959
6060-- | Produce an ODT file from a Pandoc document.
61−writeODT :: WriterOptions -- ^ Writer options
61+writeODT :: PandocMonad m
62+ => WriterOptions -- ^ Writer options
6263 -> Pandoc -- ^ Document to convert
63− -> IO B.ByteString
64−writeODT opts doc = runIO $ writeODTPure opts doc
65−
66−writeODTPure :: WriterOptions
67− -> Pandoc
68− -> PandocAction B.ByteString
69−writeODTPure opts doc =
64+ -> m B.ByteString
65+writeODT opts doc =
7066 let initState = ODTState{ stEntries = []
7167 }
7268 in
7369 evalStateT (pandocToODT opts doc) initState
7470
7571-- | Produce an ODT file from a Pandoc document.
76−pandocToODT :: WriterOptions -- ^ Writer options
72+pandocToODT :: PandocMonad m
73+ => WriterOptions -- ^ Writer options
7774 -> Pandoc -- ^ Document to convert
78− -> O B.ByteString
75+ -> O m B.ByteString
7976pandocToODT opts doc@(Pandoc meta _) = do
8077 let datadir = writerUserDataDir opts
8178 let title = docTitle meta
@@ -145,7 +142,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
145142 return $ fromArchive archive''
146143
147144-- | transform both Image and Math elements
148−transformPicMath :: WriterOptions ->Inline -> O Inline
145+transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline
149146transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = do
150147 res <- lift $ P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
151148 case res of
src/Text/Pandoc/Writers/RTF.hs+4−9
@@ -29,7 +29,6 @@ Conversion of 'Pandoc' documents to RTF (rich text format).
2929-}
3030module Text.Pandoc.Writers.RTF ( writeRTF
3131 , writeRTFWithEmbeddedImages
32− , writeRTFWithEmbeddedImagesPure
3332 ) where
3433import Text.Pandoc.Definition
3534import Text.Pandoc.Options
@@ -44,13 +43,13 @@ import qualified Data.ByteString as B
4443import qualified Data.Map as M
4544import Text.Printf ( printf )
4645import Text.Pandoc.ImageSize
47−import Text.Pandoc.Free (PandocAction, runIO)
48−import qualified Text.Pandoc.Free as P
46+import Text.Pandoc.Class (PandocMonad)
47+import qualified Text.Pandoc.Class as P
4948
5049-- | Convert Image inlines into a raw RTF embedded image, read from a file,
5150-- or a MediaBag, or the internet.
5251-- If file not found or filetype not jpeg or png, leave the inline unchanged.
53−rtfEmbedImage :: WriterOptions -> Inline -> PandocAction Inline
52+rtfEmbedImage :: PandocMonad m => WriterOptions -> Inline -> m Inline
5453rtfEmbedImage opts x@(Image attr _ (src,_)) = do
5554 result <- P.fetchItem' (writerMediaBag opts) (writerSourceURL opts) src
5655 case result of
@@ -83,12 +82,8 @@ rtfEmbedImage _ x = return x
8382
8483-- | Convert Pandoc to a string in rich text format, with
8584-- images embedded as encoded binary data.
86−writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String
85+writeRTFWithEmbeddedImages :: PandocMonad m => WriterOptions -> Pandoc -> m String
8786writeRTFWithEmbeddedImages options doc =
88− runIO $ writeRTF options `fmap` walkM (rtfEmbedImage options) doc
89−
90−writeRTFWithEmbeddedImagesPure :: WriterOptions -> Pandoc -> PandocAction String
91−writeRTFWithEmbeddedImagesPure options doc =
9287 writeRTF options `fmap` walkM (rtfEmbedImage options) doc
9388
9489-- | Convert Pandoc to a string in rich text format.