Powerpoint writer: Move Presentation.hs out of PandocMonad

We don't need it for anything but the log messages, and we can just
keep track of that in state and pass it along to the `writePowerpoint`
function. This will simplify the code.

2 files changed, 39 insertions, 35 deletions

diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs
index 3d6b736f2..acb33f582 100644
--- a/src/Text/Pandoc/Writers/Powerpoint.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint.hs
@@ -44,7 +44,7 @@ module Text.Pandoc.Writers.Powerpoint (writePowerpoint) where
 import Codec.Archive.Zip
 import Text.Pandoc.Definition
 import Text.Pandoc.Walk
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad, report)
 import Text.Pandoc.Options (WriterOptions)
 import Text.Pandoc.Writers.Shared (fixDisplayMath)
 import Text.Pandoc.Writers.Powerpoint.Presentation (documentToPresentation)
@@ -57,6 +57,7 @@ writePowerpoint :: (PandocMonad m)
                 -> m BL.ByteString
 writePowerpoint opts (Pandoc meta blks) = do
   let blks' = walk fixDisplayMath blks
-  pres <- documentToPresentation opts (Pandoc meta blks')
+  let (pres, logMsgs) = documentToPresentation opts (Pandoc meta blks')
+  mapM_ report logMsgs
   archv <- presentationToArchive opts pres
   return $ fromArchive archv
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 5ced4e8a8..3c5dd617d 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -58,9 +58,7 @@ import Control.Monad.State
 import Data.List (intercalate)
 import Data.Default
 import Text.Pandoc.Definition
-import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Slides (getSlideLevel)
-import qualified Text.Pandoc.Class as P
 import Text.Pandoc.Options
 import Text.Pandoc.Logging
 import Text.Pandoc.Walk
@@ -97,17 +95,23 @@ instance Default WriterEnv where
 data WriterState = WriterState { stNoteIds :: M.Map Int [Block]
                                -- associate anchors with slide id
                                , stAnchorMap :: M.Map String Int
+                               , stLog :: [LogMessage]
                                } deriving (Show, Eq)
 
 instance Default WriterState where
   def = WriterState { stNoteIds = mempty
-                    , stAnchorMap= mempty
+                    , stAnchorMap = mempty
+                    , stLog = []
                     }
 
-type Pres m = ReaderT WriterEnv (StateT WriterState m)
+addLogMessage :: LogMessage -> Pres ()
+addLogMessage msg = modify $ \st -> st{stLog = msg : (stLog st)}
 
-runPres :: Monad m => WriterEnv -> WriterState -> Pres m a -> m a
-runPres env st p = evalStateT (runReaderT p env) st
+type Pres = ReaderT WriterEnv (State WriterState)
+
+runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
+runPres env st p = (pres, reverse $ stLog finalSt)
+  where (pres, finalSt) = runState (runReaderT p env) st
 
 -- GHC 7.8 will still complain about concat <$> mapM unless we specify
 -- Functor. We can get rid of this when we stop supporting GHC 7.8.
@@ -234,10 +238,10 @@ instance Default PicProps where
 
 --------------------------------------------------
 
-inlinesToParElems :: Monad m => [Inline] -> Pres m [ParaElem]
+inlinesToParElems :: [Inline] -> Pres [ParaElem]
 inlinesToParElems ils = concatMapM inlineToParElems ils
 
-inlineToParElems :: Monad m => Inline -> Pres m [ParaElem]
+inlineToParElems :: Inline -> Pres [ParaElem]
 inlineToParElems (Str s) = do
   pr <- asks envRunProps
   return [Run pr s]
@@ -288,7 +292,7 @@ isListType (BulletList _) = True
 isListType (DefinitionList _) = True
 isListType _ = False
 
-registerAnchorId :: PandocMonad m => String -> Pres m ()
+registerAnchorId :: String -> Pres ()
 registerAnchorId anchor = do
   anchorMap <- gets stAnchorMap
   slideId <- asks envCurSlideId
@@ -302,7 +306,7 @@ blockQuoteSize = 20
 noteSize :: Pixels
 noteSize = 18
 
-blockToParagraphs :: PandocMonad m => Block -> Pres m [Paragraph]
+blockToParagraphs :: Block -> Pres [Paragraph]
 blockToParagraphs (Plain ils) = do
   parElems <- inlinesToParElems ils
   pProps <- asks envParaProps
@@ -362,7 +366,7 @@ blockToParagraphs (OrderedList listAttr blksLst) = do
                                            }}) $
     concatMapM multiParBullet blksLst
 blockToParagraphs (DefinitionList entries) = do
