Powerpoint writer: Fix anchor links.

They were broken when I refactored (the Output module wanted to use
state left over from the construction of the Presentation type). This
change introduces a new type `LinkTarget = InternalTarget |
ExternalTarget`. Internal target points to a slide number, and these
will all be resolved before the Presentation is passed along to the
Output module.

src/Text/Pandoc/Writers/Powerpoint/Output.hs

@@ -54,7 +54,7 @@ import Text.Pandoc.MIME
 import qualified Data.ByteString.Lazy as BL
 import Text.Pandoc.Writers.OOXML
 import qualified Data.Map as M
-import Data.Maybe (mapMaybe, listToMaybe, catMaybes)
+import Data.Maybe (mapMaybe, listToMaybe)
 import Text.Pandoc.ImageSize
 import Control.Applicative ((<|>))
 import System.FilePath.Glob
@@ -135,24 +135,16 @@ data MediaInfo = MediaInfo { mInfoFilePath :: FilePath
                            , mInfoCaption  :: Bool
                            } deriving (Show, Eq)
 
-data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int (URL, String))
+data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int LinkTarget)
                                -- (FP, Local ID, Global ID, Maybe Mime)
                                , stMediaIds :: M.Map Int [MediaInfo]
                                , stMediaGlobalIds :: M.Map FilePath Int
-                               , stNoteIds :: M.Map Int [Block]
-                               -- associate anchors with slide id
-                               , stAnchorMap :: M.Map String Int
-                               -- media inherited from the template.
-                               , stTemplateMedia :: [FilePath]
                                } deriving (Show, Eq)
 
 instance Default WriterState where
   def = WriterState { stLinkIds = mempty
                     , stMediaIds = mempty
                     , stMediaGlobalIds = mempty
-                    , stNoteIds = mempty
-                    , stAnchorMap= mempty
-                    , stTemplateMedia = []
                     }
 
 type P m = ReaderT WriterEnv (StateT WriterState m)
@@ -420,7 +412,7 @@ replaceNamedChildren ns prefix name newKids element =
 
 ----------------------------------------------------------------
 
-registerLink :: PandocMonad m => (URL, String) -> P m Int
+registerLink :: PandocMonad m => LinkTarget -> P m Int
 registerLink link = do
   curSlideId <- asks envCurSlideId
   linkReg <- gets stLinkIds
@@ -729,20 +721,15 @@ paraElemToElement (Run rpr s) = do
                    -- first we have to make sure that if it's an
                    -- anchor, it's in the anchor map. If not, there's
                    -- no link.
-                   anchorMap <- gets stAnchorMap
                    return $ case link of
-                     -- anchor with nothing in the map
+                     InternalTarget _ ->
-                     ('#':target, _) | Nothing <- M.lookup target anchorMap ->
-                       []
-                     --  anchor that is in the map
-                     ('#':_, _) ->
                        let linkAttrs =
                              [ ("r:id", "rId" ++ show idNum)
                              , ("action", "ppaction://hlinksldjump")
                              ]
                        in [mknode "a:hlinkClick" linkAttrs ()]
                      -- external
-                     _ ->
+                     ExternalTarget _ ->
                        let linkAttrs =
                              [ ("r:id", "rId" ++ show idNum)
                              ]
@@ -1191,31 +1178,23 @@ slideToSlideRelEntry slide idNum = do
   element <- slideToSlideRelElement slide idNum
   elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element
 
-linkRelElement :: PandocMonad m => Int -> (URL, String) -> P m (Maybe Element)
+linkRelElement :: PandocMonad m => Int -> LinkTarget -> P m Element
-linkRelElement idNum (url, _) = do
+linkRelElement idNum (InternalTarget num) = do
-  anchorMap <- gets stAnchorMap
+  return $
-  case url of
-    -- if it's an anchor in the map, we use the slide number for an
-    -- internal link.
-    '#' : anchor | Just num <- M.lookup anchor anchorMap ->
-      return $ Just $
     mknode "Relationship" [ ("Id", "rId" ++ show idNum)
                           , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
                           , ("Target", "slide" ++ show num ++ ".xml")
                           ] ()
-    -- if it's an anchor not in the map, we return nothing.
+linkRelElement idNum (ExternalTarget (url, _)) = do
-    '#' : _ -> return Nothing
+  return $
-    -- Anything else we treat as an external link
-    _ ->
-      return $ Just $
     mknode "Relationship" [ ("Id", "rId" ++ show idNum)
                           , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
                           , ("Target", url)
                           , ("TargetMode", "External")
                           ] ()
 
-linkRelElements :: PandocMonad m => M.Map Int (URL, String) -> P m [Element]
+linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element]
-linkRelElements mp = catMaybes <$> mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)
+linkRelElements mp = mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)
 
 mediaRelElement :: MediaInfo -> Element
 mediaRelElement mInfo =

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs

@@ -35,7 +35,6 @@ Presentation.
 module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
                                                    , Presentation(..)
                                                    , Slide(..)
-                                                   , SlideElement(..)
                                                    , Shape(..)
                                                    , Graphic(..)
                                                    , BulletType(..)
@@ -50,6 +49,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
                                                    , PicProps(..)
                                                    , URL
                                                    , TeXString(..)
+                                                   , LinkTarget(..)
                                                    ) where
 
 
@@ -78,10 +78,6 @@ data WriterEnv = WriterEnv { envMetadata :: Meta
                            , envInList :: Bool
                            , envInNoteSlide :: Bool
                            , envCurSlideId :: Int
-                           -- the difference between the number at
-                           -- the end of the slide file name and
-                           -- the rId number
-                           , envSlideIdOffset :: Int
                            }
                  deriving (Show)
 
