@@ -58,9 +58,7 @@ import Control.Monad.State
5858import Data.List (intercalate)
5959import Data.Default
6060import Text.Pandoc.Definition
61−import Text.Pandoc.Class (PandocMonad)
6261import Text.Pandoc.Slides (getSlideLevel)
63−import qualified Text.Pandoc.Class as P
6462import Text.Pandoc.Options
6563import Text.Pandoc.Logging
6664import Text.Pandoc.Walk
@@ -97,17 +95,23 @@ instance Default WriterEnv where
9795data WriterState = WriterState { stNoteIds :: M.Map Int [Block]
9896 -- associate anchors with slide id
9997 , stAnchorMap :: M.Map String Int
98+ , stLog :: [LogMessage]
10099 } deriving (Show, Eq)
101100
102101instance Default WriterState where
103102 def = WriterState { stNoteIds = mempty
104− , stAnchorMap= mempty
103+ , stAnchorMap = mempty
104+ , stLog = []
105105 }
106106
107−type Pres m = ReaderT WriterEnv (StateT WriterState m)
107+addLogMessage :: LogMessage -> Pres ()
108+addLogMessage msg = modify $ \st -> st{stLog = msg : (stLog st)}
108109
109−runPres :: Monad m => WriterEnv -> WriterState -> Pres m a -> m a
110−runPres env st p = evalStateT (runReaderT p env) st
110+type Pres = ReaderT WriterEnv (State WriterState)
111+
112+runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
113+runPres env st p = (pres, reverse $ stLog finalSt)
114+ where (pres, finalSt) = runState (runReaderT p env) st
111115
112116-- GHC 7.8 will still complain about concat <$> mapM unless we specify
113117-- Functor. We can get rid of this when we stop supporting GHC 7.8.
@@ -234,10 +238,10 @@ instance Default PicProps where
234238
235239--------------------------------------------------
236240
237−inlinesToParElems :: Monad m => [Inline] -> Pres m [ParaElem]
241+inlinesToParElems :: [Inline] -> Pres [ParaElem]
238242inlinesToParElems ils = concatMapM inlineToParElems ils
239243
240−inlineToParElems :: Monad m => Inline -> Pres m [ParaElem]
244+inlineToParElems :: Inline -> Pres [ParaElem]
241245inlineToParElems (Str s) = do
242246 pr <- asks envRunProps
243247 return [Run pr s]
@@ -288,7 +292,7 @@ isListType (BulletList _) = True
288292isListType (DefinitionList _) = True
289293isListType _ = False
290294
291−registerAnchorId :: PandocMonad m => String -> Pres m ()
295+registerAnchorId :: String -> Pres ()
292296registerAnchorId anchor = do
293297 anchorMap <- gets stAnchorMap
294298 slideId <- asks envCurSlideId
@@ -302,7 +306,7 @@ blockQuoteSize = 20
302306noteSize :: Pixels
303307noteSize = 18
304308
305−blockToParagraphs :: PandocMonad m => Block -> Pres m [Paragraph]
309+blockToParagraphs :: Block -> Pres [Paragraph]
306310blockToParagraphs (Plain ils) = do
307311 parElems <- inlinesToParElems ils
308312 pProps <- asks envParaProps
@@ -362,7 +366,7 @@ blockToParagraphs (OrderedList listAttr blksLst) = do
362366 }}) $
363367 concatMapM multiParBullet blksLst
364368blockToParagraphs (DefinitionList entries) = do
365− let go :: PandocMonad m => ([Inline], [[Block]]) -> Pres m [Paragraph]
369+ let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
366370 go (ils, blksLst) = do
367371 term <-blockToParagraphs $ Para [Strong ils]
368372 -- For now, we'll treat each definition term as a
@@ -373,11 +377,11 @@ blockToParagraphs (DefinitionList entries) = do
373377blockToParagraphs (Div (_, ("notes" : []), _) _) = return []
374378blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks
375379blockToParagraphs blk = do
376− P.report $ BlockNotRendered blk
380+ addLogMessage $ BlockNotRendered blk
377381 return []
378382
379383-- Make sure the bullet env gets turned off after the first para.
380−multiParBullet :: PandocMonad m => [Block] -> Pres m [Paragraph]
384+multiParBullet :: [Block] -> Pres [Paragraph]
381385multiParBullet [] = return []
382386multiParBullet (b:bs) = do
383387 pProps <- asks envParaProps
@@ -386,7 +390,7 @@ multiParBullet (b:bs) = do
386390 concatMapM blockToParagraphs bs
387391 return $ p ++ ps
388392
389−cellToParagraphs :: PandocMonad m => Alignment -> TableCell -> Pres m [Paragraph]
393+cellToParagraphs :: Alignment -> TableCell -> Pres [Paragraph]
390394cellToParagraphs algn tblCell = do
391395 paras <- mapM (blockToParagraphs) tblCell
392396 let alignment = case algn of
@@ -397,13 +401,13 @@ cellToParagraphs algn tblCell = do
397401 paras' = map (map (\p -> p{paraProps = (paraProps p){pPropAlign = alignment}})) paras
398402 return $ concat paras'
399403
400−rowToParagraphs :: PandocMonad m => [Alignment] -> [TableCell] -> Pres m [[Paragraph]]
404+rowToParagraphs :: [Alignment] -> [TableCell] -> Pres [[Paragraph]]
401405rowToParagraphs algns tblCells = do
402406 -- We have to make sure we have the right number of alignments
403407 let pairs = zip (algns ++ repeat AlignDefault) tblCells
404408 mapM (\(a, tc) -> cellToParagraphs a tc) pairs
405409
406−blockToShape :: PandocMonad m => Block -> Pres m Shape
410+blockToShape :: Block -> Pres Shape
407411blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
408412 Pic def url attr <$> (inlinesToParElems ils)
409413blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =
@@ -441,7 +445,7 @@ combineShapes ((TextBox (p:ps)) : (TextBox (p':ps')) : ss) =
441445 combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss
442446combineShapes (s:ss) = s : combineShapes ss
443447
444−blocksToShapes :: PandocMonad m => [Block] -> Pres m [Shape]
448+blocksToShapes :: [Block] -> Pres [Shape]
445449blocksToShapes blks = combineShapes <$> mapM blockToShape blks
446450
447451isImage :: Inline -> Bool
@@ -449,7 +453,7 @@ isImage (Image _ _ _) = True
449453isImage (Link _ ((Image _ _ _) : _) _) = True
450454isImage _ = False
451455
452−splitBlocks' :: Monad m => [Block] -> [[Block]] -> [Block] -> Pres m [[Block]]
456+splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
453457splitBlocks' cur acc [] = return $ acc ++ (if null cur then [] else [cur])
454458splitBlocks' cur acc (HorizontalRule : blks) =
455459 splitBlocks' [] (acc ++ (if null cur then [] else [cur])) blks
@@ -486,10 +490,10 @@ splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classe
486490 _ -> splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks
487491splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
488492
489−splitBlocks :: Monad m => [Block] -> Pres m [[Block]]
493+splitBlocks :: [Block] -> Pres [[Block]]
490494splitBlocks = splitBlocks' [] []
491495
492−blocksToSlide' :: PandocMonad m => Int -> [Block] -> Pres m Slide
496+blocksToSlide' :: Int -> [Block] -> Pres Slide
493497blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
494498 | n < lvl = do
495499 registerAnchorId ident
@@ -511,9 +515,9 @@ blocksToSlide' _ (blk : blks)
511515 , (Div (_, clsL, _) blksL) : (Div (_, clsR, _) blksR) : remaining <- divBlks
512516 , "column" `elem` clsL, "column" `elem` clsR = do
513517 unless (null blks)
514− (mapM (P.report . BlockNotRendered) blks >> return ())
518+ (mapM (addLogMessage . BlockNotRendered) blks >> return ())
515519 unless (null remaining)
516− (mapM (P.report . BlockNotRendered) remaining >> return ())
520+ (mapM (addLogMessage . BlockNotRendered) remaining >> return ())
517521 mbSplitBlksL <- splitBlocks blksL
518522 mbSplitBlksR <- splitBlocks blksR
519523 let blksL' = case mbSplitBlksL of
@@ -540,7 +544,7 @@ blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []
540544 , contentSlideContent = []
541545 }
542546
543−blocksToSlide :: PandocMonad m => [Block] -> Pres m Slide
547+blocksToSlide :: [Block] -> Pres Slide
544548blocksToSlide blks = do
545549 slideLevel <- asks envSlideLevel
546550 blocksToSlide' slideLevel blks
@@ -553,14 +557,14 @@ makeNoteEntry n blks =
553557 (Para ils : blks') -> (Para $ enum : Space : ils) : blks'
554558 _ -> (Para [enum]) : blks
555559
556−forceFontSize :: PandocMonad m => Pixels -> Pres m a -> Pres m a
560+forceFontSize :: Pixels -> Pres a -> Pres a
557561forceFontSize px x = do
558562 rpr <- asks envRunProps
559563 local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x
560564
561565-- We leave these as blocks because we will want to include them in
562566-- the TOC.
563−makeNotesSlideBlocks :: PandocMonad m => Pres m [Block]
567+makeNotesSlideBlocks :: Pres [Block]
564568makeNotesSlideBlocks = do
565569 noteIds <- gets stNoteIds
566570 slideLevel <- asks envSlideLevel
@@ -579,7 +583,7 @@ makeNotesSlideBlocks = do
579583 M.toList noteIds
580584 return $ hdr : blks
581585
582−getMetaSlide :: PandocMonad m => Pres m (Maybe Slide)
586+getMetaSlide :: Pres (Maybe Slide)
583587getMetaSlide = do
584588 meta <- asks envMetadata
585589 title <- inlinesToParElems $ docTitle meta
@@ -600,7 +604,7 @@ getMetaSlide = do
600604 , metadataSlideDate = date
601605 }
602606-- adapted from the markdown writer
603−elementToListItem :: PandocMonad m => Shared.Element -> Pres m [Block]
607+elementToListItem :: Shared.Element -> Pres [Block]
604608elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do
605609 opts <- asks envOpts
606610 let headerLink = if null ident
@@ -613,7 +617,7 @@ elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do
613617 return [Plain headerLink, BulletList listContents]
614618elementToListItem (Shared.Blk _) = return []
615619
616−makeTOCSlide :: PandocMonad m => [Block] -> Pres m Slide
620+makeTOCSlide :: [Block] -> Pres Slide
617621makeTOCSlide blks = do
618622 contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks)
619623 meta <- asks envMetadata
@@ -676,7 +680,7 @@ applyToSlide f (TwoColumnSlide hdr contentL contentR) = do
676680 contentR' <- mapM (applyToShape f) contentR
677681 return $ TwoColumnSlide hdr' contentL' contentR'
678682
679−replaceAnchor :: PandocMonad m => ParaElem -> Pres m ParaElem
683+replaceAnchor :: ParaElem -> Pres ParaElem
680684replaceAnchor (Run rProps s)
681685 | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do
682686 anchorMap <- gets stAnchorMap
@@ -688,7 +692,7 @@ replaceAnchor (Run rProps s)
688692 return $ Run rProps' s
689693replaceAnchor pe = return pe
690694
691−blocksToPresentation :: PandocMonad m => [Block] -> Pres m Presentation
695+blocksToPresentation :: [Block] -> Pres Presentation
692696blocksToPresentation blks = do
693697 opts <- asks envOpts
694698 let metadataStartNum = 1
@@ -732,10 +736,9 @@ blocksToPresentation blks = do
732736 slides' <- mapM (applyToSlide replaceAnchor) slides
733737 return $ Presentation slides'
734738
735−documentToPresentation :: PandocMonad m
736− => WriterOptions
739+documentToPresentation :: WriterOptions
737740 -> Pandoc
738− -> m Presentation
741+ -> (Presentation, [LogMessage])
739742documentToPresentation opts (Pandoc meta blks) = do
740743 let env = def { envOpts = opts
741744 , envMetadata = meta