-  let go :: PandocMonad m => ([Inline], [[Block]]) -> Pres m [Paragraph]
+  let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
       go (ils, blksLst) = do
         term <-blockToParagraphs $ Para [Strong ils]
         -- For now, we'll treat each definition term as a
@@ -373,11 +377,11 @@ blockToParagraphs (DefinitionList entries) = do
 blockToParagraphs (Div (_, ("notes" : []), _) _) = return []
 blockToParagraphs (Div _ blks)  = concatMapM blockToParagraphs blks
 blockToParagraphs blk = do
-  P.report $ BlockNotRendered blk
+  addLogMessage $ BlockNotRendered blk
   return []
 
 -- Make sure the bullet env gets turned off after the first para.
-multiParBullet :: PandocMonad m => [Block] -> Pres m [Paragraph]
+multiParBullet :: [Block] -> Pres [Paragraph]
 multiParBullet [] = return []
 multiParBullet (b:bs) = do
   pProps <- asks envParaProps
@@ -386,7 +390,7 @@ multiParBullet (b:bs) = do
     concatMapM blockToParagraphs bs
   return $ p ++ ps
 
-cellToParagraphs :: PandocMonad m => Alignment -> TableCell -> Pres m [Paragraph]
+cellToParagraphs :: Alignment -> TableCell -> Pres [Paragraph]
 cellToParagraphs algn tblCell = do
   paras <- mapM (blockToParagraphs) tblCell
   let alignment = case algn of
@@ -397,13 +401,13 @@ cellToParagraphs algn tblCell = do
       paras' = map (map (\p -> p{paraProps = (paraProps p){pPropAlign = alignment}})) paras
   return $ concat paras'
 
-rowToParagraphs :: PandocMonad m => [Alignment] -> [TableCell] -> Pres m [[Paragraph]]
+rowToParagraphs :: [Alignment] -> [TableCell] -> Pres [[Paragraph]]
 rowToParagraphs algns tblCells = do
   -- We have to make sure we have the right number of alignments
   let pairs = zip (algns ++ repeat AlignDefault) tblCells
   mapM (\(a, tc) -> cellToParagraphs a tc) pairs
 
-blockToShape :: PandocMonad m => Block -> Pres m Shape
+blockToShape :: Block -> Pres Shape
 blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
       Pic def url attr <$> (inlinesToParElems ils)
 blockToShape (Para (il:_))  | Image attr ils (url, _) <- il =
@@ -441,7 +445,7 @@ combineShapes ((TextBox (p:ps)) : (TextBox (p':ps')) : ss) =
   combineShapes $ TextBox ((p:ps) ++ (p':ps')) : ss
 combineShapes (s:ss) = s : combineShapes ss
 
-blocksToShapes :: PandocMonad m => [Block] -> Pres m [Shape]
+blocksToShapes :: [Block] -> Pres [Shape]
 blocksToShapes blks = combineShapes <$> mapM blockToShape blks
 
 isImage :: Inline -> Bool
@@ -449,7 +453,7 @@ isImage (Image _ _ _) = True
 isImage (Link _ ((Image _ _ _) : _) _) = True
 isImage _ = False
 
-splitBlocks' :: Monad m => [Block] -> [[Block]] -> [Block] -> Pres m [[Block]]
+splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
 splitBlocks' cur acc [] = return $ acc ++ (if null cur then [] else [cur])
 splitBlocks' cur acc (HorizontalRule : blks) =
   splitBlocks' [] (acc ++ (if null cur then [] else [cur])) blks
@@ -486,10 +490,10 @@ splitBlocks' cur acc (d@(Div (_, classes, _) _): blks) | "columns" `elem` classe
     _ ->  splitBlocks' [] (acc ++ (if null cur then [] else [cur]) ++ [[d]]) blks
 splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
 
-splitBlocks :: Monad m => [Block] -> Pres m [[Block]]
+splitBlocks :: [Block] -> Pres [[Block]]
 splitBlocks = splitBlocks' [] []
 
-blocksToSlide' :: PandocMonad m => Int -> [Block] -> Pres m Slide
+blocksToSlide' :: Int -> [Block] -> Pres Slide
 blocksToSlide' lvl ((Header n (ident, _, _) ils) : blks)
   | n < lvl = do
       registerAnchorId ident
@@ -511,9 +515,9 @@ blocksToSlide' _ (blk : blks)
   , (Div (_, clsL, _) blksL) : (Div (_, clsR, _) blksR) : remaining <- divBlks
   , "column" `elem` clsL, "column" `elem` clsR = do
       unless (null blks)