@@ -95,7 +91,6 @@ instance Default WriterEnv where
                   , envInList = False
                   , envInNoteSlide = False
                   , envCurSlideId = 1
-                  , envSlideIdOffset = 1
                   }
 
 
@@ -139,9 +134,6 @@ data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]
                             }
            deriving (Show, Eq)
 
-data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape
-  deriving (Show, Eq)
-
 data Shape = Pic PicProps FilePath Text.Pandoc.Definition.Attr [ParaElem]
            | GraphicFrame [Graphic] [ParaElem]
            | TextBox [Paragraph]
@@ -206,12 +198,16 @@ data Capitals = NoCapitals | SmallCapitals | AllCapitals
 
 type URL = String
 
+data LinkTarget = ExternalTarget (URL, String)
+                | InternalTarget Int -- slideId
+                deriving (Show, Eq)
+
 data RunProps = RunProps { rPropBold :: Bool
                          , rPropItalics :: Bool
                          , rStrikethrough :: Maybe Strikethrough
                          , rBaseline :: Maybe Int
                          , rCap :: Maybe Capitals
-                         , rLink :: Maybe (URL, String)
+                         , rLink :: Maybe LinkTarget
                          , rPropCode :: Bool
                          , rPropBlockQuote :: Bool
                          , rPropForceSize :: Maybe Pixels
@@ -229,7 +225,7 @@ instance Default RunProps where
                  , rPropForceSize = Nothing
                  }
 
-data PicProps = PicProps { picPropLink :: Maybe (URL, String)
+data PicProps = PicProps { picPropLink :: Maybe LinkTarget
                          } deriving (Show, Eq)
 
 instance Default PicProps where
@@ -267,7 +263,7 @@ inlineToParElems Space = inlineToParElems (Str " ")
 inlineToParElems SoftBreak = inlineToParElems (Str " ")
 inlineToParElems LineBreak = return [Break]
 inlineToParElems (Link _ ils (url, title)) = do
-  local (\r ->r{envRunProps = (envRunProps r){rLink = Just (url, title)}}) $
+  local (\r ->r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) $
     inlinesToParElems ils
 inlineToParElems (Code _ str) = do
   local (\r ->r{envRunProps = (envRunProps r){rPropCode = True}}) $
@@ -414,10 +410,10 @@ blockToShape (Para (il:_))  | Image attr ils (url, _) <- il =
       Pic def url attr <$> (inlinesToParElems ils)
 blockToShape (Plain (il:_)) | Link _ (il':_) target <- il
                             , Image attr ils (url, _) <- il' =
-      Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)
+      Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)
 blockToShape (Para (il:_))  | Link _ (il':_) target <- il
                             , Image attr ils (url, _) <- il' =
-      Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)
+      Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)
 blockToShape (Table caption algn _ hdrCells rows) = do
   caption' <- inlinesToParElems caption
   hdrCells' <- rowToParagraphs algn hdrCells
@@ -644,6 +640,51 @@ combineParaElems' (Just pElem') (pElem : pElems)
 combineParaElems :: [ParaElem] -> [ParaElem]
 combineParaElems = combineParaElems' Nothing
 
+applyToParagraph :: Monad m => (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
+applyToParagraph f para = do
+  paraElems' <- mapM f $ paraElems para
+  return $ para {paraElems = paraElems'}
+
+applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
+applyToShape f (Pic pPr fp attr pes) = do
+  pes' <- mapM f pes
+  return $ Pic pPr fp attr pes'
+applyToShape f (GraphicFrame gfx pes) = do
+  pes' <- mapM f pes
+  return $ GraphicFrame gfx pes'
+applyToShape f (TextBox paras) = do
+  paras' <- mapM (applyToParagraph f) paras
+  return $ TextBox paras'
+
+applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
+applyToSlide f (MetadataSlide title subtitle authors date) = do
+  title' <- mapM f title
+  subtitle' <- mapM f subtitle
+  authors' <- mapM (mapM f) authors
+  date' <- mapM f date
+  return $ MetadataSlide title' subtitle' authors' date'
+applyToSlide f (TitleSlide title) = do
+  title' <- mapM f title
+  return $ TitleSlide title'
+applyToSlide f (ContentSlide hdr content) = do
+  hdr' <- mapM f hdr
+  content' <- mapM (applyToShape f) content
+  return $ ContentSlide hdr' content'
+applyToSlide f (TwoColumnSlide hdr contentL contentR) = do
+  hdr' <- mapM f hdr
+  contentL' <- mapM (applyToShape f) contentL
+  contentR' <- mapM (applyToShape f) contentR
+  return $ TwoColumnSlide hdr' contentL' contentR'
+
+replaceAnchor :: PandocMonad m => ParaElem -> Pres m ParaElem
+replaceAnchor (Run rProps s)
+  | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do
+      anchorMap <- gets stAnchorMap
+      return $ case M.lookup anchor anchorMap of
+                 Just n  -> Run (rProps{rLink = Just $ InternalTarget n}) s
+                 Nothing -> Run rProps s
+replaceAnchor pe = return pe
+
 blocksToPresentation :: PandocMonad m => [Block] -> Pres m Presentation
 blocksToPresentation blks = do
   opts <- asks envOpts
@@ -683,9 +724,10 @@ blocksToPresentation blks = do
                                         })
                            (blocksToSlide $ notesSlideBlocks)
                          return [notesSlide]
-  return $
+
-    Presentation $
+  let slides = metadataslides ++ tocSlides ++ bodyslides ++ notesSlides
-    metadataslides ++ tocSlides ++ bodyslides ++ notesSlides
+  slides' <- mapM (applyToSlide replaceAnchor) slides
+  return $ Presentation slides'
 
 documentToPresentation :: PandocMonad m
                        => WriterOptions