-        (mapM (P.report . BlockNotRendered) blks >> return ())
+        (mapM (addLogMessage . BlockNotRendered) blks >> return ())
       unless (null remaining)
-        (mapM (P.report . BlockNotRendered) remaining >> return ())
+        (mapM (addLogMessage . BlockNotRendered) remaining >> return ())
       mbSplitBlksL <- splitBlocks blksL
       mbSplitBlksR <- splitBlocks blksR
       let blksL' = case mbSplitBlksL of
@@ -540,7 +544,7 @@ blocksToSlide' _ [] = return $ ContentSlide { contentSlideHeader = []
                                             , contentSlideContent = []
                                             }
 
-blocksToSlide :: PandocMonad m => [Block] -> Pres m Slide
+blocksToSlide :: [Block] -> Pres Slide
 blocksToSlide blks = do
   slideLevel <- asks envSlideLevel
   blocksToSlide' slideLevel blks
@@ -553,14 +557,14 @@ makeNoteEntry n blks =
       (Para ils : blks') -> (Para $ enum : Space : ils) : blks'
       _ -> (Para [enum]) : blks
 
-forceFontSize :: PandocMonad m => Pixels -> Pres m a -> Pres m a
+forceFontSize :: Pixels -> Pres a -> Pres a
 forceFontSize px x = do
   rpr <- asks envRunProps
   local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x
 
 -- We leave these as blocks because we will want to include them in
 -- the TOC.
-makeNotesSlideBlocks :: PandocMonad m => Pres m [Block]
+makeNotesSlideBlocks :: Pres [Block]
 makeNotesSlideBlocks = do
   noteIds <- gets stNoteIds
   slideLevel <- asks envSlideLevel
@@ -579,7 +583,7 @@ makeNotesSlideBlocks = do
                     M.toList noteIds
             return $ hdr : blks
 
-getMetaSlide :: PandocMonad m => Pres m (Maybe Slide)
+getMetaSlide :: Pres (Maybe Slide)
 getMetaSlide  = do
   meta <- asks envMetadata
   title <- inlinesToParElems $ docTitle meta
@@ -600,7 +604,7 @@ getMetaSlide  = do
                                        , metadataSlideDate = date
                                        }
 -- adapted from the markdown writer
-elementToListItem :: PandocMonad m => Shared.Element -> Pres m [Block]
+elementToListItem :: Shared.Element -> Pres [Block]
 elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do
   opts <- asks envOpts
   let headerLink = if null ident
@@ -613,7 +617,7 @@ elementToListItem (Shared.Sec lev _nums (ident,_,_) headerText subsecs) = do
   return [Plain headerLink, BulletList listContents]
 elementToListItem (Shared.Blk _) = return []
 
-makeTOCSlide :: PandocMonad m => [Block] -> Pres m Slide
+makeTOCSlide :: [Block] -> Pres Slide
 makeTOCSlide blks = do
   contents <- BulletList <$> mapM elementToListItem (Shared.hierarchicalize blks)
   meta <- asks envMetadata
@@ -676,7 +680,7 @@ applyToSlide f (TwoColumnSlide hdr contentL contentR) = do
   contentR' <- mapM (applyToShape f) contentR
   return $ TwoColumnSlide hdr' contentL' contentR'
 
-replaceAnchor :: PandocMonad m => ParaElem -> Pres m ParaElem
+replaceAnchor :: ParaElem -> Pres ParaElem
 replaceAnchor (Run rProps s)
   | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do
       anchorMap <- gets stAnchorMap
@@ -688,7 +692,7 @@ replaceAnchor (Run rProps s)
       return $ Run rProps' s
 replaceAnchor pe = return pe
 
-blocksToPresentation :: PandocMonad m => [Block] -> Pres m Presentation
+blocksToPresentation :: [Block] -> Pres Presentation
 blocksToPresentation blks = do
   opts <- asks envOpts
   let metadataStartNum = 1
@@ -732,10 +736,9 @@ blocksToPresentation blks = do
   slides' <- mapM (applyToSlide replaceAnchor) slides
   return $ Presentation slides'
 
-documentToPresentation :: PandocMonad m
-                       => WriterOptions
+documentToPresentation :: WriterOptions
                        -> Pandoc
-                       -> m Presentation
+                       -> (Presentation, [LogMessage])
 documentToPresentation opts (Pandoc meta blks) = do
   let env = def { envOpts = opts
                 , envMetadata = meta