    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TupleSections #-}
    {- |
       Module      : Text.Pandoc.Writers.Powerpoint.Output
       Copyright   : Copyright (C) 2017-2020 Jesse Rosenthal
       License     : GNU GPL, version 2 or above

       Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
       Stability   : alpha
       Portability : portable

    Conversion of Presentation datatype (defined in
    Text.Pandoc.Writers.Powerpoint.Presentation) to a zip archive.
    -}

    module Text.Pandoc.Writers.Powerpoint.Output ( presentationToArchive
                                                 ) where

    import Control.Monad ( MonadPlus(mplus), foldM, unless )
    import Control.Monad.Except (throwError, catchError)
    import Control.Monad.Reader
        ( asks, MonadReader(local), ReaderT(runReaderT) )
    import Control.Monad.State
        ( StateT, gets, modify, evalStateT )
    import Codec.Archive.Zip
    import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse)
    import Data.Bifunctor (bimap)
    import Data.CaseInsensitive (CI)
    import qualified Data.CaseInsensitive as CI
    import Data.Default
    import Data.Foldable (toList)
    import Data.List.NonEmpty (nonEmpty, NonEmpty ((:|)))
    import Data.Ratio ((%), Ratio)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Text.Read (decimal)
    import Data.Time (formatTime, defaultTimeLocale)
    import Data.Time.Clock (UTCTime)
    import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
    import Data.Traversable (for)
    import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension, takeFileName)
    import Text.Pandoc.XML.Light as XML
    import Text.Pandoc.Definition
    import qualified Text.Pandoc.UTF8 as UTF8
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Error (PandocError(..))
    import qualified Text.Pandoc.Class.PandocMonad as P
    import Text.Pandoc.Data (readDataFile, readDefaultDataFile)
    import Text.Pandoc.Options
    import Text.Pandoc.MIME
    import qualified Data.ByteString.Lazy as BL
    import Text.Pandoc.Writers.Shared (metaToContext)
    import Text.Pandoc.Writers.OOXML
    import qualified Data.Map as M
    import Data.Maybe (mapMaybe, listToMaybe, fromMaybe, maybeToList, catMaybes, isJust)
    import Text.Pandoc.ImageSize
    import Control.Applicative ((<|>))
    import System.FilePath.Glob
    import Text.DocTemplates (FromContext(lookupContext), Context)
    import Text.DocLayout (literal)
    import Text.TeXMath
    import Text.Pandoc.Logging (LogMessage(PowerpointTemplateWarning))
    import Text.Pandoc.Writers.Math (convertMath)
    import Text.Pandoc.Writers.Powerpoint.Presentation
    import Text.Pandoc.Shared (tshow, stringify)
    import Skylighting (fromColor)

    -- |The 'EMU' type is used to specify sizes in English Metric Units.
    type EMU = Integer

    -- |The 'pixelsToEmu' function converts a size in pixels to one
    -- in English Metric Units. It assumes a DPI of 72.
    pixelsToEmu :: Pixels -> EMU
    pixelsToEmu :: Integer -> Integer
    pixelsToEmu = (Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *)

    -- This populates the global ids map with images already in the
    -- template, so the ids won't be used by images introduced by the
    -- user.
    initialGlobalIds :: Archive -> Archive -> M.Map FilePath Int
    initialGlobalIds :: Archive -> Archive -> Map FilePath Int
    initialGlobalIds Archive
    refArchive Archive
    distArchive =
      let archiveFiles :: [FilePath]
    archiveFiles = Archive -> [FilePath]
    filesInArchive Archive
    refArchive [FilePath] -> [FilePath] -> [FilePath]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` Archive -> [FilePath]
    filesInArchive Archive
    distArchive
          mediaPaths :: [FilePath]
    mediaPaths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf FilePath
    "ppt/media/image") [FilePath]
    archiveFiles

          go :: FilePath -> Maybe (FilePath, Int)
          go :: FilePath -> Maybe (FilePath, Int)
    go FilePath
    fp = do
            s <- FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix FilePath
    "ppt/media/image" (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ (FilePath, FilePath) -> FilePath
    forall a b. (a, b) -> a
    fst ((FilePath, FilePath) -> FilePath)
    -> (FilePath, FilePath) -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    fp
            (n, _) <- listToMaybe $ reads s
            return (fp, n)
      in
        [(FilePath, Int)] -> Map FilePath Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(FilePath, Int)] -> Map FilePath Int)
    -> [(FilePath, Int)] -> Map FilePath Int
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Maybe (FilePath, Int))
    -> [FilePath] -> [(FilePath, Int)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe (FilePath, Int)
    go [FilePath]
    mediaPaths

    getPresentationSize :: Archive -> Archive -> Maybe (Integer, Integer)
    getPresentationSize :: Archive -> Archive -> Maybe (Integer, Integer)
    getPresentationSize Archive
    refArchive Archive
    distArchive = do
      entry <- FilePath -> Archive -> Maybe Entry
    findEntryByPath FilePath
    "ppt/presentation.xml" Archive
    refArchive  Maybe Entry -> Maybe Entry -> Maybe Entry
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
               FilePath -> Archive -> Maybe Entry
    findEntryByPath FilePath
    "ppt/presentation.xml" Archive
    distArchive
      presElement <- either (const Nothing) return $
                       parseXMLElement $ UTF8.toTextLazy $ fromEntry entry
      let ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    presElement
      sldSize <- findChild (elemName ns "p" "sldSz") presElement
      cxS <- findAttr (QName "cx" Nothing Nothing) sldSize
      cyS <- findAttr (QName "cy" Nothing Nothing) sldSize
      cx <- readTextAsInteger cxS
      cy <- readTextAsInteger cyS
      return (cx `div` 12700, cy `div` 12700)

    readTextAsInteger :: Text -> Maybe Integer
    readTextAsInteger :: Text -> Maybe Integer
    readTextAsInteger = (FilePath -> Maybe Integer)
    -> ((Integer, Text) -> Maybe Integer)
    -> Either FilePath (Integer, Text)
    -> Maybe Integer
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe Integer -> FilePath -> Maybe Integer
    forall a b. a -> b -> a
    const Maybe Integer
    forall a. Maybe a
    Nothing) (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer)
    -> ((Integer, Text) -> Integer) -> (Integer, Text) -> Maybe Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer, Text) -> Integer
    forall a b. (a, b) -> a
    fst) (Either FilePath (Integer, Text) -> Maybe Integer)
    -> (Text -> Either FilePath (Integer, Text))
    -> Text
    -> Maybe Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either FilePath (Integer, Text)
    forall a. Integral a => Reader a
    Data.Text.Read.decimal

    data WriterEnv = WriterEnv { WriterEnv -> Archive
    envRefArchive :: Archive
                               , WriterEnv -> Archive
    envDistArchive :: Archive
                               , WriterEnv -> UTCTime
    envUTCTime :: UTCTime
                               , WriterEnv -> WriterOptions
    envOpts :: WriterOptions
                               , WriterEnv -> Context Text
    envContext :: Context Text
                               , WriterEnv -> (Integer, Integer)
    envPresentationSize :: (Integer, Integer)
                               , WriterEnv -> Bool
    envSlideHasHeader :: Bool
                               , WriterEnv -> Bool
    envInList :: Bool
                               , WriterEnv -> Bool
    envInNoteSlide :: Bool
                               , WriterEnv -> Int
    envCurSlideId :: Int
                               , WriterEnv -> Placeholder
    envPlaceholder :: Placeholder
                               , WriterEnv -> Map SlideId Int
    envSlideIdMap :: M.Map SlideId Int
                               -- maps the slide number to the
                               -- corresponding notes id number. If there
                               -- are no notes for a slide, there will be
                               -- no entry in the map for it.
                               , WriterEnv -> Map Int Int
    envSpeakerNotesIdMap :: M.Map Int Int
                               , WriterEnv -> Bool
    envInSpeakerNotes :: Bool
                               , WriterEnv -> Maybe SlideLayouts
    envSlideLayouts :: Maybe SlideLayouts
                               , WriterEnv -> Maybe Indents
    envOtherStyleIndents :: Maybe Indents
                               }
                     deriving (Int -> WriterEnv -> FilePath -> FilePath
    [WriterEnv] -> FilePath -> FilePath
    WriterEnv -> FilePath
    (Int -> WriterEnv -> FilePath -> FilePath)
    -> (WriterEnv -> FilePath)
    -> ([WriterEnv] -> FilePath -> FilePath)
    -> Show WriterEnv
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> WriterEnv -> FilePath -> FilePath
    showsPrec :: Int -> WriterEnv -> FilePath -> FilePath
    $cshow :: WriterEnv -> FilePath
    show :: WriterEnv -> FilePath
    $cshowList :: [WriterEnv] -> FilePath -> FilePath
    showList :: [WriterEnv] -> FilePath -> FilePath
    Show)

    instance Default WriterEnv where
      def :: WriterEnv
    def = WriterEnv { envRefArchive :: Archive
    envRefArchive = Archive
    emptyArchive
                      , envDistArchive :: Archive
    envDistArchive = Archive
    emptyArchive
                      , envUTCTime :: UTCTime
    envUTCTime = POSIXTime -> UTCTime
    posixSecondsToUTCTime POSIXTime
    0
                      , envOpts :: WriterOptions
    envOpts = WriterOptions
    forall a. Default a => a
    def
                      , envContext :: Context Text
    envContext = Context Text
    forall a. Monoid a => a
    mempty
                      , envPresentationSize :: (Integer, Integer)
    envPresentationSize = (Integer
    720, Integer
    540)
                      , envSlideHasHeader :: Bool
    envSlideHasHeader = Bool
    False
                      , envInList :: Bool
    envInList = Bool
    False
                      , envInNoteSlide :: Bool
    envInNoteSlide = Bool
    False
                      , envCurSlideId :: Int
    envCurSlideId = Int
    1
                      , envPlaceholder :: Placeholder
    envPlaceholder = PHType -> Int -> Placeholder
    Placeholder PHType
    ObjType Int
    0
                      , envSlideIdMap :: Map SlideId Int
    envSlideIdMap = Map SlideId Int
    forall a. Monoid a => a
    mempty
                      , envSpeakerNotesIdMap :: Map Int Int
    envSpeakerNotesIdMap = Map Int Int
    forall a. Monoid a => a
    mempty
                      , envInSpeakerNotes :: Bool
    envInSpeakerNotes = Bool
    False
                      , envSlideLayouts :: Maybe SlideLayouts
    envSlideLayouts = Maybe SlideLayouts
    forall a. Maybe a
    Nothing
                      , envOtherStyleIndents :: Maybe Indents
    envOtherStyleIndents = Maybe Indents
    forall a. Maybe a
    Nothing
                      }

    type SlideLayouts = SlideLayoutsOf SlideLayout

    data SlideLayoutsOf a = SlideLayouts
      { forall a. SlideLayoutsOf a -> a
    metadata :: a
      , forall a. SlideLayoutsOf a -> a
    title :: a
      , forall a. SlideLayoutsOf a -> a
    content :: a
      , forall a. SlideLayoutsOf a -> a
    twoColumn :: a
      , forall a. SlideLayoutsOf a -> a
    comparison :: a
      , forall a. SlideLayoutsOf a -> a
    contentWithCaption :: a
      , forall a. SlideLayoutsOf a -> a
    blank :: a
      } deriving (Int -> SlideLayoutsOf a -> FilePath -> FilePath
    [SlideLayoutsOf a] -> FilePath -> FilePath
    SlideLayoutsOf a -> FilePath
    (Int -> SlideLayoutsOf a -> FilePath -> FilePath)
    -> (SlideLayoutsOf a -> FilePath)
    -> ([SlideLayoutsOf a] -> FilePath -> FilePath)
    -> Show (SlideLayoutsOf a)
    forall a. Show a => Int -> SlideLayoutsOf a -> FilePath -> FilePath
    forall a. Show a => [SlideLayoutsOf a] -> FilePath -> FilePath
    forall a. Show a => SlideLayoutsOf a -> FilePath
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> SlideLayoutsOf a -> FilePath -> FilePath
    showsPrec :: Int -> SlideLayoutsOf a -> FilePath -> FilePath
    $cshow :: forall a. Show a => SlideLayoutsOf a -> FilePath
    show :: SlideLayoutsOf a -> FilePath
    $cshowList :: forall a. Show a => [SlideLayoutsOf a] -> FilePath -> FilePath
    showList :: [SlideLayoutsOf a] -> FilePath -> FilePath
    Show, SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    (SlideLayoutsOf a -> SlideLayoutsOf a -> Bool)
    -> (SlideLayoutsOf a -> SlideLayoutsOf a -> Bool)
    -> Eq (SlideLayoutsOf a)
    forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    == :: SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    $c/= :: forall a. Eq a => SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    /= :: SlideLayoutsOf a -> SlideLayoutsOf a -> Bool
    Eq, (forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b)
    -> (forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a)
    -> Functor SlideLayoutsOf
    forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
    forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
    fmap :: forall a b. (a -> b) -> SlideLayoutsOf a -> SlideLayoutsOf b
    $c<$ :: forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
    <$ :: forall a b. a -> SlideLayoutsOf b -> SlideLayoutsOf a
    Functor, (forall m. Monoid m => SlideLayoutsOf m -> m)
    -> (forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m)
    -> (forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m)
    -> (forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b)
    -> (forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b)
    -> (forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b)
    -> (forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b)
    -> (forall a. (a -> a -> a) -> SlideLayoutsOf a -> a)
    -> (forall a. (a -> a -> a) -> SlideLayoutsOf a -> a)
    -> (forall a. SlideLayoutsOf a -> [a])
    -> (forall a. SlideLayoutsOf a -> Bool)
    -> (forall a. SlideLayoutsOf a -> Int)
    -> (forall a. Eq a => a -> SlideLayoutsOf a -> Bool)
    -> (forall a. Ord a => SlideLayoutsOf a -> a)
    -> (forall a. Ord a => SlideLayoutsOf a -> a)
    -> (forall a. Num a => SlideLayoutsOf a -> a)
    -> (forall a. Num a => SlideLayoutsOf a -> a)
    -> Foldable SlideLayoutsOf
    forall a. Eq a => a -> SlideLayoutsOf a -> Bool
    forall a. Num a => SlideLayoutsOf a -> a
    forall a. Ord a => SlideLayoutsOf a -> a
    forall m. Monoid m => SlideLayoutsOf m -> m
    forall a. SlideLayoutsOf a -> Bool
    forall a. SlideLayoutsOf a -> Int
    forall a. SlideLayoutsOf a -> [a]
    forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
    forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
    forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
    forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => SlideLayoutsOf m -> m
    fold :: forall m. Monoid m => SlideLayoutsOf m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> SlideLayoutsOf a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> SlideLayoutsOf a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
    foldr1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
    foldl1 :: forall a. (a -> a -> a) -> SlideLayoutsOf a -> a
    $ctoList :: forall a. SlideLayoutsOf a -> [a]
    toList :: forall a. SlideLayoutsOf a -> [a]
    $cnull :: forall a. SlideLayoutsOf a -> Bool
    null :: forall a. SlideLayoutsOf a -> Bool
    $clength :: forall a. SlideLayoutsOf a -> Int
    length :: forall a. SlideLayoutsOf a -> Int
    $celem :: forall a. Eq a => a -> SlideLayoutsOf a -> Bool
    elem :: forall a. Eq a => a -> SlideLayoutsOf a -> Bool
    $cmaximum :: forall a. Ord a => SlideLayoutsOf a -> a
    maximum :: forall a. Ord a => SlideLayoutsOf a -> a
    $cminimum :: forall a. Ord a => SlideLayoutsOf a -> a
    minimum :: forall a. Ord a => SlideLayoutsOf a -> a
    $csum :: forall a. Num a => SlideLayoutsOf a -> a
    sum :: forall a. Num a => SlideLayoutsOf a -> a
    $cproduct :: forall a. Num a => SlideLayoutsOf a -> a
    product :: forall a. Num a => SlideLayoutsOf a -> a
    Foldable, Functor SlideLayoutsOf
    Foldable SlideLayoutsOf
    (Functor SlideLayoutsOf, Foldable SlideLayoutsOf) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        SlideLayoutsOf (f a) -> f (SlideLayoutsOf a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        SlideLayoutsOf (m a) -> m (SlideLayoutsOf a))
    -> Traversable SlideLayoutsOf
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a.
    Monad m =>
    SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
    forall (f :: * -> *) a.
    Applicative f =>
    SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SlideLayoutsOf a -> f (SlideLayoutsOf b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    SlideLayoutsOf (f a) -> f (SlideLayoutsOf a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SlideLayoutsOf a -> m (SlideLayoutsOf b)
    $csequence :: forall (m :: * -> *) a.
    Monad m =>
    SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    SlideLayoutsOf (m a) -> m (SlideLayoutsOf a)
    Traversable)

    data SlideLayout = SlideLayout
      { SlideLayout -> Element
    slElement :: Element
      , SlideLayout -> Bool
    slInReferenceDoc :: Bool
        -- ^ True if the layout is in the provided reference doc, False if it's in
        -- the default reference doc.
      , SlideLayout -> FilePath
    slPath :: FilePath
      , SlideLayout -> Entry
    slEntry :: Entry
      } deriving (Int -> SlideLayout -> FilePath -> FilePath
    [SlideLayout] -> FilePath -> FilePath
    SlideLayout -> FilePath
    (Int -> SlideLayout -> FilePath -> FilePath)
    -> (SlideLayout -> FilePath)
    -> ([SlideLayout] -> FilePath -> FilePath)
    -> Show SlideLayout
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> SlideLayout -> FilePath -> FilePath
    showsPrec :: Int -> SlideLayout -> FilePath -> FilePath
    $cshow :: SlideLayout -> FilePath
    show :: SlideLayout -> FilePath
    $cshowList :: [SlideLayout] -> FilePath -> FilePath
    showList :: [SlideLayout] -> FilePath -> FilePath
    Show)

    getSlideLayouts :: PandocMonad m => P m SlideLayouts
    getSlideLayouts :: forall (m :: * -> *). PandocMonad m => P m SlideLayouts
    getSlideLayouts = (WriterEnv -> Maybe SlideLayouts)
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe SlideLayouts)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Maybe SlideLayouts
    envSlideLayouts ReaderT WriterEnv (StateT WriterState m) (Maybe SlideLayouts)
    -> (Maybe SlideLayouts
        -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts)
    -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) a
    -> (a -> ReaderT WriterEnv (StateT WriterState m) b)
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    -> (SlideLayouts
        -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts)
    -> Maybe SlideLayouts
    -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (PandocError
    -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError PandocError
    e) SlideLayouts
    -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      where
        e :: PandocError
    e = Text -> PandocError
    PandocSomeError (Text
    "Slide layouts aren't defined, even though they should "
          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "always be. This is a bug in pandoc.")

    -- | A placeholder within a layout, identified by type and index.
    --
    -- E.g., @Placeholder ObjType 2@ is the third placeholder of type 'ObjType' in
    -- the layout.
    data Placeholder = Placeholder
      { Placeholder -> PHType
    placeholderType :: PHType
      , Placeholder -> Int
    index :: Int
      } deriving (Int -> Placeholder -> FilePath -> FilePath
    [Placeholder] -> FilePath -> FilePath
    Placeholder -> FilePath
    (Int -> Placeholder -> FilePath -> FilePath)
    -> (Placeholder -> FilePath)
    -> ([Placeholder] -> FilePath -> FilePath)
    -> Show Placeholder
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Placeholder -> FilePath -> FilePath
    showsPrec :: Int -> Placeholder -> FilePath -> FilePath
    $cshow :: Placeholder -> FilePath
    show :: Placeholder -> FilePath
    $cshowList :: [Placeholder] -> FilePath -> FilePath
    showList :: [Placeholder] -> FilePath -> FilePath
    Show, Placeholder -> Placeholder -> Bool
    (Placeholder -> Placeholder -> Bool)
    -> (Placeholder -> Placeholder -> Bool) -> Eq Placeholder
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Placeholder -> Placeholder -> Bool
    == :: Placeholder -> Placeholder -> Bool
    $c/= :: Placeholder -> Placeholder -> Bool
    /= :: Placeholder -> Placeholder -> Bool
    Eq)

    -- | Paragraph indentation info.
    data Indents = Indents
      { Indents -> Maybe LevelIndents
    level1 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level2 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level3 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level4 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level5 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level6 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level7 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level8 :: Maybe LevelIndents
      , Indents -> Maybe LevelIndents
    level9 :: Maybe LevelIndents
      } deriving (Int -> Indents -> FilePath -> FilePath
    [Indents] -> FilePath -> FilePath
    Indents -> FilePath
    (Int -> Indents -> FilePath -> FilePath)
    -> (Indents -> FilePath)
    -> ([Indents] -> FilePath -> FilePath)
    -> Show Indents
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Indents -> FilePath -> FilePath
    showsPrec :: Int -> Indents -> FilePath -> FilePath
    $cshow :: Indents -> FilePath
    show :: Indents -> FilePath
    $cshowList :: [Indents] -> FilePath -> FilePath
    showList :: [Indents] -> FilePath -> FilePath
    Show, Indents -> Indents -> Bool
    (Indents -> Indents -> Bool)
    -> (Indents -> Indents -> Bool) -> Eq Indents
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Indents -> Indents -> Bool
    == :: Indents -> Indents -> Bool
    $c/= :: Indents -> Indents -> Bool
    /= :: Indents -> Indents -> Bool
    Eq)

    levelIndent :: Indents -> Int -> Maybe LevelIndents
    levelIndent :: Indents -> Int -> Maybe LevelIndents
    levelIndent Indents
    is Int
    index = Indents -> Maybe LevelIndents
    getter Indents
    is
      where
        getter :: Indents -> Maybe LevelIndents
    getter = case Int
    index of
          Int
    0 -> Indents -> Maybe LevelIndents
    level1
          Int
    1 -> Indents -> Maybe LevelIndents
    level2
          Int
    2 -> Indents -> Maybe LevelIndents
    level3
          Int
    3 -> Indents -> Maybe LevelIndents
    level4
          Int
    4 -> Indents -> Maybe LevelIndents
    level5
          Int
    5 -> Indents -> Maybe LevelIndents
    level6
          Int
    6 -> Indents -> Maybe LevelIndents
    level7
          Int
    7 -> Indents -> Maybe LevelIndents
    level8
          Int
    8 -> Indents -> Maybe LevelIndents
    level9
          Int
    _ -> Maybe LevelIndents -> Indents -> Maybe LevelIndents
    forall a b. a -> b -> a
    const Maybe LevelIndents
    forall a. Maybe a
    Nothing

    data LevelIndents = LevelIndents
      { LevelIndents -> Integer
    marL :: EMU
      , LevelIndents -> Integer
    indent :: EMU
      } deriving (Int -> LevelIndents -> FilePath -> FilePath
    [LevelIndents] -> FilePath -> FilePath
    LevelIndents -> FilePath
    (Int -> LevelIndents -> FilePath -> FilePath)
    -> (LevelIndents -> FilePath)
    -> ([LevelIndents] -> FilePath -> FilePath)
    -> Show LevelIndents
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> LevelIndents -> FilePath -> FilePath
    showsPrec :: Int -> LevelIndents -> FilePath -> FilePath
    $cshow :: LevelIndents -> FilePath
    show :: LevelIndents -> FilePath
    $cshowList :: [LevelIndents] -> FilePath -> FilePath
    showList :: [LevelIndents] -> FilePath -> FilePath
    Show, LevelIndents -> LevelIndents -> Bool
    (LevelIndents -> LevelIndents -> Bool)
    -> (LevelIndents -> LevelIndents -> Bool) -> Eq LevelIndents
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LevelIndents -> LevelIndents -> Bool
    == :: LevelIndents -> LevelIndents -> Bool
    $c/= :: LevelIndents -> LevelIndents -> Bool
    /= :: LevelIndents -> LevelIndents -> Bool
    Eq)

    data MediaInfo = MediaInfo { MediaInfo -> FilePath
    mInfoFilePath :: FilePath
                               , MediaInfo -> Int
    mInfoLocalId  :: Int
                               , MediaInfo -> Int
    mInfoGlobalId :: Int
                               , MediaInfo -> Maybe Text
    mInfoMimeType :: Maybe MimeType
                               , MediaInfo -> Maybe Text
    mInfoExt      :: Maybe T.Text
                               , MediaInfo -> Bool
    mInfoCaption  :: Bool
                               } deriving (Int -> MediaInfo -> FilePath -> FilePath
    [MediaInfo] -> FilePath -> FilePath
    MediaInfo -> FilePath
    (Int -> MediaInfo -> FilePath -> FilePath)
    -> (MediaInfo -> FilePath)
    -> ([MediaInfo] -> FilePath -> FilePath)
    -> Show MediaInfo
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> MediaInfo -> FilePath -> FilePath
    showsPrec :: Int -> MediaInfo -> FilePath -> FilePath
    $cshow :: MediaInfo -> FilePath
    show :: MediaInfo -> FilePath
    $cshowList :: [MediaInfo] -> FilePath -> FilePath
    showList :: [MediaInfo] -> FilePath -> FilePath
    Show, MediaInfo -> MediaInfo -> Bool
    (MediaInfo -> MediaInfo -> Bool)
    -> (MediaInfo -> MediaInfo -> Bool) -> Eq MediaInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MediaInfo -> MediaInfo -> Bool
    == :: MediaInfo -> MediaInfo -> Bool
    $c/= :: MediaInfo -> MediaInfo -> Bool
    /= :: MediaInfo -> MediaInfo -> Bool
    Eq)

    data WriterState = WriterState { WriterState -> Map Int (Map Int LinkTarget)
    stLinkIds :: M.Map Int (M.Map Int LinkTarget)
                                   -- (FP, Local ID, Global ID, Maybe Mime)
                                   , WriterState -> Map Int [MediaInfo]
    stMediaIds :: M.Map Int [MediaInfo]
                                   , WriterState -> Map FilePath Int
    stMediaGlobalIds :: M.Map FilePath Int
                                   , WriterState -> Maybe FooterInfo
    stFooterInfo :: Maybe FooterInfo
                                   } deriving (Int -> WriterState -> FilePath -> FilePath
    [WriterState] -> FilePath -> FilePath
    WriterState -> FilePath
    (Int -> WriterState -> FilePath -> FilePath)
    -> (WriterState -> FilePath)
    -> ([WriterState] -> FilePath -> FilePath)
    -> Show WriterState
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> WriterState -> FilePath -> FilePath
    showsPrec :: Int -> WriterState -> FilePath -> FilePath
    $cshow :: WriterState -> FilePath
    show :: WriterState -> FilePath
    $cshowList :: [WriterState] -> FilePath -> FilePath
    showList :: [WriterState] -> FilePath -> FilePath
    Show, WriterState -> WriterState -> Bool
    (WriterState -> WriterState -> Bool)
    -> (WriterState -> WriterState -> Bool) -> Eq WriterState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: WriterState -> WriterState -> Bool
    == :: WriterState -> WriterState -> Bool
    $c/= :: WriterState -> WriterState -> Bool
    /= :: WriterState -> WriterState -> Bool
    Eq)

    instance Default WriterState where
      def :: WriterState
    def = WriterState { stLinkIds :: Map Int (Map Int LinkTarget)
    stLinkIds = Map Int (Map Int LinkTarget)
    forall a. Monoid a => a
    mempty
                        , stMediaIds :: Map Int [MediaInfo]
    stMediaIds = Map Int [MediaInfo]
    forall a. Monoid a => a
    mempty
                        , stMediaGlobalIds :: Map FilePath Int
    stMediaGlobalIds = Map FilePath Int
    forall a. Monoid a => a
    mempty
                        , stFooterInfo :: Maybe FooterInfo
    stFooterInfo = Maybe FooterInfo
    forall a. Maybe a
    Nothing
                        }

    type P m = ReaderT WriterEnv (StateT WriterState m)

    runP :: Monad m => WriterEnv -> WriterState -> P m a -> m a
    runP :: forall (m :: * -> *) a.
    Monad m =>
    WriterEnv -> WriterState -> P m a -> m a
    runP WriterEnv
    env WriterState
    st P m a
    p = StateT WriterState m a -> WriterState -> m a
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (P m a -> WriterEnv -> StateT WriterState m a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT P m a
    p WriterEnv
    env) WriterState
    st

    --------------------------------------------------------------------

    monospaceFont :: Monad m => P m T.Text
    monospaceFont :: forall (m :: * -> *). Monad m => P m Text
    monospaceFont = do
      vars <- (WriterEnv -> Context Text)
    -> ReaderT WriterEnv (StateT WriterState m) (Context Text)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Context Text
    envContext
      case lookupContext "monofont" vars of
        Just Text
    s -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
        Maybe Text
    Nothing -> Text -> ReaderT WriterEnv (StateT WriterState m) Text
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    "Courier"

    fontSizeAttributes :: Monad m => RunProps -> P m [(Text, Text)]
    fontSizeAttributes :: forall (m :: * -> *). Monad m => RunProps -> P m [(Text, Text)]
    fontSizeAttributes RunProps { rPropForceSize :: RunProps -> Maybe Integer
    rPropForceSize = Just Integer
    sz } =
      [(Text, Text)]
    -> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Text
    "sz", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    sz Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    100)]
    fontSizeAttributes RunProps
    _ = [(Text, Text)]
    -> ReaderT WriterEnv (StateT WriterState m) [(Text, Text)]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    copyFileToArchive :: PandocMonad m => Archive -> FilePath -> P m Archive
    copyFileToArchive :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> FilePath -> P m Archive
    copyFileToArchive Archive
    arch FilePath
    fp = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of
        Maybe Entry
    Nothing -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive)
    -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError
                              (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack
                              (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ FilePath
    fp FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    " missing in reference file"
        Just Entry
    e -> Archive -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Archive -> ReaderT WriterEnv (StateT WriterState m) Archive)
    -> Archive -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall a b. (a -> b) -> a -> b
    $ Entry -> Archive -> Archive
    addEntryToArchive Entry
    e Archive
    arch

    alwaysInheritedPatterns :: [Pattern]
    alwaysInheritedPatterns :: [Pattern]
    alwaysInheritedPatterns =
      (FilePath -> Pattern) -> [FilePath] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> Pattern
    compile [ FilePath
    "docProps/app.xml"
                  , FilePath
    "ppt/slideLayouts/slideLayout*.xml"
                  , FilePath
    "ppt/slideLayouts/_rels/slideLayout*.xml.rels"
                  , FilePath
    "ppt/slideMasters/slideMaster1.xml"
                  , FilePath
    "ppt/slideMasters/_rels/slideMaster1.xml.rels"
                  , FilePath
    "ppt/theme/theme*.xml"
                  , FilePath
    "ppt/theme/_rels/theme*.xml.rels"
                  , FilePath
    "ppt/presProps.xml"
                  , FilePath
    "ppt/tableStyles.xml"
                  , FilePath
    "ppt/media/image*"
                  , FilePath
    "ppt/fonts/*"
                  ]

    -- We only look for these under special conditions
    contingentInheritedPatterns :: Presentation -> [Pattern]
    contingentInheritedPatterns :: Presentation -> [Pattern]
    contingentInheritedPatterns Presentation
    pres = [] [Pattern] -> [Pattern] -> [Pattern]
    forall a. Semigroup a => a -> a -> a
    <>
      if Presentation -> Bool
    presHasSpeakerNotes Presentation
    pres
      then (FilePath -> Pattern) -> [FilePath] -> [Pattern]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> Pattern
    compile [ FilePath
    "ppt/notesMasters/notesMaster*.xml"
                       , FilePath
    "ppt/notesMasters/_rels/notesMaster*.xml.rels"
                       ]
      else []

    inheritedPatterns :: Presentation -> [Pattern]
    inheritedPatterns :: Presentation -> [Pattern]
    inheritedPatterns Presentation
    pres =
      [Pattern]
    alwaysInheritedPatterns [Pattern] -> [Pattern] -> [Pattern]
    forall a. Semigroup a => a -> a -> a
    <> Presentation -> [Pattern]
    contingentInheritedPatterns Presentation
    pres

    patternToFilePaths :: PandocMonad m => Pattern -> P m [FilePath]
    patternToFilePaths :: forall (m :: * -> *). PandocMonad m => Pattern -> P m [FilePath]
    patternToFilePaths Pattern
    pat = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive

      let archiveFiles = Archive -> [FilePath]
    filesInArchive Archive
    refArchive [FilePath] -> [FilePath] -> [FilePath]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` Archive -> [FilePath]
    filesInArchive Archive
    distArchive
      return $ filter (match pat) archiveFiles

    patternsToFilePaths :: PandocMonad m => [Pattern] -> P m [FilePath]
    patternsToFilePaths :: forall (m :: * -> *). PandocMonad m => [Pattern] -> P m [FilePath]
    patternsToFilePaths [Pattern]
    pats = [[FilePath]] -> [FilePath]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[FilePath]] -> [FilePath])
    -> ReaderT WriterEnv (StateT WriterState m) [[FilePath]]
    -> ReaderT WriterEnv (StateT WriterState m) [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Pattern -> ReaderT WriterEnv (StateT WriterState m) [FilePath])
    -> [Pattern]
    -> ReaderT WriterEnv (StateT WriterState m) [[FilePath]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Pattern -> ReaderT WriterEnv (StateT WriterState m) [FilePath]
    forall (m :: * -> *). PandocMonad m => Pattern -> P m [FilePath]
    patternToFilePaths [Pattern]
    pats

    -- Here are the files we'll require to make a Powerpoint document. If
    -- any of these are missing, we should error out of our build.
    requiredFiles :: [FilePath]
    requiredFiles :: [FilePath]
    requiredFiles = [ FilePath
    "docProps/app.xml"
                    , FilePath
    "ppt/presProps.xml"
                    , FilePath
    "ppt/slideLayouts/slideLayout1.xml"
                    , FilePath
    "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
                    , FilePath
    "ppt/slideLayouts/slideLayout2.xml"
                    , FilePath
    "ppt/slideLayouts/_rels/slideLayout2.xml.rels"
                    , FilePath
    "ppt/slideLayouts/slideLayout3.xml"
                    , FilePath
    "ppt/slideLayouts/_rels/slideLayout3.xml.rels"
                    , FilePath
    "ppt/slideLayouts/slideLayout4.xml"
                    , FilePath
    "ppt/slideLayouts/_rels/slideLayout4.xml.rels"
                    , FilePath
    "ppt/slideMasters/slideMaster1.xml"
                    , FilePath
    "ppt/slideMasters/_rels/slideMaster1.xml.rels"
                    , FilePath
    "ppt/theme/theme1.xml"
                    , FilePath
    "ppt/tableStyles.xml"
                    ]

    presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
    presentationToArchiveP :: forall (m :: * -> *). PandocMonad m => Presentation -> P m Archive
    presentationToArchiveP p :: Presentation
    p@(Presentation DocProps
    docProps [Slide]
    slides) = do
      filePaths <- [Pattern] -> P m [FilePath]
    forall (m :: * -> *). PandocMonad m => [Pattern] -> P m [FilePath]
    patternsToFilePaths ([Pattern] -> P m [FilePath]) -> [Pattern] -> P m [FilePath]
    forall a b. (a -> b) -> a -> b
    $ Presentation -> [Pattern]
    inheritedPatterns Presentation
    p

      -- make sure all required files are available:
      let missingFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FilePath -> [FilePath] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [FilePath]
    filePaths) [FilePath]
    requiredFiles
      unless (null missingFiles)
        (throwError $
          PandocSomeError $
          "The following required files are missing:\n" <>
          T.unlines (map (T.pack . ("  " <>)) missingFiles)
        )

      newArch <- foldM copyFileToArchive emptyArchive filePaths

      -- Add any layouts taken from the default archive,
      -- overwriting any already added.
      slideLayouts <- getSlideLayouts
      let f SlideLayout
    layout =
            if Bool -> Bool
    not (SlideLayout -> Bool
    slInReferenceDoc SlideLayout
    layout)
            then Entry -> Archive -> Archive
    addEntryToArchive (SlideLayout -> Entry
    slEntry SlideLayout
    layout)
            else Archive -> Archive
    forall a. a -> a
    id
      let newArch' = (SlideLayout -> Archive -> Archive)
    -> Archive -> SlideLayouts -> Archive
    forall a b. (a -> b -> b) -> b -> SlideLayoutsOf a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr SlideLayout -> Archive -> Archive
    f Archive
    newArch SlideLayouts
    slideLayouts

      master <- getMaster
      refArchive <- asks envRefArchive
      distArchive <- asks envDistArchive
      presentationElement <- parseXml refArchive distArchive "ppt/presentation.xml"
      modify (\WriterState
    s ->
        WriterState
    s {stFooterInfo =
            getFooterInfo (dcDate docProps) slideLayouts master presentationElement
          })

      -- Update the master to make sure it includes any layouts we've just added
      masterRels <- getMasterRels
      let (updatedMasterElem, updatedMasterRelElem) = updateMasterElems slideLayouts master masterRels
      updatedMasterEntry <- elemToEntry "ppt/slideMasters/slideMaster1.xml" updatedMasterElem
      updatedMasterRelEntry <- elemToEntry "ppt/slideMasters/_rels/slideMaster1.xml.rels" updatedMasterRelElem

      -- we make a modified ppt/viewProps.xml out of the presentation viewProps
      viewPropsEntry <- makeViewPropsEntry
      -- we make a docProps/core.xml entry out of the presentation docprops
      docPropsEntry <- docPropsToEntry docProps
      -- we make a docProps/custom.xml entry out of the custom properties
      docCustomPropsEntry <- docCustomPropsToEntry docProps
      -- we make this ourself in case there's something unexpected in the
      -- one in the reference doc.
      relsEntry <- topLevelRelsEntry
      -- presentation entry and rels.
      (presentationRIdUpdateData, presRelsEntry) <- presentationToRelsEntry p
      presEntry <- presentationToPresEntry presentationRIdUpdateData p
      slideEntries <- mapM slideToEntry slides
      slideRelEntries <- mapM slideToSlideRelEntry slides
      spkNotesEntries <- catMaybes <$> mapM slideToSpeakerNotesEntry slides
      spkNotesRelEntries <- catMaybes <$> mapM slideToSpeakerNotesRelEntry slides
      -- These have to come after everything, because they need the info
      -- built up in the state.
      mediaEntries <- makeMediaEntries
      contentTypesEntry <- presentationToContentTypes p >>= contentTypesToEntry
      -- fold everything into our inherited archive and return it.
      return $ foldr addEntryToArchive newArch' $
        slideEntries <>
        slideRelEntries <>
        spkNotesEntries <>
        spkNotesRelEntries <>
        mediaEntries <>
        [updatedMasterEntry, updatedMasterRelEntry]  <>
        [contentTypesEntry, docPropsEntry, docCustomPropsEntry, relsEntry,
         presEntry, presRelsEntry, viewPropsEntry]

    updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
    updateMasterElems :: SlideLayouts -> Element -> Element -> (Element, Element)
    updateMasterElems SlideLayouts
    layouts Element
    master Element
    masterRels = (Element
    updatedMaster, Element
    updatedMasterRels)
      where
        updatedMaster :: Element
    updatedMaster = Element
    master { elContent = updateSldLayoutIdLst <$> elContent master }
        ([Text]
    updatedRelationshipIds, Element
    updatedMasterRels) = Element -> ([Text], Element)
    addLayoutRels Element
    masterRels

        updateSldLayoutIdLst :: Content -> Content
        updateSldLayoutIdLst :: Content -> Content
    updateSldLayoutIdLst (Elem Element
    e) = case Element -> QName
    elName Element
    e of
          (QName Text
    "sldLayoutIdLst" Maybe Text
    _ Maybe Text
    _) -> let
            mkChild :: Text -> (a, [Content]) -> (a, [Content])
    mkChild Text
    relationshipId (a
    lastId, [Content]
    children) = let
              thisId :: a
    thisId = a
    lastId a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
              newChild :: Element
    newChild = Element
                { elName :: QName
    elName = Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "sldLayoutId" Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "p")
                , elAttribs :: [Attr]
    elAttribs =
                  [ QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) (FilePath -> Text
    T.pack (a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    thisId))
                  , QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "id" Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "r")) Text
    relationshipId
                  ]
                , elContent :: [Content]
    elContent = []
                , elLine :: Maybe Integer
    elLine = Maybe Integer
    forall a. Maybe a
    Nothing
                }
              in (a
    thisId, Element -> Content
    Elem Element
    newChild Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    children)
            newChildren :: [Content]
    newChildren = (Integer, [Content]) -> [Content]
    forall a b. (a, b) -> b
    snd ((Text -> (Integer, [Content]) -> (Integer, [Content]))
    -> (Integer, [Content]) -> [Text] -> (Integer, [Content])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Text -> (Integer, [Content]) -> (Integer, [Content])
    forall {a}.
    (Num a, Show a) =>
    Text -> (a, [Content]) -> (a, [Content])
    mkChild (Element -> Integer
    maxIdNumber' Element
    e, []) [Text]
    updatedRelationshipIds)
            in Element -> Content
    Elem Element
    e { elContent = elContent e <> newChildren }
          QName
    _ -> Element -> Content
    Elem Element
    e
        updateSldLayoutIdLst Content
    c = Content
    c

        addLayoutRels ::
          Element ->
          ([Text], Element)
        addLayoutRels :: Element -> ([Text], Element)
    addLayoutRels Element
    e = let
          layoutsToAdd :: [SlideLayout]
    layoutsToAdd = (SlideLayout -> Bool) -> [SlideLayout] -> [SlideLayout]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\SlideLayout
    l -> Bool -> Bool
    not (SlideLayout -> Bool
    slInReferenceDoc SlideLayout
    l) Bool -> Bool -> Bool
    && Element -> SlideLayout -> Bool
    isNew Element
    e SlideLayout
    l)
                                (SlideLayouts -> [SlideLayout]
    forall a. SlideLayoutsOf a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList SlideLayouts
    layouts)
          newRelationships :: [Content]
    newRelationships = (Integer, [Content]) -> [Content]
    forall a b. (a, b) -> b
    snd ((SlideLayout -> (Integer, [Content]) -> (Integer, [Content]))
    -> (Integer, [Content]) -> [SlideLayout] -> (Integer, [Content])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr SlideLayout -> (Integer, [Content]) -> (Integer, [Content])
    forall {a}.
    (Num a, Show a) =>
    SlideLayout -> (a, [Content]) -> (a, [Content])
    mkRelationship (Element -> Integer
    maxIdNumber Element
    e, []) [SlideLayout]
    layoutsToAdd)
          newRelationshipIds :: [Text]
    newRelationshipIds =
            (Content -> Maybe Text) -> [Content] -> [Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (QName -> Content -> Maybe Text
    findElemAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing)) [Content]
    newRelationships
          mkRelationship :: SlideLayout -> (a, [Content]) -> (a, [Content])
    mkRelationship SlideLayout
    layout (a
    lastId, [Content]
    relationships) = let
            thisId :: a
    thisId = a
    lastId a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
            slideLayoutPath :: Text
    slideLayoutPath = Text
    "../slideLayouts/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack (FilePath -> FilePath
    takeFileName (SlideLayout -> FilePath
    slPath SlideLayout
    layout))
            newRelationship :: Element
    newRelationship = Element
              { elName :: QName
    elName = Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Relationship" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing
              , elAttribs :: [Attr]
    elAttribs =
                [ QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) (Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack (a -> FilePath
    forall a. Show a => a -> FilePath
    show a
    thisId))
                , QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout"
                , QName -> Text -> Attr
    Attr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Target" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Text
    slideLayoutPath
                ]
              , elContent :: [Content]
    elContent = []
              , elLine :: Maybe Integer
    elLine = Maybe Integer
    forall a. Maybe a
    Nothing
              }
            in (a
    thisId, Element -> Content
    Elem Element
    newRelationship Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    relationships)
          in ([Text]
    newRelationshipIds, Element
    e {elContent = elContent e <> newRelationships})

        -- Whether the layout needs to be added to the Relationships element.
        isNew :: Element -> SlideLayout -> Bool
        isNew :: Element -> SlideLayout -> Bool
    isNew Element
    relationships SlideLayout{Bool
    FilePath
    Element
    Entry
    slElement :: SlideLayout -> Element
    slInReferenceDoc :: SlideLayout -> Bool
    slPath :: SlideLayout -> FilePath
    slEntry :: SlideLayout -> Entry
    slElement :: Element
    slInReferenceDoc :: Bool
    slPath :: FilePath
    slEntry :: Entry
    ..} = let
          toDetails :: Content -> Maybe FilePath
    toDetails = (Text -> FilePath) -> Maybe Text -> Maybe FilePath
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FilePath -> FilePath
    takeFileName (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> FilePath
    T.unpack)
            (Maybe Text -> Maybe FilePath)
    -> (Content -> Maybe Text) -> Content -> Maybe FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> Content -> Maybe Text
    findElemAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Target" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing)
          in FilePath -> FilePath
    takeFileName FilePath
    slPath FilePath -> [FilePath] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (Content -> Maybe FilePath) -> [Content] -> [FilePath]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Content -> Maybe FilePath
    toDetails (Element -> [Content]
    elContent Element
    relationships)

        findElemAttr :: QName -> Content -> Maybe Text
        findElemAttr :: QName -> Content -> Maybe Text
    findElemAttr QName
    attr (Elem Element
    e) = QName -> Element -> Maybe Text
    findAttr QName
    attr Element
    e
        findElemAttr QName
    _ Content
    _ = Maybe Text
    forall a. Maybe a
    Nothing

        maxIdNumber :: Element -> Integer
        maxIdNumber :: Element -> Integer
    maxIdNumber Element
    relationships = [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Integer
    0 Integer -> [Integer] -> [Integer]
    forall a. a -> [a] -> [a]
    : [Integer]
    idNumbers)
          where
            idNumbers :: [Integer]
    idNumbers = (Text -> Maybe Integer) -> [Text] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Text -> Maybe Integer
    readTextAsInteger (Text -> Maybe Integer) -> (Text -> Text) -> Text -> Maybe Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Text -> Text
    T.drop Int
    3) [Text]
    idAttributes
            idAttributes :: [Text]
    idAttributes = (Content -> Maybe Text) -> [Content] -> [Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Content -> Maybe Text
    getIdAttribute (Element -> [Content]
    elContent Element
    relationships)
            getIdAttribute :: Content -> Maybe Text
    getIdAttribute (Elem Element
    e) = QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e
            getIdAttribute Content
    _ = Maybe Text
    forall a. Maybe a
    Nothing

        maxIdNumber' :: Element -> Integer
        maxIdNumber' :: Element -> Integer
    maxIdNumber' Element
    sldLayouts = [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Integer
    0 Integer -> [Integer] -> [Integer]
    forall a. a -> [a] -> [a]
    : [Integer]
    idNumbers)
          where
            idNumbers :: [Integer]
    idNumbers = (Text -> Maybe Integer) -> [Text] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Text -> Maybe Integer
    readTextAsInteger [Text]
    idAttributes
            idAttributes :: [Text]
    idAttributes = (Content -> Maybe Text) -> [Content] -> [Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Content -> Maybe Text
    getIdAttribute (Element -> [Content]
    elContent Element
    sldLayouts)
            getIdAttribute :: Content -> Maybe Text
    getIdAttribute (Elem Element
    e) = QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e
            getIdAttribute Content
    _ = Maybe Text
    forall a. Maybe a
    Nothing

    data FooterInfo = FooterInfo
      { FooterInfo -> SlideLayoutsOf (Maybe Element)
    fiDate :: SlideLayoutsOf (Maybe Element)
      , FooterInfo -> SlideLayoutsOf (Maybe Element)
    fiFooter :: SlideLayoutsOf (Maybe Element)
      , FooterInfo -> SlideLayoutsOf (Maybe Element)
    fiSlideNumber :: SlideLayoutsOf (Maybe Element)
      , FooterInfo -> Bool
    fiShowOnFirstSlide :: Bool
      } deriving (Int -> FooterInfo -> FilePath -> FilePath
    [FooterInfo] -> FilePath -> FilePath
    FooterInfo -> FilePath
    (Int -> FooterInfo -> FilePath -> FilePath)
    -> (FooterInfo -> FilePath)
    -> ([FooterInfo] -> FilePath -> FilePath)
    -> Show FooterInfo
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> FooterInfo -> FilePath -> FilePath
    showsPrec :: Int -> FooterInfo -> FilePath -> FilePath
    $cshow :: FooterInfo -> FilePath
    show :: FooterInfo -> FilePath
    $cshowList :: [FooterInfo] -> FilePath -> FilePath
    showList :: [FooterInfo] -> FilePath -> FilePath
    Show, FooterInfo -> FooterInfo -> Bool
    (FooterInfo -> FooterInfo -> Bool)
    -> (FooterInfo -> FooterInfo -> Bool) -> Eq FooterInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FooterInfo -> FooterInfo -> Bool
    == :: FooterInfo -> FooterInfo -> Bool
    $c/= :: FooterInfo -> FooterInfo -> Bool
    /= :: FooterInfo -> FooterInfo -> Bool
    Eq)

    getFooterInfo :: Maybe Text -> SlideLayouts -> Element -> Element -> Maybe FooterInfo
    getFooterInfo :: Maybe Text
    -> SlideLayouts -> Element -> Element -> Maybe FooterInfo
    getFooterInfo Maybe Text
    date SlideLayouts
    layouts Element
    master Element
    presentation = do
      let ns :: [(Text, Text)]
    ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    master
      hf <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "hf") Element
    master
      let fiDate = let
            f :: Element -> Element
    f Element
    layoutDate =
              case Maybe Text
    date of
                Maybe Text
    Nothing -> Element
    layoutDate
                Just Text
    d ->
                  if [(Text, Text)] -> Element -> Bool
    dateIsAutomatic (Element -> [(Text, Text)]
    elemToNameSpaces Element
    layoutDate) Element
    layoutDate
                  then Element
    layoutDate
                  else Text -> Element -> Element
    replaceDate Text
    d Element
    layoutDate
            in (Element -> Element) -> Maybe Element -> Maybe Element
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Element -> Element
    f (Maybe Element -> Maybe Element)
    -> (SlideLayout -> Maybe Element) -> SlideLayout -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Element -> Element -> Maybe Element
    getShape Text
    "dt" Element
    hf (Element -> Maybe Element)
    -> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SlideLayout -> Element
    slElement (SlideLayout -> Maybe Element)
    -> SlideLayouts -> SlideLayoutsOf (Maybe Element)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SlideLayouts
    layouts
          fiFooter = Text -> Element -> Element -> Maybe Element
    getShape Text
    "ftr" Element
    hf (Element -> Maybe Element)
    -> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SlideLayout -> Element
    slElement (SlideLayout -> Maybe Element)
    -> SlideLayouts -> SlideLayoutsOf (Maybe Element)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SlideLayouts
    layouts
          fiSlideNumber = Text -> Element -> Element -> Maybe Element
    getShape Text
    "sldNum" Element
    hf (Element -> Maybe Element)
    -> (SlideLayout -> Element) -> SlideLayout -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SlideLayout -> Element
    slElement (SlideLayout -> Maybe Element)
    -> SlideLayouts -> SlideLayoutsOf (Maybe Element)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SlideLayouts
    layouts
          fiShowOnFirstSlide =
            Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    True
            (Text -> Element -> Maybe Bool
    getBooleanAttribute Text
    "showSpecialPlsOnTitleSld" Element
    presentation)
      pure FooterInfo{..}
        where
          getShape :: Text -> Element -> Element -> Maybe Element
    getShape Text
    t Element
    hf Element
    layout =
            if Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    True (Text -> Element -> Maybe Bool
    getBooleanAttribute Text
    t Element
    hf)
            then do
              let ns :: [(Text, Text)]
    ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
              cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
              spTree <- findChild (elemName ns "p" "spTree") cSld
              let containsPlaceholder Element
    sp = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
                    nvSpPr <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvSpPr") Element
    sp
                    nvPr <- findChild (elemName ns "p" "nvPr") nvSpPr
                    ph <- findChild (elemName ns "p" "ph") nvPr
                    placeholderType <- findAttr (QName "type" Nothing Nothing) ph
                    pure (placeholderType == t)
              listToMaybe (filterChildren containsPlaceholder spTree)
            else Maybe Element
    forall a. Maybe a
    Nothing

          dateIsAutomatic :: NameSpaces -> Element -> Bool
          dateIsAutomatic :: [(Text, Text)] -> Element -> Bool
    dateIsAutomatic [(Text, Text)]
    ns Element
    shape = Maybe Element -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Element -> Bool) -> Maybe Element -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
            txBody <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "txBody") Element
    shape
            p <- findChild (elemName ns "a" "p") txBody
            findChild (elemName ns "a" "fld") p

          replaceDate :: Text -> Element -> Element
          replaceDate :: Text -> Element -> Element
    replaceDate Text
    newDate Element
    e =
            Element
    e { elContent =
                case (elName e) of
                  QName Text
    "t" Maybe Text
    _ (Just Text
    "a") ->
                    [ CData -> Content
    Text (CData { cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataText
                                  , cdData :: Text
    cdData = Text
    newDate
                                  , cdLine :: Maybe Integer
    cdLine = Maybe Integer
    forall a. Maybe a
    Nothing
                                  })
                    ]
                  QName
    _ -> (Element -> Element) -> Content -> Content
    ifElem (Text -> Element -> Element
    replaceDate Text
    newDate) (Content -> Content) -> [Content] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Element -> [Content]
    elContent Element
    e
               }

          ifElem :: (Element -> Element) -> (Content -> Content)
          ifElem :: (Element -> Element) -> Content -> Content
    ifElem Element -> Element
    f (Elem Element
    e) = Element -> Content
    Elem (Element -> Element
    f Element
    e)
          ifElem Element -> Element
    _ Content
    c = Content
    c

          getBooleanAttribute :: Text -> Element -> Maybe Bool
    getBooleanAttribute Text
    t Element
    e =
            (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "1", Text
    "true"]) (Text -> Bool) -> Maybe Text -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
              (QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    t Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    e)

    footerElements ::
      PandocMonad m =>
      (forall a. SlideLayoutsOf a -> a) ->
      P m [Content]
    footerElements :: forall (m :: * -> *).
    PandocMonad m =>
    (forall a. SlideLayoutsOf a -> a) -> P m [Content]
    footerElements forall a. SlideLayoutsOf a -> a
    layout = do
      footerInfo <- (WriterState -> Maybe FooterInfo)
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe FooterInfo)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Maybe FooterInfo
    stFooterInfo
      pure
        $ Elem <$>
          (toList (footerInfo >>= layout . fiDate)
           <> toList (footerInfo >>= layout . fiFooter)
           <> toList (footerInfo >>= layout . fiSlideNumber))

    makeSlideIdMap :: Presentation -> M.Map SlideId Int
    makeSlideIdMap :: Presentation -> Map SlideId Int
    makeSlideIdMap (Presentation DocProps
    _ [Slide]
    slides) =
      [(SlideId, Int)] -> Map SlideId Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(SlideId, Int)] -> Map SlideId Int)
    -> [(SlideId, Int)] -> Map SlideId Int
    forall a b. (a -> b) -> a -> b
    $ (Slide -> SlideId) -> [Slide] -> [SlideId]
    forall a b. (a -> b) -> [a] -> [b]
    map Slide -> SlideId
    slideId [Slide]
    slides [SlideId] -> [Int] -> [(SlideId, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Int
    1..]

    makeSpeakerNotesMap :: Presentation -> M.Map Int Int
    makeSpeakerNotesMap :: Presentation -> Map Int Int
    makeSpeakerNotesMap (Presentation DocProps
    _ [Slide]
    slides) =
      [(Int, Int)] -> Map Int Int
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
    forall a b. (a -> b) -> a -> b
    $
        ((Slide, Int) -> Maybe Int) -> [(Slide, Int)] -> [Int]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Slide, Int) -> Maybe Int
    forall {a}. (Slide, a) -> Maybe a
    f ([Slide]
    slides [Slide] -> [Int] -> [(Slide, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Int
    1..]) [Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Int
    1..]
      where f :: (Slide, a) -> Maybe a
    f (Slide SlideId
    _ Layout
    _ SpeakerNotes
    notes Maybe FilePath
    _, a
    n) = if SpeakerNotes
    notes SpeakerNotes -> SpeakerNotes -> Bool
    forall a. Eq a => a -> a -> Bool
    == SpeakerNotes
    forall a. Monoid a => a
    mempty
                                       then Maybe a
    forall a. Maybe a
    Nothing
                                       else a -> Maybe a
    forall a. a -> Maybe a
    Just a
    n

    presentationToArchive :: PandocMonad m
                          => WriterOptions -> Meta -> Presentation -> m Archive
    presentationToArchive :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Meta -> Presentation -> m Archive
    presentationToArchive WriterOptions
    opts Meta
    meta Presentation
    pres = do
      distArchive <- ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (StrictByteString -> ByteString) -> StrictByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> ByteString
    BL.fromStrict (StrictByteString -> Archive) -> m StrictByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            FilePath -> m StrictByteString
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> m StrictByteString
    readDefaultDataFile FilePath
    "reference.pptx"
      refArchive <- case writerReferenceDoc opts of
                         Just FilePath
    f  -> ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> ((StrictByteString, Maybe Text) -> ByteString)
    -> (StrictByteString, Maybe Text)
    -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> ByteString
    BL.fromStrict (StrictByteString -> ByteString)
    -> ((StrictByteString, Maybe Text) -> StrictByteString)
    -> (StrictByteString, Maybe Text)
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StrictByteString, Maybe Text) -> StrictByteString
    forall a b. (a, b) -> a
    fst
                                      ((StrictByteString, Maybe Text) -> Archive)
    -> m (StrictByteString, Maybe Text) -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (StrictByteString, Maybe Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Text -> m (StrictByteString, Maybe Text)
    P.fetchItem (FilePath -> Text
    T.pack FilePath
    f)
                         Maybe FilePath
    Nothing -> ByteString -> Archive
    toArchive (ByteString -> Archive)
    -> (StrictByteString -> ByteString) -> StrictByteString -> Archive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrictByteString -> ByteString
    BL.fromStrict (StrictByteString -> Archive) -> m StrictByteString -> m Archive
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            FilePath -> m StrictByteString
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> m StrictByteString
    readDataFile FilePath
    "reference.pptx"

      let (referenceLayouts, defaultReferenceLayouts) =
            (getLayoutsFromArchive refArchive, getLayoutsFromArchive distArchive)
      let layoutTitles = SlideLayouts { metadata :: Text
    metadata = Text
    "Title Slide" :: Text
                                      , title :: Text
    title = Text
    "Section Header"
                                      , content :: Text
    content = Text
    "Title and Content"
                                      , twoColumn :: Text
    twoColumn = Text
    "Two Content"
                                      , comparison :: Text
    comparison = Text
    "Comparison"
                                      , contentWithCaption :: Text
    contentWithCaption = Text
    "Content with Caption"
                                      , blank :: Text
    blank = Text
    "Blank"
                                      }
      layouts <- for layoutTitles $ \Text
    layoutTitle -> do
            let layout :: Maybe (NonEmpty (Element, FilePath, Entry))
    layout = CI Text
    -> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    -> Maybe (NonEmpty (Element, FilePath, Entry))
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text -> CI Text
    forall s. FoldCase s => s -> CI s
    CI.mk Text
    layoutTitle) Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    referenceLayouts
            let defaultLayout :: Maybe (NonEmpty (Element, FilePath, Entry))
    defaultLayout = CI Text
    -> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    -> Maybe (NonEmpty (Element, FilePath, Entry))
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text -> CI Text
    forall s. FoldCase s => s -> CI s
    CI.mk Text
    layoutTitle) Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    defaultReferenceLayouts
            case (Maybe (NonEmpty (Element, FilePath, Entry))
    layout, Maybe (NonEmpty (Element, FilePath, Entry))
    defaultLayout) of
              (Maybe (NonEmpty (Element, FilePath, Entry))
    Nothing, Maybe (NonEmpty (Element, FilePath, Entry))
    Nothing) ->
                PandocError -> m SlideLayout
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> PandocError
    PandocSomeError (Text
    "Couldn't find layout named \""
                                             Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    layoutTitle Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" in the provided "
                                             Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "reference doc or in the default "
                                             Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "reference doc included with pandoc."))
              (Maybe (NonEmpty (Element, FilePath, Entry))
    Nothing, Just ((Element
    element, FilePath
    path, Entry
    entry) :| [(Element, FilePath, Entry)]
    _)) -> do
                LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    P.report (Text -> LogMessage
    PowerpointTemplateWarning
                                         (Text
    "Couldn't find layout named \""
                                          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    layoutTitle Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" in provided "
                                          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "reference doc. Falling back to "
                                          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "the default included with pandoc."))
                SlideLayout -> m SlideLayout
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SlideLayout { slElement :: Element
    slElement = Element
    element
                                 , slPath :: FilePath
    slPath = FilePath
    path
                                 , slEntry :: Entry
    slEntry = Entry
    entry
                                 , slInReferenceDoc :: Bool
    slInReferenceDoc = Bool
    False
                                 }
              (Just ((Element
    element, FilePath
    path, Entry
    entry) :| [(Element, FilePath, Entry)]
    _), Maybe (NonEmpty (Element, FilePath, Entry))
    _ ) ->
                SlideLayout -> m SlideLayout
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SlideLayout { slElement :: Element
    slElement = Element
    element
                                 , slPath :: FilePath
    slPath = FilePath
    path
                                 , slEntry :: Entry
    slEntry = Entry
    entry
                                 , slInReferenceDoc :: Bool
    slInReferenceDoc = Bool
    True
                                 }

      master <- getMaster' refArchive distArchive

      let otherStyleIndents = do
            let ns :: [(Text, Text)]
    ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    master
            txStyles <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "txStyles") Element
    master
            otherStyle <- findChild (elemName ns "p" "otherStyle") txStyles
            let makeLevelIndents Text
    name = do
                  e <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "a" Text
    name) Element
    otherStyle
                  pure LevelIndents
                    { indent = fromMaybe (-342900)
                        (findAttr (QName "indent" Nothing Nothing) e
                        >>= readTextAsInteger)
                    , marL = fromMaybe 347663
                        (findAttr (QName "marL" Nothing Nothing) e
                         >>= readTextAsInteger)
                    }
            pure Indents
              { level1 = makeLevelIndents "lvl1pPr"
              , level2 = makeLevelIndents "lvl2pPr"
              , level3 = makeLevelIndents "lvl3pPr"
              , level4 = makeLevelIndents "lvl4pPr"
              , level5 = makeLevelIndents "lvl5pPr"
              , level6 = makeLevelIndents "lvl6pPr"
              , level7 = makeLevelIndents "lvl7pPr"
              , level8 = makeLevelIndents "lvl8pPr"
              , level9 = makeLevelIndents "lvl9pPr"
              }

      utctime <- P.getTimestamp

      presSize <- case getPresentationSize refArchive distArchive of
                    Just (Integer, Integer)
    sz -> (Integer, Integer) -> m (Integer, Integer)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer, Integer)
    sz
                    Maybe (Integer, Integer)
    Nothing -> PandocError -> m (Integer, Integer)
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m (Integer, Integer))
    -> PandocError -> m (Integer, Integer)
    forall a b. (a -> b) -> a -> b
    $
                               Text -> PandocError
    PandocSomeError
                               Text
    "Could not determine presentation size"

      -- note, we need writerTemplate to be Just _ or metaToContext does
      -- nothing
      context <- metaToContext opts{ writerTemplate =
                                      writerTemplate opts <|> Just mempty }
                    (return . literal . stringify)
                    (return . literal . stringify) meta

      let env = WriterEnv
    forall a. Default a => a
    def { envRefArchive = refArchive
                    , envDistArchive = distArchive
                    , envUTCTime = utctime
                    , envOpts = opts
                    , envContext = context
                    , envPresentationSize = presSize
                    , envSlideIdMap = makeSlideIdMap pres
                    , envSpeakerNotesIdMap = makeSpeakerNotesMap pres
                    , envSlideLayouts = Just layouts
                    , envOtherStyleIndents = otherStyleIndents
                    }

      let st = WriterState
    forall a. Default a => a
    def { stMediaGlobalIds = initialGlobalIds refArchive distArchive
                   }

      runP env st $ presentationToArchiveP pres

    -- | Get all slide layouts from an archive, as a map where the layout's name
    -- gives the map key.
    --
    -- For each layout, the map contains its XML representation, its path within
    -- the archive, and the archive entry.
    getLayoutsFromArchive :: Archive -> M.Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    getLayoutsFromArchive :: Archive -> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    getLayoutsFromArchive Archive
    archive =
      (NonEmpty (Element, FilePath, Entry)
     -> NonEmpty (Element, FilePath, Entry)
     -> NonEmpty (Element, FilePath, Entry))
    -> [(CI Text, NonEmpty (Element, FilePath, Entry))]
    -> Map (CI Text) (NonEmpty (Element, FilePath, Entry))
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith NonEmpty (Element, FilePath, Entry)
    -> NonEmpty (Element, FilePath, Entry)
    -> NonEmpty (Element, FilePath, Entry)
    forall a. Semigroup a => a -> a -> a
    (<>) ((\t :: (Element, FilePath, Entry)
    t@(Element
    e, FilePath
    _, Entry
    _) -> (Text -> CI Text
    forall s. FoldCase s => s -> CI s
    CI.mk (Element -> Text
    name Element
    e), (Element, FilePath, Entry) -> NonEmpty (Element, FilePath, Entry)
    forall a. a -> NonEmpty a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Element, FilePath, Entry)
    t)) ((Element, FilePath, Entry)
     -> (CI Text, NonEmpty (Element, FilePath, Entry)))
    -> [(Element, FilePath, Entry)]
    -> [(CI Text, NonEmpty (Element, FilePath, Entry))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Element, FilePath, Entry)]
    layouts)
      where
        layouts :: [(Element, FilePath, Entry)]
        layouts :: [(Element, FilePath, Entry)]
    layouts = (FilePath -> Maybe (Element, FilePath, Entry))
    -> [FilePath] -> [(Element, FilePath, Entry)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe (Element, FilePath, Entry)
    findElementByPath [FilePath]
    paths
        parseXml' :: Entry -> Maybe Element
    parseXml' Entry
    entry = case Text -> Either Text Element
    parseXMLElement (ByteString -> Text
    UTF8.toTextLazy (Entry -> ByteString
    fromEntry Entry
    entry)) of
                Left Text
    _ -> Maybe Element
    forall a. Maybe a
    Nothing
                Right Element
    element -> Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    element
        findElementByPath :: FilePath -> Maybe (Element, FilePath, Entry)
        findElementByPath :: FilePath -> Maybe (Element, FilePath, Entry)
    findElementByPath FilePath
    path = do
          entry <- FilePath -> Archive -> Maybe Entry
    findEntryByPath FilePath
    path Archive
    archive
          element <- parseXml' entry
          pure (element, path, entry)
        paths :: [FilePath]
    paths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Pattern -> FilePath -> Bool
    match (FilePath -> Pattern
    compile FilePath
    "ppt/slideLayouts/slideLayout*.xml")) (Archive -> [FilePath]
    filesInArchive Archive
    archive)
        name :: Element -> Text
    name Element
    element = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "Untitled layout" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ do
                let ns :: [(Text, Text)]
    ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    element
                cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    element
                findAttr (QName "name" Nothing Nothing) cSld

    --------------------------------------------------

    -- Check to see if the presentation has speaker notes. This will
    -- influence whether we import the notesMaster template.
    presHasSpeakerNotes :: Presentation -> Bool
    presHasSpeakerNotes :: Presentation -> Bool
    presHasSpeakerNotes (Presentation DocProps
    _ [Slide]
    slides) =
      Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Slide -> Bool) -> [Slide] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((SpeakerNotes
    forall a. Monoid a => a
    mempty SpeakerNotes -> SpeakerNotes -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (SpeakerNotes -> Bool) -> (Slide -> SpeakerNotes) -> Slide -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Slide -> SpeakerNotes
    slideSpeakerNotes) [Slide]
    slides

    curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
    curSlideHasSpeakerNotes :: forall (m :: * -> *). PandocMonad m => P m Bool
    curSlideHasSpeakerNotes =
      Int -> Map Int Int -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member (Int -> Map Int Int -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Int
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int Int -> Bool)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envCurSlideId ReaderT WriterEnv (StateT WriterState m) (Map Int Int -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) (a -> b)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (WriterEnv -> Map Int Int)
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Map Int Int
    envSpeakerNotesIdMap

    --------------------------------------------------

    getLayout :: PandocMonad m => Layout -> P m Element
    getLayout :: forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    layout = SlideLayouts -> Element
    getElement (SlideLayouts -> Element)
    -> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT WriterEnv (StateT WriterState m) SlideLayouts
    forall (m :: * -> *). PandocMonad m => P m SlideLayouts
    getSlideLayouts
      where
        getElement :: SlideLayouts -> Element
    getElement =
          SlideLayout -> Element
    slElement (SlideLayout -> Element)
    -> (SlideLayouts -> SlideLayout) -> SlideLayouts -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . case Layout
    layout of
            MetadataSlide{}           -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    metadata
            TitleSlide{}              -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    title
            ContentSlide{}            -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    content
            TwoColumnSlide{}          -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    twoColumn
            ComparisonSlide{}         -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    comparison
            ContentWithCaptionSlide{} -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    contentWithCaption
            BlankSlide{}              -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    blank

    shapeHasId :: NameSpaces -> T.Text -> Element -> Bool
    shapeHasId :: [(Text, Text)] -> Text -> Element -> Bool
    shapeHasId [(Text, Text)]
    ns Text
    ident Element
    element = [(Text, Text)] -> Element -> Maybe Text
    getShapeId [(Text, Text)]
    ns Element
    element Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ident

    getShapeId :: NameSpaces -> Element -> Maybe Text
    getShapeId :: [(Text, Text)] -> Element -> Maybe Text
    getShapeId [(Text, Text)]
    ns Element
    element = do
      nvSpPr <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvSpPr") Element
    element
      cNvPr <- findChild (elemName ns "p" "cNvPr") nvSpPr
      findAttr (QName "id" Nothing Nothing) cNvPr

    type ShapeId = Integer

    getContentShape :: PandocMonad m => NameSpaces -> Element -> P m (Maybe ShapeId, Element)
    getContentShape :: forall (m :: * -> *).
    PandocMonad m =>
    [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
    getContentShape [(Text, Text)]
    ns Element
    spTreeElem
      | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "spTree" Element
    spTreeElem = do
          ph@Placeholder{index, placeholderType} <- (WriterEnv -> Placeholder)
    -> ReaderT WriterEnv (StateT WriterState m) Placeholder
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Placeholder
    envPlaceholder
          case drop index (getShapesByPlaceHolderType ns spTreeElem placeholderType) of
            Element
    sp : [Element]
    _ -> let
              shapeId :: Maybe Integer
    shapeId = [(Text, Text)] -> Element -> Maybe Text
    getShapeId [(Text, Text)]
    ns Element
    sp Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Integer
    readTextAsInteger
              in (Maybe Integer, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Integer
    shapeId, Element
    sp)
            [] -> PandocError
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError
     -> ReaderT
          WriterEnv (StateT WriterState m) (Maybe Integer, Element))
    -> PandocError
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ Placeholder -> Text
    missingPlaceholderMessage Placeholder
    ph
    getContentShape [(Text, Text)]
    _ Element
    _ = PandocError
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError
     -> ReaderT
          WriterEnv (StateT WriterState m) (Maybe Integer, Element))
    -> PandocError
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError
                          Text
    "Attempted to find content on non shapeTree"

    missingPlaceholderMessage :: Placeholder -> Text
    missingPlaceholderMessage :: Placeholder -> Text
    missingPlaceholderMessage Placeholder{Int
    PHType
    placeholderType :: Placeholder -> PHType
    index :: Placeholder -> Int
    placeholderType :: PHType
    index :: Int
    ..} =
      Text
    "Could not find a " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ordinal
      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " placeholder of type " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    placeholderText
      where
        ordinal :: Text
    ordinal = FilePath -> Text
    T.pack (Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    index) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
          case (Int
    index Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    100, Int
    index Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    10) of
            (Int
    11, Int
    _) -> Text
    "th"
            (Int
    12, Int
    _) -> Text
    "th"
            (Int
    13, Int
    _) -> Text
    "th"
            (Int
    _,  Int
    1) -> Text
    "st"
            (Int
    _,  Int
    2) -> Text
    "nd"
            (Int
    _,  Int
    3) -> Text
    "rd"
            (Int, Int)
    _       -> Text
    "th"
        placeholderText :: Text
    placeholderText = case PHType
    placeholderType of
          PHType
    ObjType -> Text
    "obj (or nothing)"
          PHType Text
    t -> Text
    t

    getShapeDimensions :: NameSpaces
                       -> Element
                       -> Maybe ((Integer, Integer), (Integer, Integer))
    getShapeDimensions :: [(Text, Text)]
    -> Element -> Maybe ((Integer, Integer), (Integer, Integer))
    getShapeDimensions [(Text, Text)]
    ns Element
    element
      | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "sp" Element
    element = do
          spPr <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spPr") Element
    element
          xfrm <- findChild (elemName ns "a" "xfrm") spPr
          off <- findChild (elemName ns "a" "off") xfrm
          xS <- findAttr (QName "x" Nothing Nothing) off
          yS <- findAttr (QName "y" Nothing Nothing) off
          ext <- findChild (elemName ns "a" "ext") xfrm
          cxS <- findAttr (QName "cx" Nothing Nothing) ext
          cyS <- findAttr (QName "cy" Nothing Nothing) ext
          x <- readTextAsInteger xS
          y <- readTextAsInteger yS
          cx <- readTextAsInteger cxS
          cy <- readTextAsInteger cyS
          return ((x `div` 12700, y `div` 12700),
                  (cx `div` 12700, cy `div` 12700))
      | Bool
    otherwise = Maybe ((Integer, Integer), (Integer, Integer))
    forall a. Maybe a
    Nothing

    getMasterShapeDimensionsById :: T.Text
                                 -> Element
                                 -> Maybe ((Integer, Integer), (Integer, Integer))
    getMasterShapeDimensionsById :: Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer))
    getMasterShapeDimensionsById Text
    ident Element
    master = do
      let ns :: [(Text, Text)]
    ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    master
      cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    master
      spTree <- findChild (elemName ns "p" "spTree") cSld
      sp <- filterChild (\Element
    e -> [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "sp" Element
    e Bool -> Bool -> Bool
    && [(Text, Text)] -> Text -> Element -> Bool
    shapeHasId [(Text, Text)]
    ns Text
    ident Element
    e) spTree
      getShapeDimensions ns sp

    getContentShapeSize :: PandocMonad m
                        => NameSpaces
                        -> Element
                        -> Element
                        -> P m ((Integer, Integer), (Integer, Integer))
    getContentShapeSize :: forall (m :: * -> *).
    PandocMonad m =>
    [(Text, Text)]
    -> Element
    -> Element
    -> P m ((Integer, Integer), (Integer, Integer))
    getContentShapeSize [(Text, Text)]
    ns Element
    layout Element
    master
      | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "sldLayout" Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (_, sp)  <- [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
    getContentShape [(Text, Text)]
    ns Element
    spTree
          case getShapeDimensions ns sp of
            Just ((Integer, Integer), (Integer, Integer))
    sz -> ((Integer, Integer), (Integer, Integer))
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, Integer), (Integer, Integer))
    sz
            Maybe ((Integer, Integer), (Integer, Integer))
    Nothing -> do let mbSz :: Maybe ((Integer, Integer), (Integer, Integer))
    mbSz =
                                QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvSpPr") Element
    sp Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cNvPr") Maybe Element -> (Element -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Maybe Text
    -> (Text -> Maybe ((Integer, Integer), (Integer, Integer)))
    -> Maybe ((Integer, Integer), (Integer, Integer))
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                (Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer)))
    -> Element
    -> Text
    -> Maybe ((Integer, Integer), (Integer, Integer))
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Text -> Element -> Maybe ((Integer, Integer), (Integer, Integer))
    getMasterShapeDimensionsById Element
    master
                          case Maybe ((Integer, Integer), (Integer, Integer))
    mbSz of
                            Just ((Integer, Integer), (Integer, Integer))
    sz' -> ((Integer, Integer), (Integer, Integer))
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, Integer), (Integer, Integer))
    sz'
                            Maybe ((Integer, Integer), (Integer, Integer))
    Nothing -> PandocError
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          ((Integer, Integer), (Integer, Integer)))
    -> PandocError
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError
                                       Text
    "Couldn't find necessary content shape size"
    getContentShapeSize [(Text, Text)]
    _ Element
    _ Element
    _ = PandocError
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError
     -> ReaderT
          WriterEnv
          (StateT WriterState m)
          ((Integer, Integer), (Integer, Integer)))
    -> PandocError
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         ((Integer, Integer), (Integer, Integer))
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocSomeError
                                Text
    "Attempted to find content shape size in non-layout"

    buildSpTree :: NameSpaces -> Element -> [Content] -> Element
    buildSpTree :: [(Text, Text)] -> Element -> [Content] -> Element
    buildSpTree [(Text, Text)]
    ns Element
    spTreeElem [Content]
    newShapes =
      Element
    emptySpTreeElem { elContent = newContent }
      where newContent :: [Content]
    newContent = Element -> [Content]
    elContent Element
    emptySpTreeElem [Content] -> [Content] -> [Content]
    forall a. Semigroup a => a -> a -> a
    <> [Content]
    newShapes
            emptySpTreeElem :: Element
    emptySpTreeElem = Element
    spTreeElem { elContent = filter fn (elContent spTreeElem) }
            fn :: Content -> Bool
            fn :: Content -> Bool
    fn (Elem Element
    e) = [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "nvGrpSpPr" Element
    e Bool -> Bool -> Bool
    ||
                          [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "grpSpPr" Element
    e
            fn Content
    _        = Bool
    True

    replaceNamedChildren :: NameSpaces
                         -> Text
                         -> Text
                         -> [Element]
                         -> Element
                         -> Element
    replaceNamedChildren :: [(Text, Text)] -> Text -> Text -> [Element] -> Element -> Element
    replaceNamedChildren [(Text, Text)]
    ns Text
    prefix Text
    name [Element]
    newKids Element
    element =
      Element
    element { elContent = concat $ fun True $ elContent element }
      where
        fun :: Bool -> [Content] -> [[Content]]
        fun :: Bool -> [Content] -> [[Content]]
    fun Bool
    _ [] = []
        fun Bool
    switch (Elem Element
    e : [Content]
    conts) | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    prefix Text
    name Element
    e =
                                          if Bool
    switch
                                          then (Element -> Content) -> [Element] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Content
    Elem [Element]
    newKids [Content] -> [[Content]] -> [[Content]]
    forall a. a -> [a] -> [a]
    : Bool -> [Content] -> [[Content]]
    fun Bool
    False [Content]
    conts
                                          else Bool -> [Content] -> [[Content]]
    fun Bool
    False [Content]
    conts
        fun Bool
    switch (Content
    cont : [Content]
    conts) = [Content
    cont] [Content] -> [[Content]] -> [[Content]]
    forall a. a -> [a] -> [a]
    : Bool -> [Content] -> [[Content]]
    fun Bool
    switch [Content]
    conts

    ----------------------------------------------------------------

    registerLink :: PandocMonad m => LinkTarget -> P m Int
    registerLink :: forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
    registerLink LinkTarget
    link = do
      curSlideId <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envCurSlideId
      linkReg <- gets stLinkIds
      mediaReg <- gets stMediaIds
      hasSpeakerNotes <- curSlideHasSpeakerNotes
      let maxLinkId = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int (Map Int LinkTarget)
    linkReg Maybe (Map Int LinkTarget)
    -> (Map Int LinkTarget -> Maybe (NonEmpty Int))
    -> Maybe (NonEmpty Int)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Int] -> Maybe (NonEmpty Int)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Int] -> Maybe (NonEmpty Int))
    -> (Map Int LinkTarget -> [Int])
    -> Map Int LinkTarget
    -> Maybe (NonEmpty Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Int LinkTarget -> [Int]
    forall k a. Map k a -> [k]
    M.keys of
            Just NonEmpty Int
    xs -> NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum NonEmpty Int
    xs
            Maybe (NonEmpty Int)
    Nothing
              | Bool
    hasSpeakerNotes -> Int
    2
              | Bool
    otherwise       -> Int
    1
          maxMediaId = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int [MediaInfo]
    mediaReg Maybe [MediaInfo]
    -> ([MediaInfo] -> Maybe (NonEmpty MediaInfo))
    -> Maybe (NonEmpty MediaInfo)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [MediaInfo] -> Maybe (NonEmpty MediaInfo)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty of
            Just NonEmpty MediaInfo
    mInfos -> NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (MediaInfo -> Int) -> NonEmpty MediaInfo -> NonEmpty Int
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MediaInfo -> Int
    mInfoLocalId NonEmpty MediaInfo
    mInfos
            Maybe (NonEmpty MediaInfo)
    Nothing
              | Bool
    hasSpeakerNotes -> Int
    2
              | Bool
    otherwise       -> Int
    1
          maxId = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    maxLinkId Int
    maxMediaId
          slideLinks = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int (Map Int LinkTarget)
    linkReg of
            Just Map Int LinkTarget
    mp -> Int -> LinkTarget -> Map Int LinkTarget -> Map Int LinkTarget
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (Int
    maxId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) LinkTarget
    link Map Int LinkTarget
    mp
            Maybe (Map Int LinkTarget)
    Nothing -> Int -> LinkTarget -> Map Int LinkTarget
    forall k a. k -> a -> Map k a
    M.singleton (Int
    maxId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) LinkTarget
    link
      modify $ \WriterState
    st -> WriterState
    st{ stLinkIds = M.insert curSlideId slideLinks linkReg}
      return $ maxId + 1

    registerMedia :: PandocMonad m => FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia :: forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia FilePath
    fp [ParaElem]
    caption = do
      curSlideId <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Int
    envCurSlideId
      linkReg <- gets stLinkIds
      mediaReg <- gets stMediaIds
      globalIds <- gets stMediaGlobalIds
      hasSpeakerNotes <- curSlideHasSpeakerNotes
      let maxLinkId = case Int -> Map Int (Map Int LinkTarget) -> Maybe (Map Int LinkTarget)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int (Map Int LinkTarget)
    linkReg Maybe (Map Int LinkTarget)
    -> (Map Int LinkTarget -> Maybe (NonEmpty Int))
    -> Maybe (NonEmpty Int)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Int] -> Maybe (NonEmpty Int)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Int] -> Maybe (NonEmpty Int))
    -> (Map Int LinkTarget -> [Int])
    -> Map Int LinkTarget
    -> Maybe (NonEmpty Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Int LinkTarget -> [Int]
    forall k a. Map k a -> [k]
    M.keys of
              Just NonEmpty Int
    ks -> NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum NonEmpty Int
    ks
              Maybe (NonEmpty Int)
    Nothing
                | Bool
    hasSpeakerNotes -> Int
    2
                | Bool
    otherwise       -> Int
    1
          maxMediaId = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int [MediaInfo]
    mediaReg Maybe [MediaInfo]
    -> ([MediaInfo] -> Maybe (NonEmpty MediaInfo))
    -> Maybe (NonEmpty MediaInfo)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [MediaInfo] -> Maybe (NonEmpty MediaInfo)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty of
              Just NonEmpty MediaInfo
    mInfos -> NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (MediaInfo -> Int) -> NonEmpty MediaInfo -> NonEmpty Int
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MediaInfo -> Int
    mInfoLocalId NonEmpty MediaInfo
    mInfos
              Maybe (NonEmpty MediaInfo)
    Nothing
                | Bool
    hasSpeakerNotes -> Int
    2
                | Bool
    otherwise       -> Int
    1
          maxLocalId = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    maxLinkId Int
    maxMediaId

          maxGlobalId = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Maybe (NonEmpty Int)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
    forall a b. (a -> b) -> a -> b
    $ Map FilePath Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map FilePath Int
    globalIds

      (imgBytes, mbMt) <- P.fetchItem $ T.pack fp
      let imgExt = (Maybe Text
    mbMt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text
    extensionFromMimeType Maybe Text -> (Text -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\Text
    x -> Text -> Maybe Text
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    "." Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    x))
                   Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
                   case StrictByteString -> Maybe ImageType
    imageType StrictByteString
    imgBytes of
                     Just ImageType
    Png  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".png"
                     Just ImageType
    Jpeg -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".jpeg"
                     Just ImageType
    Gif  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".gif"
                     Just ImageType
    Pdf  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".pdf"
                     Just ImageType
    Eps  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".eps"
                     Just ImageType
    Svg  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".svg"
                     Just ImageType
    Emf  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".emf"
                     Just ImageType
    Tiff -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".tiff"
                     Just ImageType
    Webp -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".webp"
                     Just ImageType
    Avif -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ".avif"
                     Maybe ImageType
    Nothing   -> Maybe Text
    forall a. Maybe a
    Nothing

      let newGlobalId = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (Int
    maxGlobalId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (FilePath -> Map FilePath Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup FilePath
    fp Map FilePath Int
    globalIds)

      let newGlobalIds = FilePath -> Int -> Map FilePath Int -> Map FilePath Int
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert FilePath
    fp Int
    newGlobalId Map FilePath Int
    globalIds

      let mediaInfo = MediaInfo { mInfoFilePath :: FilePath
    mInfoFilePath = FilePath
    fp
                                , mInfoLocalId :: Int
    mInfoLocalId = Int
    maxLocalId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                                , mInfoGlobalId :: Int
    mInfoGlobalId = Int
    newGlobalId
                                , mInfoMimeType :: Maybe Text
    mInfoMimeType =
                                    case Maybe Text
    mbMt of
                                      -- see #9113
                                      Just Text
    t | Text
    ";base64" Text -> Text -> Bool
    `T.isSuffixOf` Text
    t
                                         -> Text -> Text -> Maybe Text
    T.stripSuffix Text
    ";base64" Text
    t
                                      Maybe Text
    x -> Maybe Text
    x
                                , mInfoExt :: Maybe Text
    mInfoExt = Maybe Text
    imgExt
                                , mInfoCaption :: Bool
    mInfoCaption = (Bool -> Bool
    not (Bool -> Bool) -> ([ParaElem] -> Bool) -> [ParaElem] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [ParaElem]
    caption
                                }

      let slideMediaInfos = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    curSlideId Map Int [MediaInfo]
    mediaReg of
            Just [MediaInfo]
    minfos -> MediaInfo
    mediaInfo MediaInfo -> [MediaInfo] -> [MediaInfo]
    forall a. a -> [a] -> [a]
    : [MediaInfo]
    minfos
            Maybe [MediaInfo]
    Nothing     -> [MediaInfo
    mediaInfo]

      modify $ \WriterState
    st -> WriterState
    st{ stMediaIds = M.insert curSlideId slideMediaInfos mediaReg
                        , stMediaGlobalIds = newGlobalIds
                        }
      return mediaInfo

    makeMediaEntry :: PandocMonad m => MediaInfo -> P m Entry
    makeMediaEntry :: forall (m :: * -> *). PandocMonad m => MediaInfo -> P m Entry
    makeMediaEntry MediaInfo
    mInfo = do
      epochtime <- POSIXTime -> Integer
    forall b. Integral b => POSIXTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Integer)
    -> (UTCTime -> POSIXTime) -> UTCTime -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> POSIXTime
    utcTimeToPOSIXSeconds (UTCTime -> Integer)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    -> ReaderT WriterEnv (StateT WriterState m) Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterEnv -> UTCTime)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> UTCTime
    envUTCTime
      (imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo)
      let ext = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (MediaInfo -> Maybe Text
    mInfoExt MediaInfo
    mInfo)
      let fp = FilePath
    "ppt/media/image" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
              Int -> FilePath
    forall a. Show a => a -> FilePath
    show (MediaInfo -> Int
    mInfoGlobalId MediaInfo
    mInfo) FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Text -> FilePath
    T.unpack Text
    ext
      return $ toEntry fp epochtime $ BL.fromStrict imgBytes

    makeMediaEntries :: PandocMonad m => P m [Entry]
    makeMediaEntries :: forall (m :: * -> *). PandocMonad m => P m [Entry]
    makeMediaEntries = do
      mediaInfos <- (WriterState -> Map Int [MediaInfo])
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map Int [MediaInfo]
    stMediaIds
      let allInfos = [[MediaInfo]] -> [MediaInfo]
    forall a. Monoid a => [a] -> a
    mconcat ([[MediaInfo]] -> [MediaInfo]) -> [[MediaInfo]] -> [MediaInfo]
    forall a b. (a -> b) -> a -> b
    $ Map Int [MediaInfo] -> [[MediaInfo]]
    forall k a. Map k a -> [a]
    M.elems Map Int [MediaInfo]
    mediaInfos
      mapM makeMediaEntry allInfos

    -- -- | Scales the image to fit the page
    -- -- sizes are passed in emu
    -- fitToPage' :: (Double, Double)  -- image size in emu
    --            -> Integer           -- pageWidth
    --            -> Integer           -- pageHeight
    --            -> (Integer, Integer) -- imagesize
    -- fitToPage' (x, y) pageWidth pageHeight
    --   -- Fixes width to the page width and scales the height
    --   | x <= fromIntegral pageWidth && y <= fromIntegral pageHeight =
    --       (floor x, floor y)
    --   | x / fromIntegral pageWidth > y / fromIntegral pageWidth =
    --       (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
    --   | otherwise =
    --       (floor $ ((fromIntegral pageHeight) / y) * x, pageHeight)

    -- positionImage :: (Double, Double) -> Integer -> Integer -> (Integer, Integer)
    -- positionImage (x, y) pageWidth pageHeight =
    --   let (x', y') = fitToPage' (x, y) pageWidth pageHeight
    --   in
    --     ((pageWidth - x') `div` 2, (pageHeight - y') `div`  2)

    getMaster :: PandocMonad m => P m Element
    getMaster :: forall (m :: * -> *). PandocMonad m => P m Element
    getMaster = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      getMaster' refArchive distArchive

    getMaster' :: PandocMonad m => Archive -> Archive -> m Element
    getMaster' :: forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> m Element
    getMaster' Archive
    refArchive Archive
    distArchive =
      Archive -> Archive -> FilePath -> m Element
    forall (m :: * -> *).
    PandocMonad m =>
    Archive -> Archive -> FilePath -> m Element
    parseXml Archive
    refArchive Archive
    distArchive FilePath
    "ppt/slideMasters/slideMaster1.xml"

    getMasterRels :: PandocMonad m => P m Element
    getMasterRels :: forall (m :: * -> *). PandocMonad m => P m Element
    getMasterRels = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      parseXml refArchive distArchive "ppt/slideMasters/_rels/slideMaster1.xml.rels"

    -- We want to get the header dimensions, so we can make sure that the
    -- image goes underneath it. We only use this in a content slide if it
    -- has a header.

    -- getHeaderSize :: PandocMonad m => P m ((Integer, Integer), (Integer, Integer))
    -- getHeaderSize = do
    --   master <- getMaster
    --   let ns = elemToNameSpaces master
    --       sps = [master] >>=
    --             findChildren (elemName ns "p" "cSld") >>=
    --             findChildren (elemName ns "p" "spTree") >>=
    --             findChildren (elemName ns "p" "sp")
    --       mbXfrm =
    --         listToMaybe (filter (shapeHasName ns "Title Placeholder 1") sps) >>=
    --         findChild (elemName ns "p" "spPr") >>=
    --         findChild (elemName ns "a" "xfrm")
    --       xoff = mbXfrm >>=
    --              findChild (elemName ns "a" "off") >>=
    --              findAttr (QName "x" Nothing Nothing) >>=
    --              (listToMaybe . (\s -> reads s :: [(Integer, String)]))
    --       yoff = mbXfrm >>=
    --              findChild (elemName ns "a" "off") >>=
    --              findAttr (QName "y" Nothing Nothing) >>=
    --              (listToMaybe . (\s -> reads s :: [(Integer, String)]))
    --       xext = mbXfrm >>=
    --              findChild (elemName ns "a" "ext") >>=
    --              findAttr (QName "cx" Nothing Nothing) >>=
    --              (listToMaybe . (\s -> reads s :: [(Integer, String)]))
    --       yext = mbXfrm >>=
    --              findChild (elemName ns "a" "ext") >>=
    --              findAttr (QName "cy" Nothing Nothing) >>=
    --              (listToMaybe . (\s -> reads s :: [(Integer, String)]))
    --       off = case xoff of
    --               Just (xoff', _) | Just (yoff',_) <- yoff -> (xoff', yoff')
    --               _                               -> (1043490, 1027664)
    --       ext = case xext of
    --               Just (xext', _) | Just (yext',_) <- yext -> (xext', yext')
    --               _                               -> (7024744, 1143000)
    --   return $ (off, ext)

    -- Hard-coded for now
    -- captionPosition :: ((Integer, Integer), (Integer, Integer))
    -- captionPosition = ((457200, 6061972), (8229600, 527087))

    captionHeight :: Integer
    captionHeight :: Integer
    captionHeight = Integer
    40

    createCaption :: PandocMonad m
                  => ((Integer, Integer), (Integer, Integer))
                  -> [ParaElem]
                  -> P m (ShapeId, Element)
    createCaption :: forall (m :: * -> *).
    PandocMonad m =>
    ((Integer, Integer), (Integer, Integer))
    -> [ParaElem] -> P m (Integer, Element)
    createCaption ((Integer, Integer), (Integer, Integer))
    contentShapeDimensions [ParaElem]
    paraElements = do
      let para :: Paragraph
    para = ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def{pPropAlign = Just AlgnCenter} [ParaElem]
    paraElements
      elements <- (Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [Paragraph]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement [Paragraph
    para]
      let ((x, y), (cx, cy)) = contentShapeDimensions
      let txBody = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                   [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
      return
        ( 1
        ,  surroundWithMathAlternate $
           mknode "p:sp" [] [ mknode "p:nvSpPr" []
                              [ mknode "p:cNvPr" [("id","1"), ("name","TextBox 3")] ()
                              , mknode "p:cNvSpPr" [("txBox", "1")] ()
                              , mknode "p:nvPr" []
                                [mknode "p:ph" [("idx", "1")] ()]
                              ]
                            , mknode "p:spPr" []
                              [ mknode "a:xfrm" []
                                [ mknode "a:off" [("x", tshow $ 12700 * x),
                                                  ("y", tshow $ 12700 * (y + cy - captionHeight))] ()
                                , mknode "a:ext" [("cx", tshow $ 12700 * cx),
                                                  ("cy", tshow $ 12700 * captionHeight)] ()
                                ]
                              , mknode "a:prstGeom" [("prst", "rect")]
                                [ mknode "a:avLst" [] ()
                                ]
                              , mknode "a:noFill" [] ()
                              ]
                            , txBody
                            ]
        )

    makePicElements :: PandocMonad m
                    => Element
                    -> PicProps
                    -> MediaInfo
                    -> Text
                    -> [ParaElem]
                    -> P m [(ShapeId, Element)]
    makePicElements :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> PicProps
    -> MediaInfo
    -> Text
    -> [ParaElem]
    -> P m [(Integer, Element)]
    makePicElements Element
    layout PicProps
    picProps MediaInfo
    mInfo Text
    titleText [ParaElem]
    alt = do
      opts <- (WriterEnv -> WriterOptions)
    -> ReaderT WriterEnv (StateT WriterState m) WriterOptions
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> WriterOptions
    envOpts
      (pageWidth, pageHeight) <- asks envPresentationSize
      -- hasHeader <- asks envSlideHasHeader
      let hasCaption = MediaInfo -> Bool
    mInfoCaption MediaInfo
    mInfo
      (imgBytes, _) <- P.fetchItem (T.pack $ mInfoFilePath mInfo)
      let (pxX, pxY) = case imageSize opts imgBytes of
            Right ImageSize
    sz -> ImageSize -> (Integer, Integer)
    sizeInPixels ImageSize
    sz
            Left Text
    _   -> ImageSize -> (Integer, Integer)
    sizeInPixels ImageSize
    forall a. Default a => a
    def
      master <- getMaster
      let ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      ((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master
                               `catchError`
                               (\PandocError
    _ -> ((Integer, Integer), (Integer, Integer))
    -> P m ((Integer, Integer), (Integer, Integer))
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer
    0, Integer
    0), (Integer
    pageWidth, Integer
    pageHeight)))

      let cy = if Bool
    hasCaption then Integer
    cytmp Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    captionHeight else Integer
    cytmp

      let imgRatio = Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    pxX Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    pxY :: Double
          boxRatio = Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    cx Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    cy :: Double
          (dimX, dimY) = if imgRatio > boxRatio
                         then (fromIntegral cx, fromIntegral cx / imgRatio)
                         else (fromIntegral cy * imgRatio, fromIntegral cy)

          (dimX', dimY') = (round dimX * 12700, round dimY * 12700) :: (Integer, Integer)
          (xoff, yoff) = (fromIntegral x + (fromIntegral cx - dimX) / 2,
                          fromIntegral y + (fromIntegral cy - dimY) / 2)
          (xoff', yoff') = (round xoff * 12700, round yoff * 12700) :: (Integer, Integer)

      let cNvPicPr = Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvPicPr" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                     Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:picLocks" [(Text
    "noGrp",Text
    "1")
                                         ,(Text
    "noChangeAspect",Text
    "1")] ()
      -- cNvPr will contain the link information so we do that separately,
      -- and register the link if necessary.
      let description = (if Text -> Bool
    T.null Text
    titleText
                          then Text
    ""
                          else Text
    titleText Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n")
                          Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack (MediaInfo -> FilePath
    mInfoFilePath MediaInfo
    mInfo)
      let cNvPrAttr = [(Text
    "descr", Text
    description),
                       (Text
    "id",Text
    "0"),
                       (Text
    "name",Text
    "Picture 1")]
      cNvPr <- case picPropLink picProps of
        Just LinkTarget
    link -> do idNum <- LinkTarget -> P m Int
    forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
    registerLink LinkTarget
    link
                        return $ mknode "p:cNvPr" cNvPrAttr $
                          mknode "a:hlinkClick" [("r:id", "rId" <> tshow idNum)] ()
        Maybe LinkTarget
    Nothing   -> Element -> P m Element
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> P m Element) -> Element -> P m Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvPr" [(Text, Text)]
    cNvPrAttr ()
      let nvPicPr  = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvPicPr" []
                     [ Element
    cNvPr
                     , Element
    cNvPicPr
                     , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvPr" [] ()]
      let blipFill = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:blipFill" []
                     [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:blip" [(Text
    "r:embed", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                         Int -> Text
    forall a. Show a => a -> Text
    tshow (MediaInfo -> Int
    mInfoLocalId MediaInfo
    mInfo))] ()
                     , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:stretch" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                       Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:fillRect" [] () ]
      let xfrm =    Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:xfrm" []
                    [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:off" [(Text
    "x", Integer -> Text
    forall a. Show a => a -> Text
    tshow Integer
    xoff'), (Text
    "y", Integer -> Text
    forall a. Show a => a -> Text
    tshow Integer
    yoff')] ()
                    , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:ext" [(Text
    "cx", Integer -> Text
    forall a. Show a => a -> Text
    tshow Integer
    dimX')
                                     ,(Text
    "cy", Integer -> Text
    forall a. Show a => a -> Text
    tshow Integer
    dimY')] () ]
      let prstGeom = Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:prstGeom" [(Text
    "prst",Text
    "rect")] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $
                     Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:avLst" [] ()
      let ln =      Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:ln" [(Text
    "w",Text
    "9525")]
                    [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:noFill" [] ()
                    , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:headEnd" [] ()
                    , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tailEnd" [] () ]
      let spPr =    Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:spPr" [(Text
    "bwMode",Text
    "auto")]
                    [Element
    xfrm, Element
    prstGeom, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:noFill" [] (), Element
    ln]

      let picShape = ( Integer
    0
                     , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:pic" []
                       [ Element
    nvPicPr
                       , Element
    blipFill
                       , Element
    spPr ]
                     )

      -- And now, maybe create the caption:
      if hasCaption
        then do cap <- createCaption ((x, y), (cx, cytmp)) alt
                return [picShape, cap]
        else return [picShape]

    consolidateRuns :: [ParaElem] -> [ParaElem]
    consolidateRuns :: [ParaElem] -> [ParaElem]
    consolidateRuns [] = []
    consolidateRuns (Run RunProps
    pr1 Text
    s1 : Run RunProps
    pr2 Text
    s2 : [ParaElem]
    xs)
      | RunProps
    pr1 RunProps -> RunProps -> Bool
    forall a. Eq a => a -> a -> Bool
    == RunProps
    pr2 = [ParaElem] -> [ParaElem]
    consolidateRuns (RunProps -> Text -> ParaElem
    Run RunProps
    pr1 (Text
    s1 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s2) ParaElem -> [ParaElem] -> [ParaElem]
    forall a. a -> [a] -> [a]
    : [ParaElem]
    xs)
    consolidateRuns (ParaElem
    x:[ParaElem]
    xs) = ParaElem
    x ParaElem -> [ParaElem] -> [ParaElem]
    forall a. a -> [a] -> [a]
    : [ParaElem] -> [ParaElem]
    consolidateRuns [ParaElem]
    xs

    paraElemToElements :: PandocMonad m => ParaElem -> P m [Content]
    paraElemToElements :: forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Content]
    paraElemToElements ParaElem
    Break = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element -> Content
    Elem (Element -> Content) -> Element -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:br" [] ()]
    paraElemToElements (Run RunProps
    rpr Text
    s) = do
      sizeAttrs <- RunProps -> P m [(Text, Text)]
    forall (m :: * -> *). Monad m => RunProps -> P m [(Text, Text)]
    fontSizeAttributes RunProps
    rpr
      let attrs = [(Text, Text)]
    sizeAttrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [(Text
    "b", Text
    "1") | RunProps -> Bool
    rPropBold RunProps
    rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [(Text
    "i", Text
    "1") | RunProps -> Bool
    rPropItalics RunProps
    rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (
            [(Text
    "u", Text
    "sng") | RunProps -> Bool
    rPropUnderline RunProps
    rpr]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Strikethrough
    rStrikethrough RunProps
    rpr of
                Just Strikethrough
    NoStrike     -> [(Text
    "strike", Text
    "noStrike")]
                Just Strikethrough
    SingleStrike -> [(Text
    "strike", Text
    "sngStrike")]
                Just Strikethrough
    DoubleStrike -> [(Text
    "strike", Text
    "dblStrike")]
                Maybe Strikethrough
    Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Int
    rBaseline RunProps
    rpr of
                Just Int
    n -> [(Text
    "baseline", Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n)]
                Maybe Int
    Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            (case RunProps -> Maybe Capitals
    rCap RunProps
    rpr of
                Just Capitals
    NoCapitals -> [(Text
    "cap", Text
    "none")]
                Just Capitals
    SmallCapitals -> [(Text
    "cap", Text
    "small")]
                Just Capitals
    AllCapitals -> [(Text
    "cap", Text
    "all")]
                Maybe Capitals
    Nothing -> []) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
            []
      linkProps <- case rLink rpr of
                     Just LinkTarget
    link -> do
                       idNum <- LinkTarget -> P m Int
    forall (m :: * -> *). PandocMonad m => LinkTarget -> P m Int
    registerLink LinkTarget
    link
                       -- first we have to make sure that if it's an
                       -- anchor, it's in the anchor map. If not, there's
                       -- no link.
                       return $ case link of
                         InternalTarget SlideId
    _ ->
                           let linkAttrs :: [(Text, Text)]
    linkAttrs =
                                 [ (Text
    "r:id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    idNum)
                                 , (Text
    "action", Text
    "ppaction://hlinksldjump")
                                 ]
                           in [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:hlinkClick" [(Text, Text)]
    linkAttrs ()]
                         -- external
                         ExternalTarget (Text, Text)
    _ ->
                           let linkAttrs :: [(Text, Text)]
    linkAttrs =
                                 [ (Text
    "r:id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    idNum)
                                 ]
                           in [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:hlinkClick" [(Text, Text)]
    linkAttrs ()]
                     Maybe LinkTarget
    Nothing -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      let colorContents = case RunProps -> Maybe Color
    rSolidFill RunProps
    rpr of
                            Just Color
    color ->
                              case Color -> FilePath
    forall a. FromColor a => Color -> a
    fromColor Color
    color of
                                Char
    '#':FilePath
    hx ->
                                  [Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:solidFill" []
                                    [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:srgbClr"
                                      [(Text
    "val", Text -> Text
    T.toUpper (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Text
    T.pack FilePath
    hx)] ()]]
                                FilePath
    _ -> []
                            Maybe Color
    Nothing -> []
      codeFont <- monospaceFont
      let codeContents =
            [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:latin" [(Text
    "typeface", Text
    codeFont)] () | RunProps -> Bool
    rPropCode RunProps
    rpr]
      let propContents = [Element]
    linkProps [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    colorContents [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    codeContents
      return [Elem $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
                                     , mknode "a:t" [] s
                                     ]]
    paraElemToElements (MathElem MathType
    mathType TeXString
    texStr) = do
      isInSpkrNotes <- (WriterEnv -> Bool)
    -> ReaderT WriterEnv (StateT WriterState m) Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Bool
    envInSpeakerNotes
      if isInSpkrNotes
        then paraElemToElements $ Run def $ unTeXString texStr
        else do res <- convertMath writeOMML mathType (unTeXString texStr)
                case fromXLElement <$> res of
                  Right Element
    r -> [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Element -> Content
    Elem (Element -> Content) -> Element -> Content
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a14:m" [] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Element -> Element
    addMathInfo Element
    r]
                  Left (Str Text
    s) -> ParaElem -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall (m :: * -> *). PandocMonad m => ParaElem -> P m [Content]
    paraElemToElements (RunProps -> Text -> ParaElem
    Run RunProps
    forall a. Default a => a
    def Text
    s)
                  Left Inline
    _       -> PandocError -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) [Content])
    -> PandocError
    -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocShouldNeverHappenError Text
    "non-string math fallback"
    paraElemToElements (RawOOXMLParaElem Text
    str) = [Content] -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      [CData -> Content
    Text (CDataKind -> Text -> Maybe Integer -> CData
    CData CDataKind
    CDataRaw Text
    str Maybe Integer
    forall a. Maybe a
    Nothing)]

    -- This is a bit of a kludge -- really requires adding an option to
    -- TeXMath, but since that's a different package, we'll do this one
    -- step at a time.
    addMathInfo :: Element -> Element
    addMathInfo :: Element -> Element
    addMathInfo Element
    element =
      let mathspace :: Attr
    mathspace =
            Attr { attrKey :: QName
    attrKey = Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "m" Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "xmlns")
                 , attrVal :: Text
    attrVal = Text
    "http://schemas.openxmlformats.org/officeDocument/2006/math"
                 }
      in Attr -> Element -> Element
    add_attr Attr
    mathspace Element
    element

    -- We look through the element to see if it contains an a14:m
    -- element. If so, we surround it. This is a bit ugly, but it seems
    -- more dependable than looking through shapes for math. Plus this is
    -- an xml implementation detail, so it seems to make sense to do it at
    -- the xml level.
    surroundWithMathAlternate :: Element -> Element
    surroundWithMathAlternate :: Element -> Element
    surroundWithMathAlternate Element
    element =
      case QName -> Element -> Maybe Element
    findElement (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "m" Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "a14")) Element
    element of
        Just Element
    _ ->
          Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "mc:AlternateContent"
             [(Text
    "xmlns:mc", Text
    "http://schemas.openxmlformats.org/markup-compatibility/2006")
             ] [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "mc:Choice"
                 [ (Text
    "xmlns:a14", Text
    "http://schemas.microsoft.com/office/drawing/2010/main")
                 , (Text
    "Requires", Text
    "a14")] [ Element
    element ]
               ]
        Maybe Element
    Nothing -> Element
    element

    paragraphToElement :: PandocMonad m => Paragraph -> P m Element
    paragraphToElement :: forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement Paragraph
    par = do
      indents <- (WriterEnv -> Maybe Indents)
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Indents)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Maybe Indents
    envOtherStyleIndents
      let
        lvl = ParaProps -> Int
    pPropLevel (Paragraph -> ParaProps
    paraProps Paragraph
    par)
        attrs = [(Text
    "lvl", Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    lvl)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
                (case (ParaProps -> Maybe Integer
    pPropIndent (Paragraph -> ParaProps
    paraProps Paragraph
    par), ParaProps -> Maybe Integer
    pPropMarginLeft (Paragraph -> ParaProps
    paraProps Paragraph
    par)) of
                   (Just Integer
    px1, Just Integer
    px2) -> [ (Text
    "indent", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    pixelsToEmu Integer
    px1)
                                           , (Text
    "marL", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    pixelsToEmu Integer
    px2)
                                           ]
                   (Just Integer
    px1, Maybe Integer
    Nothing) -> [(Text
    "indent", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    pixelsToEmu Integer
    px1)]
                   (Maybe Integer
    Nothing, Just Integer
    px2) -> [(Text
    "marL", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    pixelsToEmu Integer
    px2)]
                   (Maybe Integer
    Nothing, Maybe Integer
    Nothing) -> [(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [(Text, Text)] -> [(Text, Text)])
    -> Maybe [(Text, Text)] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ do
                     indents' <- Maybe Indents
    indents
                     thisLevel <- levelIndent indents' lvl
                     nextLevel <- levelIndent indents' (lvl + 1)
                     let (m, i) =
                           case pPropBullet (paraProps par) of
                             Maybe BulletType
    Nothing ->
                               (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (LevelIndents -> Integer
    marL LevelIndents
    thisLevel), Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    0)
                             Just (AutoNumbering ListAttributes
    _) ->
                               ( Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (LevelIndents -> Integer
    marL LevelIndents
    nextLevel)
                               , Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (LevelIndents -> Integer
    marL LevelIndents
    thisLevel Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - LevelIndents -> Integer
    marL LevelIndents
    nextLevel)
                               )
                             Just BulletType
    Bullet -> (Maybe Integer
    forall a. Maybe a
    Nothing, Maybe Integer
    forall a. Maybe a
    Nothing)
                     pure ( toList ((,) "indent" . tshow <$> i)
                          <> toList ((,) "marL" . tshow <$> m)
                          )
                ) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Algnment
    pPropAlign (Paragraph -> ParaProps
    paraProps Paragraph
    par) of
                   Just Algnment
    AlgnLeft -> [(Text
    "algn", Text
    "l")]
                   Just Algnment
    AlgnRight -> [(Text
    "algn", Text
    "r")]
                   Just Algnment
    AlgnCenter -> [(Text
    "algn", Text
    "ctr")]
                   Maybe Algnment
    Nothing -> []
                )
        props = [] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe Integer
    pPropSpaceBefore (ParaProps -> Maybe Integer) -> ParaProps -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ Paragraph -> ParaProps
    paraProps Paragraph
    par of
                   Just Integer
    px -> [Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:spcBef" [] [
                                  Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:spcPts" [(Text
    "val", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    100 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    px)] ()
                                  ]
                              ]
                   Maybe Integer
    Nothing -> []
                ) [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
                (case ParaProps -> Maybe BulletType
    pPropBullet (ParaProps -> Maybe BulletType) -> ParaProps -> Maybe BulletType
    forall a b. (a -> b) -> a -> b
    $ Paragraph -> ParaProps
    paraProps Paragraph
    par of
                   Just BulletType
    Bullet -> []
                   Just (AutoNumbering ListAttributes
    attrs') ->
                     [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:buAutoNum" (ListAttributes -> [(Text, Text)]
    autoNumAttrs ListAttributes
    attrs') ()]
                   Maybe BulletType
    Nothing -> [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:buNone" [] ()]
                )
      paras <- mconcat <$> mapM paraElemToElements (consolidateRuns (paraElems par))
      return $ mknode "a:p" [] $ [Elem $ mknode "a:pPr" attrs props] <> paras

    shapeToElement :: PandocMonad m => Element -> Shape -> P m (Maybe ShapeId, Element)
    shapeToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m (Maybe Integer, Element)
    shapeToElement Element
    layout (TextBox [Paragraph]
    paras)
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (shapeId, sp) <- [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    [(Text, Text)] -> Element -> P m (Maybe Integer, Element)
    getContentShape [(Text, Text)]
    ns Element
    spTree
          elements <- mapM paragraphToElement paras
          let txBody = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                       [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
              emptySpPr = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:spPr" [] ()
          return
            . (shapeId,)
            . surroundWithMathAlternate
            . replaceNamedChildren ns "p" "txBody" [txBody]
            . replaceNamedChildren ns "p" "spPr" [emptySpPr]
            $ sp
    -- GraphicFrame and Pic should never reach this.
    shapeToElement Element
    _ Shape
    _ = (Maybe Integer, Element) -> P m (Maybe Integer, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Integer
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    shapeToElements :: PandocMonad m => Element -> Shape -> P m [(Maybe ShapeId, Content)]
    shapeToElements :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m [(Maybe Integer, Content)]
    shapeToElements Element
    layout (Pic PicProps
    picProps FilePath
    fp Text
    titleText [ParaElem]
    alt) = do
      mInfo <- FilePath -> [ParaElem] -> P m MediaInfo
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia FilePath
    fp [ParaElem]
    alt
      case mInfoExt mInfo of
        Just Text
    _ -> ((Integer, Element) -> (Maybe Integer, Content))
    -> [(Integer, Element)] -> [(Maybe Integer, Content)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Integer -> Maybe Integer)
    -> (Element -> Content)
    -> (Integer, Element)
    -> (Maybe Integer, Content)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Element -> Content
    Elem) ([(Integer, Element)] -> [(Maybe Integer, Content)])
    -> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
          Element
    -> PicProps
    -> MediaInfo
    -> Text
    -> [ParaElem]
    -> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
    forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> PicProps
    -> MediaInfo
    -> Text
    -> [ParaElem]
    -> P m [(Integer, Element)]
    makePicElements Element
    layout PicProps
    picProps MediaInfo
    mInfo Text
    titleText [ParaElem]
    alt
        Maybe Text
    Nothing -> Element
    -> Shape
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m [(Maybe Integer, Content)]
    shapeToElements Element
    layout (Shape
     -> ReaderT
          WriterEnv (StateT WriterState m) [(Maybe Integer, Content)])
    -> Shape
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall a b. (a -> b) -> a -> b
    $ [Paragraph] -> Shape
    TextBox [ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def [ParaElem]
    alt]
    shapeToElements Element
    layout (GraphicFrame [Graphic]
    tbls [ParaElem]
    cptn) = ((Integer, Element) -> (Maybe Integer, Content))
    -> [(Integer, Element)] -> [(Maybe Integer, Content)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Integer -> Maybe Integer)
    -> (Element -> Content)
    -> (Integer, Element)
    -> (Maybe Integer, Content)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Element -> Content
    Elem) ([(Integer, Element)] -> [(Maybe Integer, Content)])
    -> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      Element
    -> [Graphic]
    -> [ParaElem]
    -> ReaderT WriterEnv (StateT WriterState m) [(Integer, Element)]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Graphic] -> [ParaElem] -> P m [(Integer, Element)]
    graphicFrameToElements Element
    layout [Graphic]
    tbls [ParaElem]
    cptn
    shapeToElements Element
    _ (RawOOXMLShape Text
    str) = [(Maybe Integer, Content)]
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      [(Maybe Integer
    forall a. Maybe a
    Nothing, CData -> Content
    Text (CDataKind -> Text -> Maybe Integer -> CData
    CData CDataKind
    CDataRaw Text
    str Maybe Integer
    forall a. Maybe a
    Nothing))]
    shapeToElements Element
    layout shp :: Shape
    shp@(TextBox [Paragraph]
    _) = do
      (shapeId, element) <- Element -> Shape -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m (Maybe Integer, Element)
    shapeToElement Element
    layout Shape
    shp
      return [(shapeId, Elem element)]

    shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [(Maybe ShapeId, Content)]
    shapesToElements :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Shape] -> P m [(Maybe Integer, Content)]
    shapesToElements Element
    layout [Shape]
    shps =
     [[(Maybe Integer, Content)]] -> [(Maybe Integer, Content)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Maybe Integer, Content)]] -> [(Maybe Integer, Content)])
    -> ReaderT
         WriterEnv (StateT WriterState m) [[(Maybe Integer, Content)]]
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Shape
     -> ReaderT
          WriterEnv (StateT WriterState m) [(Maybe Integer, Content)])
    -> [Shape]
    -> ReaderT
         WriterEnv (StateT WriterState m) [[(Maybe Integer, Content)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Element
    -> Shape
    -> ReaderT
         WriterEnv (StateT WriterState m) [(Maybe Integer, Content)]
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> Shape -> P m [(Maybe Integer, Content)]
    shapeToElements Element
    layout) [Shape]
    shps

    graphicFrameToElements ::
      PandocMonad m =>
      Element ->
      [Graphic] ->
      [ParaElem] ->
      P m [(ShapeId, Element)]
    graphicFrameToElements :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> [Graphic] -> [ParaElem] -> P m [(Integer, Element)]
    graphicFrameToElements Element
    layout [Graphic]
    tbls [ParaElem]
    caption = do
      -- get the sizing
      master <- P m Element
    forall (m :: * -> *). PandocMonad m => P m Element
    getMaster
      (pageWidth, pageHeight) <- asks envPresentationSize
      let ns = Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      ((x, y), (cx, cytmp)) <- getContentShapeSize ns layout master
                               `catchError`
                               (\PandocError
    _ -> ((Integer, Integer), (Integer, Integer))
    -> P m ((Integer, Integer), (Integer, Integer))
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer
    0, Integer
    0), (Integer
    pageWidth, Integer
    pageHeight)))

      let cy = if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    caption then Integer
    cytmp Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    captionHeight else Integer
    cytmp

      elements <- mapM (graphicToElement cx) tbls
      let graphicFrameElts =
            ( Integer
    6
            , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:graphicFrame" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
              [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvGraphicFramePr" []
                [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvPr" [(Text
    "id", Text
    "6"), (Text
    "name", Text
    "Content Placeholder 5")] ()
                , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvGraphicFramePr" []
                  [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:graphicFrameLocks" [(Text
    "noGrp", Text
    "1")] ()]
                , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvPr" []
                  [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:ph" [(Text
    "idx", Text
    "1")] ()]
                ]
              , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:xfrm" []
                [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:off" [(Text
    "x", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    x),
                                  (Text
    "y", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    y)] ()
                , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:ext" [(Text
    "cx", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    cx),
                                  (Text
    "cy", Integer -> Text
    forall a. Show a => a -> Text
    tshow (Integer -> Text) -> Integer -> Text
    forall a b. (a -> b) -> a -> b
    $ Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    cy)] ()
                ]
              ] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
            )

      if not $ null caption
        then do capElt <- createCaption ((x, y), (cx, cytmp)) caption
                return [graphicFrameElts, capElt]
        else return [graphicFrameElts]

    getDefaultTableStyle :: PandocMonad m => P m (Maybe T.Text)
    getDefaultTableStyle :: forall (m :: * -> *). PandocMonad m => P m (Maybe Text)
    getDefaultTableStyle = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      tblStyleLst <- parseXml refArchive distArchive "ppt/tableStyles.xml"
      return $ findAttr (QName "def" Nothing Nothing) tblStyleLst

    graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
    graphicToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Integer -> Graphic -> P m Element
    graphicToElement Integer
    tableWidth (Tbl [Double]
    widths TableProps
    tblPr [[Paragraph]]
    hdrCells [[[Paragraph]]]
    rows) = do
      let totalWidth :: Double
    totalWidth = [Double] -> Double
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Double]
    widths
      let colWidths :: [Integer]
    colWidths = if Double
    0.0 Double -> [Double] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Double]
    widths
                      then if [[Paragraph]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Paragraph]]
    hdrCells
                          then case [[[Paragraph]]]
    rows of
                             r :: [[Paragraph]]
    r@([Paragraph]
    _:[[Paragraph]]
    _) : [[[Paragraph]]]
    _ -> Int -> Integer -> [Integer]
    forall a. Int -> a -> [a]
    replicate ([[Paragraph]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    r) (Integer -> [Integer]) -> Integer -> [Integer]
    forall a b. (a -> b) -> a -> b
    $
                                                     Integer
    tableWidth Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([[Paragraph]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    r)
                             []: [[[Paragraph]]]
    _ -> []
                             [] -> []
                          else Int -> Integer -> [Integer]
    forall a. Int -> a -> [a]
    replicate ([[Paragraph]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    hdrCells) (Integer -> [Integer]) -> Integer -> [Integer]
    forall a b. (a -> b) -> a -> b
    $
                               Integer
    tableWidth Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([[Paragraph]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Paragraph]]
    hdrCells)
                      else (Double -> Integer) -> [Double] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Double
    w -> Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Double
    w Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    totalWidth Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    tableWidth) [Double]
    widths

      let cellToOpenXML :: [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML [Paragraph]
    paras =
            do elements <- (Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [Paragraph]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement [Paragraph]
    paras
               let elements' = if [Element] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    elements
                               then [Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:p" [] [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:endParaRPr" [] ()]]
                               else [Element]
    elements

               return
                 [mknode "a:txBody" [] $
                   [ mknode "a:bodyPr" [] ()
                   , mknode "a:lstStyle" [] ()]
                   <> elements']
      headers' <- ([Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> [[Paragraph]]
    -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall {m :: * -> *}.
    PandocMonad m =>
    [Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    cellToOpenXML [[Paragraph]]
    hdrCells
      rows' <- mapM (mapM cellToOpenXML) rows
      let borderProps = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tcPr" [] ()
      let emptyCell' = [Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:p" [] [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:pPr" [] ()]]
      let mkcell Bool
    border [Element]
    contents = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tc" []
                                ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ (if [Element] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    contents
                                   then [Element]
    emptyCell'
                                   else [Element]
    contents) [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [ Element
    borderProps | Bool
    border ]
      let mkrow Bool
    border [[Element]]
    cells = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tr" [(Text
    "h", Text
    "0")] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ ([Element] -> Element) -> [[Element]] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> [Element] -> Element
    mkcell Bool
    border) [[Element]]
    cells

      let mkgridcol Integer
    w = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:gridCol"
                           [(Text
    "w", Integer -> Text
    forall a. Show a => a -> Text
    tshow ((Integer
    12700 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    w) :: Integer))] ()
      let hasHeader = Bool -> Bool
    not (([Paragraph] -> Bool) -> [[Paragraph]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Paragraph] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Paragraph]]
    hdrCells)

      mbDefTblStyle <- getDefaultTableStyle
      let tblPrElt = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tblPr"
                     [ (Text
    "firstRow", if TableProps -> Bool
    tblPrFirstRow TableProps
    tblPr then Text
    "1" else Text
    "0")
                     , (Text
    "bandRow", if TableProps -> Bool
    tblPrBandRow TableProps
    tblPr then Text
    "1" else Text
    "0")
                     ] (case Maybe Text
    mbDefTblStyle of
                          Maybe Text
    Nothing -> []
                          Just Text
    sty -> [Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:tableStyleId" [] Text
    sty])

      return $ mknode "a:graphic" []
        [mknode "a:graphicData" [("uri", "http://schemas.openxmlformats.org/drawingml/2006/table")]
         [mknode "a:tbl" [] $
          [ tblPrElt
          , mknode "a:tblGrid" [] (if all (==0) colWidths
                                   then []
                                   else map mkgridcol colWidths)
          ]
          <> [ mkrow True headers' | hasHeader ] <> map (mkrow False) rows'
         ]
        ]

    -- We get the shape by placeholder type. If there is NO type, it
    -- defaults to a content placeholder.

    data PHType = PHType T.Text | ObjType
      deriving (Int -> PHType -> FilePath -> FilePath
    [PHType] -> FilePath -> FilePath
    PHType -> FilePath
    (Int -> PHType -> FilePath -> FilePath)
    -> (PHType -> FilePath)
    -> ([PHType] -> FilePath -> FilePath)
    -> Show PHType
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> PHType -> FilePath -> FilePath
    showsPrec :: Int -> PHType -> FilePath -> FilePath
    $cshow :: PHType -> FilePath
    show :: PHType -> FilePath
    $cshowList :: [PHType] -> FilePath -> FilePath
    showList :: [PHType] -> FilePath -> FilePath
    Show, PHType -> PHType -> Bool
    (PHType -> PHType -> Bool)
    -> (PHType -> PHType -> Bool) -> Eq PHType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PHType -> PHType -> Bool
    == :: PHType -> PHType -> Bool
    $c/= :: PHType -> PHType -> Bool
    /= :: PHType -> PHType -> Bool
    Eq)

    findPHType :: NameSpaces -> Element -> PHType -> Bool
    findPHType :: [(Text, Text)] -> Element -> PHType -> Bool
    findPHType [(Text, Text)]
    ns Element
    spElem PHType
    phType
      | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "sp" Element
    spElem =
        let mbPHElem :: Maybe Element
    mbPHElem = (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    spElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvSpPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvPr") Maybe Element -> (Element -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "ph"))
        in
          case Maybe Element
    mbPHElem of
            -- if it's a named PHType, we want to check that the attribute
            -- value matches.
            Just Element
    phElem | (PHType Text
    tp) <- PHType
    phType ->
                            case QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    phElem of
                              Just Text
    tp' -> Text
    tp Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    tp'
                              Maybe Text
    Nothing -> Bool
    False
            -- if it's an ObjType, we want to check that there is NO
            -- "type" attribute. In other words, a lookup should return nothing.
            Just Element
    phElem | PHType
    ObjType <- PHType
    phType ->
                            case QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "type" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    phElem of
                              Just Text
    _ -> Bool
    False
                              Maybe Text
    Nothing -> Bool
    True
            Maybe Element
    Nothing -> Bool
    False
    findPHType [(Text, Text)]
    _ Element
    _ PHType
    _ = Bool
    False

    getShapesByPlaceHolderType :: NameSpaces -> Element -> PHType -> [Element]
    getShapesByPlaceHolderType :: [(Text, Text)] -> Element -> PHType -> [Element]
    getShapesByPlaceHolderType [(Text, Text)]
    ns Element
    spTreeElem PHType
    phType
      | [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [(Text, Text)]
    ns Text
    "p" Text
    "spTree" Element
    spTreeElem =
          (Element -> Bool) -> Element -> [Element]
    filterChildren (\Element
    e -> [(Text, Text)] -> Element -> PHType -> Bool
    findPHType [(Text, Text)]
    ns Element
    e PHType
    phType) Element
    spTreeElem
      | Bool
    otherwise = []

    getShapeByPlaceHolderType :: NameSpaces -> Element -> PHType -> Maybe Element
    getShapeByPlaceHolderType :: [(Text, Text)] -> Element -> PHType -> Maybe Element
    getShapeByPlaceHolderType [(Text, Text)]
    ns Element
    spTreeElem PHType
    phType =
      [Element] -> Maybe Element
    forall a. [a] -> Maybe a
    listToMaybe ([Element] -> Maybe Element) -> [Element] -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ [(Text, Text)] -> Element -> PHType -> [Element]
    getShapesByPlaceHolderType [(Text, Text)]
    ns Element
    spTreeElem PHType
    phType

    -- Like the above, but it tries a number of different placeholder types
    getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [PHType] -> Maybe Element
    getShapeByPlaceHolderTypes :: [(Text, Text)] -> Element -> [PHType] -> Maybe Element
    getShapeByPlaceHolderTypes [(Text, Text)]
    _ Element
    _ [] = Maybe Element
    forall a. Maybe a
    Nothing
    getShapeByPlaceHolderTypes [(Text, Text)]
    ns Element
    spTreeElem (PHType
    s:[PHType]
    ss) =
      case [(Text, Text)] -> Element -> PHType -> Maybe Element
    getShapeByPlaceHolderType [(Text, Text)]
    ns Element
    spTreeElem PHType
    s of
        Just Element
    element -> Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    element
        Maybe Element
    Nothing -> [(Text, Text)] -> Element -> [PHType] -> Maybe Element
    getShapeByPlaceHolderTypes [(Text, Text)]
    ns Element
    spTreeElem [PHType]
    ss

    nonBodyTextToElement ::
      PandocMonad m =>
      Element ->
      [PHType] ->
      [ParaElem] ->
      P m (Maybe ShapeId, Element)
    nonBodyTextToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [PHType]
    phTypes [ParaElem]
    paraElements
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld
      , Just Element
    sp <- [(Text, Text)] -> Element -> [PHType] -> Maybe Element
    getShapeByPlaceHolderTypes [(Text, Text)]
    ns Element
    spTree [PHType]
    phTypes
      , Just Element
    nvSpPr <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "nvSpPr") Element
    sp
      , Just Element
    cNvPr <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cNvPr") Element
    nvSpPr
      , Just Text
    shapeId <- QName -> Element -> Maybe Text
    findAttr (Text -> QName
    nodename Text
    "id") Element
    cNvPr
      , Right (Integer
    shapeIdNum, Text
    _) <- Text -> Either FilePath (Integer, Text)
    forall a. Integral a => Reader a
    decimal Text
    shapeId = do
          let hdrPara :: Paragraph
    hdrPara = ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def [ParaElem]
    paraElements
          element <- Paragraph -> P m Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement Paragraph
    hdrPara
          let txBody = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                       [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
                       [Element
    element]
          return (Just shapeIdNum,
                  surroundWithMathAlternate $
                    replaceNamedChildren ns "p" "txBody" [txBody] sp)
      -- XXX: TODO
      | Bool
    otherwise = (Maybe Integer, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe Integer, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Integer
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    data ContentShapeIds = ContentShapeIds
      { ContentShapeIds -> Maybe Integer
    contentHeaderId :: Maybe ShapeId
      , ContentShapeIds -> [Integer]
    contentContentIds :: [ShapeId]
      }

    contentToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      [Shape] ->
      P m (Maybe ContentShapeIds, Element)
    contentToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem] -> [Shape] -> P m (Maybe ContentShapeIds, Element)
    contentToElement Element
    layout [ParaElem]
    hdrShape [Shape]
    shapes
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "title"] [ParaElem]
    hdrShape
          let hdrShapeElements = [Element -> Content
    Elem Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
              contentHeaderId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    shapeId
          content' <- local
                             (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 0})
                             (shapesToElements layout shapes)
          let contentContentIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    content'
              contentElements = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    content'
          footer <- footerElements content
          return ( Just ContentShapeIds{..}
                 , buildSpTree ns spTree (hdrShapeElements <> contentElements <> footer)
                 )
    contentToElement Element
    _ [ParaElem]
    _ [Shape]
    _ = (Maybe ContentShapeIds, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe ContentShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ContentShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    data TwoColumnShapeIds = TwoColumnShapeIds
      { TwoColumnShapeIds -> Maybe Integer
    twoColumnHeaderId :: Maybe ShapeId
      , TwoColumnShapeIds -> [Integer]
    twoColumnLeftIds :: [ShapeId]
      , TwoColumnShapeIds -> [Integer]
    twoColumnRightIds :: [ShapeId]
      }

    twoColumnToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      [Shape] ->
      [Shape] ->
      P m (Maybe TwoColumnShapeIds, Element)
    twoColumnToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem]
    -> [Shape]
    -> [Shape]
    -> P m (Maybe TwoColumnShapeIds, Element)
    twoColumnToElement Element
    layout [ParaElem]
    hdrShape [Shape]
    shapesL [Shape]
    shapesR
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (headerId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "title"] [ParaElem]
    hdrShape
          let hdrShapeElements = [Element -> Content
    Elem Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
              twoColumnHeaderId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    headerId
          contentL <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 0})
                            (shapesToElements layout shapesL)
          let twoColumnLeftIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    contentL
              contentElementsL = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentL
          contentR <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 1})
                            (shapesToElements layout shapesR)
          let (twoColumnRightIds) = (mapMaybe fst contentR)
              contentElementsR = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentR
          -- let contentElementsL' = map (setIdx ns "1") contentElementsL
          --     contentElementsR' = map (setIdx ns "2") contentElementsR
          footer <- footerElements twoColumn
          return
            $ (Just TwoColumnShapeIds{..}, )
            $ buildSpTree ns spTree
            $ hdrShapeElements <> contentElementsL <> contentElementsR <> footer
    twoColumnToElement Element
    _ [ParaElem]
    _ [Shape]
    _ [Shape]
    _ = (Maybe TwoColumnShapeIds, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe TwoColumnShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe TwoColumnShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    data ComparisonShapeIds = ComparisonShapeIds
      { ComparisonShapeIds -> Maybe Integer
    comparisonHeaderId :: Maybe ShapeId
      , ComparisonShapeIds -> [Integer]
    comparisonLeftTextIds :: [ShapeId]
      , ComparisonShapeIds -> [Integer]
    comparisonLeftContentIds :: [ShapeId]
      , ComparisonShapeIds -> [Integer]
    comparisonRightTextIds :: [ShapeId]
      , ComparisonShapeIds -> [Integer]
    comparisonRightContentIds :: [ShapeId]
      }

    comparisonToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      ([Shape], [Shape]) ->
      ([Shape], [Shape]) ->
      P m (Maybe ComparisonShapeIds, Element)
    comparisonToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem]
    -> ([Shape], [Shape])
    -> ([Shape], [Shape])
    -> P m (Maybe ComparisonShapeIds, Element)
    comparisonToElement Element
    layout [ParaElem]
    hdrShape ([Shape]
    shapesL1, [Shape]
    shapesL2) ([Shape]
    shapesR1, [Shape]
    shapesR2)
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (headerShapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "title"] [ParaElem]
    hdrShape
          let hdrShapeElements = [Element -> Content
    Elem Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
              comparisonHeaderId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    headerShapeId
          contentL1 <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder (PHType "body") 0})
                             (shapesToElements layout shapesL1)
          let comparisonLeftTextIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    contentL1
              contentElementsL1 = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentL1
          contentL2 <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 0})
                             (shapesToElements layout shapesL2)
          let comparisonLeftContentIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    contentL2
              contentElementsL2 = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentL2
          contentR1 <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder (PHType "body") 1})
                             (shapesToElements layout shapesR1)
          let comparisonRightTextIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    contentR1
              contentElementsR1 = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentR1
          contentR2 <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 1})
                             (shapesToElements layout shapesR2)
          let comparisonRightContentIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    contentR2
              contentElementsR2 = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    contentR2
          footer <- footerElements comparison
          return
            $ (Just ComparisonShapeIds{..}, )
            $ buildSpTree ns spTree
            $ mconcat [ hdrShapeElements
                      , contentElementsL1
                      , contentElementsL2
                      , contentElementsR1
                      , contentElementsR2
                      ] <> footer
    comparisonToElement Element
    _ [ParaElem]
    _ ([Shape], [Shape])
    _ ([Shape], [Shape])
    _= (Maybe ComparisonShapeIds, Element)
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         (Maybe ComparisonShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ComparisonShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    data ContentWithCaptionShapeIds = ContentWithCaptionShapeIds
      { ContentWithCaptionShapeIds -> Maybe Integer
    contentWithCaptionHeaderId :: Maybe ShapeId
      , ContentWithCaptionShapeIds -> [Integer]
    contentWithCaptionCaptionIds :: [ShapeId]
      , ContentWithCaptionShapeIds -> [Integer]
    contentWithCaptionContentIds :: [ShapeId]
      }

    contentWithCaptionToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      [Shape] ->
      [Shape] ->
      P m (Maybe ContentWithCaptionShapeIds, Element)
    contentWithCaptionToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem]
    -> [Shape]
    -> [Shape]
    -> P m (Maybe ContentWithCaptionShapeIds, Element)
    contentWithCaptionToElement Element
    layout [ParaElem]
    hdrShape [Shape]
    textShapes [Shape]
    contentShapes
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "title"] [ParaElem]
    hdrShape
          let hdrShapeElements = [Element -> Content
    Elem Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape)]
              contentWithCaptionHeaderId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrShape then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    shapeId
          text <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder (PHType "body") 0})
                        (shapesToElements layout textShapes)
          let contentWithCaptionCaptionIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    text
              textElements = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    text
          content <- local (\WriterEnv
    env -> WriterEnv
    env {envPlaceholder = Placeholder ObjType 0})
                           (shapesToElements layout contentShapes)
          let contentWithCaptionContentIds = ((Maybe Integer, Content) -> Maybe Integer)
    -> [(Maybe Integer, Content)] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe Integer, Content) -> Maybe Integer
    forall a b. (a, b) -> a
    fst [(Maybe Integer, Content)]
    content
              contentElements = (Maybe Integer, Content) -> Content
    forall a b. (a, b) -> b
    snd ((Maybe Integer, Content) -> Content)
    -> [(Maybe Integer, Content)] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Maybe Integer, Content)]
    content
          footer <- footerElements contentWithCaption
          return
            $ (Just ContentWithCaptionShapeIds{..}, )
            $ buildSpTree ns spTree
            $ mconcat [ hdrShapeElements
                      , textElements
                      , contentElements
                      ] <> footer
    contentWithCaptionToElement Element
    _ [ParaElem]
    _ [Shape]
    _ [Shape]
    _ = (Maybe ContentWithCaptionShapeIds, Element)
    -> ReaderT
         WriterEnv
         (StateT WriterState m)
         (Maybe ContentWithCaptionShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ContentWithCaptionShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    blankToElement ::
      PandocMonad m =>
      Element ->
      P m Element
    blankToElement :: forall (m :: * -> *). PandocMonad m => Element -> P m Element
    blankToElement Element
    layout
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld =
          [(Text, Text)] -> Element -> [Content] -> Element
    buildSpTree [(Text, Text)]
    ns Element
    spTree ([Content] -> Element)
    -> ReaderT WriterEnv (StateT WriterState m) [Content]
    -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (forall a. SlideLayoutsOf a -> a)
    -> ReaderT WriterEnv (StateT WriterState m) [Content]
    forall (m :: * -> *).
    PandocMonad m =>
    (forall a. SlideLayoutsOf a -> a) -> P m [Content]
    footerElements SlideLayoutsOf a -> a
    forall a. SlideLayoutsOf a -> a
    blank
    blankToElement Element
    _ = Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ()

    newtype TitleShapeIds = TitleShapeIds
      { TitleShapeIds -> Maybe Integer
    titleHeaderId :: Maybe ShapeId
      }

    titleToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      P m (Maybe TitleShapeIds, Element)
    titleToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element -> [ParaElem] -> P m (Maybe TitleShapeIds, Element)
    titleToElement Element
    layout [ParaElem]
    titleElems
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          (shapeId, element) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "title", Text -> PHType
    PHType Text
    "ctrTitle"] [ParaElem]
    titleElems
          let titleShapeElements = [Element -> Content
    Elem Element
    element | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems)]
              titleHeaderId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    shapeId
          footer <- footerElements title
          return
            $ (Just TitleShapeIds{..}, )
            $ buildSpTree ns spTree (titleShapeElements <> footer)
    titleToElement Element
    _ [ParaElem]
    _ = (Maybe TitleShapeIds, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe TitleShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe TitleShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    data MetadataShapeIds = MetadataShapeIds
      { MetadataShapeIds -> Maybe Integer
    metadataTitleId :: Maybe ShapeId
      , MetadataShapeIds -> Maybe Integer
    metadataSubtitleId :: Maybe ShapeId
      , MetadataShapeIds -> Maybe Integer
    metadataDateId :: Maybe ShapeId
      }

    metadataToElement ::
      PandocMonad m =>
      Element ->
      [ParaElem] ->
      [ParaElem] ->
      [[ParaElem]] ->
      [ParaElem] ->
      P m (Maybe MetadataShapeIds, Element)
    metadataToElement :: forall (m :: * -> *).
    PandocMonad m =>
    Element
    -> [ParaElem]
    -> [ParaElem]
    -> [[ParaElem]]
    -> [ParaElem]
    -> P m (Maybe MetadataShapeIds, Element)
    metadataToElement Element
    layout [ParaElem]
    titleElems [ParaElem]
    subtitleElems [[ParaElem]]
    authorsElems [ParaElem]
    dateElems
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    layout
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    layout
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld = do
          let combinedAuthorElems :: [ParaElem]
    combinedAuthorElems = [ParaElem] -> [[ParaElem]] -> [ParaElem]
    forall a. [a] -> [[a]] -> [a]
    intercalate [ParaElem
    Break] [[ParaElem]]
    authorsElems
              subtitleAndAuthorElems :: [ParaElem]
    subtitleAndAuthorElems = [ParaElem] -> [[ParaElem]] -> [ParaElem]
    forall a. [a] -> [[a]] -> [a]
    intercalate [ParaElem
    Break, ParaElem
    Break] ([[ParaElem]] -> [ParaElem]) -> [[ParaElem]] -> [ParaElem]
    forall a b. (a -> b) -> a -> b
    $
                                        ([ParaElem] -> Bool) -> [[ParaElem]] -> [[ParaElem]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([ParaElem] -> Bool) -> [ParaElem] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null)
                                         [[ParaElem]
    subtitleElems, [ParaElem]
    combinedAuthorElems]
          (titleId, titleElement) <- Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    forall (m :: * -> *).
    PandocMonad m =>
    Element -> [PHType] -> [ParaElem] -> P m (Maybe Integer, Element)
    nonBodyTextToElement Element
    layout [Text -> PHType
    PHType Text
    "ctrTitle"] [ParaElem]
    titleElems
          (subtitleId, subtitleElement) <- nonBodyTextToElement layout [PHType "subTitle"] subtitleAndAuthorElems
          (dateId, dateElement) <- nonBodyTextToElement layout [PHType "dt"] dateElems
          let titleShapeElements = [Element
    titleElement | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems)]
              metadataTitleId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    titleElems then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    titleId
              subtitleShapeElements = [Element
    subtitleElement | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    subtitleAndAuthorElems)]
              metadataSubtitleId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    subtitleAndAuthorElems then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    subtitleId
          footerInfo <- gets stFooterInfo
          footer <- (if maybe False fiShowOnFirstSlide footerInfo
                     then id
                     else const []) <$> footerElements metadata
          let dateShapeElements = [Element
    dateElement
                                  | Bool -> Bool
    not ([ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    dateElems
                                    Bool -> Bool -> Bool
    || Maybe Element -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe FooterInfo
    footerInfo Maybe FooterInfo -> (FooterInfo -> Maybe Element) -> Maybe Element
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= SlideLayoutsOf (Maybe Element) -> Maybe Element
    forall a. SlideLayoutsOf a -> a
    metadata (SlideLayoutsOf (Maybe Element) -> Maybe Element)
    -> (FooterInfo -> SlideLayoutsOf (Maybe Element))
    -> FooterInfo
    -> Maybe Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FooterInfo -> SlideLayoutsOf (Maybe Element)
    fiDate))
                                  ]
              metadataDateId = if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    dateElems then Maybe Integer
    forall a. Maybe a
    Nothing else Maybe Integer
    dateId
          return
            $ (Just MetadataShapeIds{..}, )
            $ buildSpTree ns spTree
            $ map Elem (titleShapeElements <> subtitleShapeElements <> dateShapeElements)
            <> footer
    metadataToElement Element
    _ [ParaElem]
    _ [ParaElem]
    _ [[ParaElem]]
    _ [ParaElem]
    _ = (Maybe MetadataShapeIds, Element)
    -> ReaderT
         WriterEnv (StateT WriterState m) (Maybe MetadataShapeIds, Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe MetadataShapeIds
    forall a. Maybe a
    Nothing, Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" [] ())

    slideToElement :: PandocMonad m => Slide -> P m Element
    slideToElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m Element
    slideToElement (Slide SlideId
    _ l :: Layout
    l@(ContentSlide [ParaElem]
    hdrElems [Shape]
    shapes) SpeakerNotes
    _ Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (shapeIds, spTree)
         <- local (\WriterEnv
    env -> if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrElems
                           then WriterEnv
    env
                           else WriterEnv
    env{envSlideHasHeader=True})
                  (contentToElement layout hdrElems shapes)
      let animations = case Maybe ContentShapeIds
    shapeIds of
            Maybe ContentShapeIds
    Nothing -> []
            Just ContentShapeIds{[Integer]
    Maybe Integer
    contentHeaderId :: ContentShapeIds -> Maybe Integer
    contentContentIds :: ContentShapeIds -> [Integer]
    contentHeaderId :: Maybe Integer
    contentContentIds :: [Integer]
    ..} ->
              [(Integer, Shape)] -> [Element]
    slideToIncrementalAnimations ([Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    contentContentIds [Shape]
    shapes)
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
    slideToElement (Slide SlideId
    _ l :: Layout
    l@(TwoColumnSlide [ParaElem]
    hdrElems [Shape]
    shapesL [Shape]
    shapesR) SpeakerNotes
    _ Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (shapeIds, spTree) <- local (\WriterEnv
    env -> if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrElems
                               then WriterEnv
    env
                               else WriterEnv
    env{envSlideHasHeader=True}) $
                twoColumnToElement layout hdrElems shapesL shapesR
      let animations = case Maybe TwoColumnShapeIds
    shapeIds of
            Maybe TwoColumnShapeIds
    Nothing -> []
            Just TwoColumnShapeIds{[Integer]
    Maybe Integer
    twoColumnHeaderId :: TwoColumnShapeIds -> Maybe Integer
    twoColumnLeftIds :: TwoColumnShapeIds -> [Integer]
    twoColumnRightIds :: TwoColumnShapeIds -> [Integer]
    twoColumnHeaderId :: Maybe Integer
    twoColumnLeftIds :: [Integer]
    twoColumnRightIds :: [Integer]
    ..} ->
              [(Integer, Shape)] -> [Element]
    slideToIncrementalAnimations ([Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    twoColumnLeftIds [Shape]
    shapesL
                                            [(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
    forall a. Semigroup a => a -> a -> a
    <> [Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    twoColumnRightIds [Shape]
    shapesR)
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
    slideToElement (Slide SlideId
    _ l :: Layout
    l@(ComparisonSlide [ParaElem]
    hdrElems ([Shape], [Shape])
    shapesL ([Shape], [Shape])
    shapesR) SpeakerNotes
    _ Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (shapeIds, spTree) <- local (\WriterEnv
    env -> if [ParaElem] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ParaElem]
    hdrElems
                               then WriterEnv
    env
                               else WriterEnv
    env{envSlideHasHeader=True}) $
                comparisonToElement layout hdrElems shapesL shapesR
      let animations = case Maybe ComparisonShapeIds
    shapeIds of
            Maybe ComparisonShapeIds
    Nothing -> []
            Just ComparisonShapeIds{[Integer]
    Maybe Integer
    comparisonHeaderId :: ComparisonShapeIds -> Maybe Integer
    comparisonLeftTextIds :: ComparisonShapeIds -> [Integer]
    comparisonLeftContentIds :: ComparisonShapeIds -> [Integer]
    comparisonRightTextIds :: ComparisonShapeIds -> [Integer]
    comparisonRightContentIds :: ComparisonShapeIds -> [Integer]
    comparisonHeaderId :: Maybe Integer
    comparisonLeftTextIds :: [Integer]
    comparisonLeftContentIds :: [Integer]
    comparisonRightTextIds :: [Integer]
    comparisonRightContentIds :: [Integer]
    ..} ->
              [(Integer, Shape)] -> [Element]
    slideToIncrementalAnimations
                ([Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    comparisonLeftTextIds (([Shape], [Shape]) -> [Shape]
    forall a b. (a, b) -> a
    fst ([Shape], [Shape])
    shapesL)
                [(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
    forall a. Semigroup a => a -> a -> a
    <> [Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    comparisonLeftContentIds (([Shape], [Shape]) -> [Shape]
    forall a b. (a, b) -> b
    snd ([Shape], [Shape])
    shapesL)
                [(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
    forall a. Semigroup a => a -> a -> a
    <> [Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    comparisonRightTextIds (([Shape], [Shape]) -> [Shape]
    forall a b. (a, b) -> a
    fst ([Shape], [Shape])
    shapesR)
                [(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
    forall a. Semigroup a => a -> a -> a
    <> [Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    comparisonRightContentIds (([Shape], [Shape]) -> [Shape]
    forall a b. (a, b) -> b
    snd ([Shape], [Shape])
    shapesR))
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
    slideToElement (Slide SlideId
    _ l :: Layout
    l@(TitleSlide [ParaElem]
    hdrElems) SpeakerNotes
    _ Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (_, spTree) <- titleToElement layout hdrElems
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
    slideToElement (Slide
                    SlideId
    _
                    l :: Layout
    l@(MetadataSlide [ParaElem]
    titleElems [ParaElem]
    subtitleElems [[ParaElem]]
    authorElems [ParaElem]
    dateElems)
                    SpeakerNotes
    _
                    Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (_, spTree) <- metadataToElement layout titleElems subtitleElems authorElems dateElems
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]
    slideToElement (Slide
                    SlideId
    _
                    l :: Layout
    l@(ContentWithCaptionSlide [ParaElem]
    hdrElems [Shape]
    captionShapes [Shape]
    contentShapes)
                    SpeakerNotes
    _
                    Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    l
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      (shapeIds, spTree) <- contentWithCaptionToElement layout hdrElems captionShapes contentShapes
      let animations = case Maybe ContentWithCaptionShapeIds
    shapeIds of
            Maybe ContentWithCaptionShapeIds
    Nothing -> []
            Just ContentWithCaptionShapeIds{[Integer]
    Maybe Integer
    contentWithCaptionHeaderId :: ContentWithCaptionShapeIds -> Maybe Integer
    contentWithCaptionCaptionIds :: ContentWithCaptionShapeIds -> [Integer]
    contentWithCaptionContentIds :: ContentWithCaptionShapeIds -> [Integer]
    contentWithCaptionHeaderId :: Maybe Integer
    contentWithCaptionCaptionIds :: [Integer]
    contentWithCaptionContentIds :: [Integer]
    ..} ->
              [(Integer, Shape)] -> [Element]
    slideToIncrementalAnimations
                ([Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    contentWithCaptionCaptionIds [Shape]
    captionShapes
                 [(Integer, Shape)] -> [(Integer, Shape)] -> [(Integer, Shape)]
    forall a. Semigroup a => a -> a -> a
    <> [Integer] -> [Shape] -> [(Integer, Shape)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    contentWithCaptionContentIds [Shape]
    contentShapes)
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] (mknode "p:cSld" [] (toList backgroundImageElement <> [spTree]) : animations)
    slideToElement (Slide SlideId
    _ Layout
    BlankSlide SpeakerNotes
    _ Maybe FilePath
    backgroundImage) = do
      layout <- Layout -> P m Element
    forall (m :: * -> *). PandocMonad m => Layout -> P m Element
    getLayout Layout
    BlankSlide
      backgroundImageElement <- traverse backgroundImageToElement backgroundImage
      spTree <- blankToElement layout
      return $ mknode "p:sld"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main"),
          ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships"),
          ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] [mknode "p:cSld" [] (toList backgroundImageElement <> [spTree])]

    backgroundImageToElement :: PandocMonad m => FilePath -> P m Element
    backgroundImageToElement :: forall (m :: * -> *). PandocMonad m => FilePath -> P m Element
    backgroundImageToElement FilePath
    path = do
      MediaInfo{mInfoLocalId, mInfoFilePath} <- FilePath -> [ParaElem] -> P m MediaInfo
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> [ParaElem] -> P m MediaInfo
    registerMedia FilePath
    path []
      (imgBytes, _) <- P.fetchItem (T.pack mInfoFilePath)
      opts <- asks envOpts
      let imageDimensions = (Text -> Maybe (Integer, Integer))
    -> (ImageSize -> Maybe (Integer, Integer))
    -> Either Text ImageSize
    -> Maybe (Integer, Integer)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe (Integer, Integer) -> Text -> Maybe (Integer, Integer)
    forall a b. a -> b -> a
    const Maybe (Integer, Integer)
    forall a. Maybe a
    Nothing)
                                   ((Integer, Integer) -> Maybe (Integer, Integer)
    forall a. a -> Maybe a
    Just ((Integer, Integer) -> Maybe (Integer, Integer))
    -> (ImageSize -> (Integer, Integer))
    -> ImageSize
    -> Maybe (Integer, Integer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImageSize -> (Integer, Integer)
    sizeInPixels)
                                   (WriterOptions -> StrictByteString -> Either Text ImageSize
    imageSize WriterOptions
    opts StrictByteString
    imgBytes)
      pageSize <- asks envPresentationSize
      let fillRectAttributes = [(Text, Text)]
    -> ((Integer, Integer) -> [(Text, Text)])
    -> Maybe (Integer, Integer)
    -> [(Text, Text)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ((Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
    offsetAttributes (Integer, Integer)
    pageSize) Maybe (Integer, Integer)
    imageDimensions
      let rId = Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Text
    T.pack (Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    mInfoLocalId)
      return
        $ mknode "p:bg" []
        $ mknode "p:bgPr" []
        [ mknode "a:blipFill" [("dpi", "0"), ("rotWithShape", "1")]
          [ mknode "a:blip" [("r:embed", rId)]
            $ mknode "a:lum" [] ()
          , mknode "a:srcRect" [] ()
          , mknode "a:stretch" []
            $ mknode "a:fillRect" fillRectAttributes ()
          ]
        , mknode "a:effectsLst" [] ()
        ]
      where
        offsetAttributes :: (Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
        offsetAttributes :: (Integer, Integer) -> (Integer, Integer) -> [(Text, Text)]
    offsetAttributes (Integer
    pageWidth, Integer
    pageHeight) (Integer
    pictureWidth, Integer
    pictureHeight) = let
          widthRatio :: Rational
    widthRatio = Integer
    pictureWidth Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    pageWidth
          heightRatio :: Rational
    heightRatio = Integer
    pictureHeight Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    pageHeight
          getOffset :: Ratio Integer -> Text
          getOffset :: Rational -> Text
    getOffset Rational
    proportion = let
              percentageOffset :: Rational
    percentageOffset = (Rational
    proportion Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    1) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * (-Integer
    100 Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    2)
              integerOffset :: Integer
    integerOffset = Rational -> Integer
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Rational
    percentageOffset Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    1000 :: Integer
            in FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    integerOffset)
          in case Rational -> Rational -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Rational
    widthRatio Rational
    heightRatio of
            Ordering
    EQ -> []
            Ordering
    LT -> let
              offset :: Text
    offset = Rational -> Text
    getOffset ((Integer
    pictureHeight Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    pageHeight) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    widthRatio)
              in [ (Text
    "t", Text
    offset)
                 , (Text
    "b", Text
    offset)
                 ]
            Ordering
    GT -> let
              offset :: Text
    offset = Rational -> Text
    getOffset ((Integer
    pictureWidth Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    pageWidth) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    heightRatio)
              in [ (Text
    "l", Text
    offset)
                 , (Text
    "r", Text
    offset)
                 ]

    slideToIncrementalAnimations ::
      [(ShapeId, Shape)] ->
      [Element]
    slideToIncrementalAnimations :: [(Integer, Shape)] -> [Element]
    slideToIncrementalAnimations [(Integer, Shape)]
    shapes = let
      incrementals :: [(ShapeId, [Bool])]
      incrementals :: [(Integer, [Bool])]
    incrementals = do
        (shapeId, TextBox ps) <- [(Integer, Shape)]
    shapes
        pure . (shapeId,) $ do
          Paragraph ParaProps{pPropIncremental} _ <- ps
          pure pPropIncremental
      toIndices :: [Bool] -> Maybe (NonEmpty (Integer, Integer))
      toIndices :: [Bool] -> Maybe (NonEmpty (Integer, Integer))
    toIndices [Bool]
    bs = do
            let indexed :: [(Integer, Bool)]
    indexed = [Integer] -> [Bool] -> [(Integer, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer
    0..] [Bool]
    bs
            ts <- [(Integer, Bool)] -> Maybe (NonEmpty (Integer, Bool))
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty (((Integer, Bool) -> Bool) -> [(Integer, Bool)] -> [(Integer, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Integer, Bool) -> Bool
    forall a b. (a, b) -> b
    snd [(Integer, Bool)]
    indexed)
            pure (fmap (\(Integer
    n, Bool
    _) -> (Integer
    n, Integer
    n)) ts)
      indices :: [(ShapeId, NonEmpty (Integer, Integer))]
      indices :: [(Integer, NonEmpty (Integer, Integer))]
    indices = do
        (shapeId, bs) <- [(Integer, [Bool])]
    incrementals
        toList ((,) shapeId <$> toIndices bs)
      in Maybe Element -> [Element]
    forall a. Maybe a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element
    incrementalAnimation (NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element)
    -> Maybe (NonEmpty (Integer, NonEmpty (Integer, Integer)))
    -> Maybe Element
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Integer, NonEmpty (Integer, Integer))]
    -> Maybe (NonEmpty (Integer, NonEmpty (Integer, Integer)))
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty [(Integer, NonEmpty (Integer, Integer))]
    indices)

    --------------------------------------------------------------------
    -- Notes:

    getNotesMaster :: PandocMonad m => P m Element
    getNotesMaster :: forall (m :: * -> *). PandocMonad m => P m Element
    getNotesMaster = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      parseXml refArchive distArchive "ppt/notesMasters/notesMaster1.xml"

    getSlideNumberFieldId :: PandocMonad m => Element -> P m T.Text
    getSlideNumberFieldId :: forall (m :: * -> *). PandocMonad m => Element -> P m Text
    getSlideNumberFieldId Element
    notesMaster
      | [(Text, Text)]
    ns <- Element -> [(Text, Text)]
    elemToNameSpaces Element
    notesMaster
      , Just Element
    cSld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "cSld") Element
    notesMaster
      , Just Element
    spTree <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "spTree") Element
    cSld
      , Just Element
    sp <- [(Text, Text)] -> Element -> PHType -> Maybe Element
    getShapeByPlaceHolderType [(Text, Text)]
    ns Element
    spTree (Text -> PHType
    PHType Text
    "sldNum")
      , Just Element
    txBody <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "p" Text
    "txBody") Element
    sp
      , Just Element
    p <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "a" Text
    "p") Element
    txBody
      , Just Element
    fld <- QName -> Element -> Maybe Element
    findChild ([(Text, Text)] -> Text -> Text -> QName
    elemName [(Text, Text)]
    ns Text
    "a" Text
    "fld") Element
    p
      , Just Text
    fldId <- QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    fld =
          Text -> ReaderT WriterEnv (StateT WriterState m) Text
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    fldId
      | Bool
    otherwise = PandocError -> ReaderT WriterEnv (StateT WriterState m) Text
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Text)
    -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Text
    forall a b. (a -> b) -> a -> b
    $
                    Text -> PandocError
    PandocSomeError
                    Text
    "No field id for slide numbers in notesMaster.xml"

    speakerNotesSlideImage :: Element
    speakerNotesSlideImage :: Element
    speakerNotesSlideImage =
      Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" []
      [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvSpPr" []
        [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvPr" [ (Text
    "id", Text
    "2")
                           , (Text
    "name", Text
    "Slide Image Placeholder 1")
                           ] ()
        , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvSpPr" []
          [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:spLocks" [ (Text
    "noGrp", Text
    "1")
                               , (Text
    "noRot", Text
    "1")
                               , (Text
    "noChangeAspect", Text
    "1")
                               ] ()
          ]
        , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvPr" []
          [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:ph" [(Text
    "type", Text
    "sldImg")] ()]
        ]
      , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:spPr" [] ()
      ]

    -- we want to wipe links from the speaker notes in the
    -- paragraphs. Powerpoint doesn't allow you to input them, and it
    -- would provide extra complications.
    removeParaLinks :: Paragraph -> Paragraph
    removeParaLinks :: Paragraph -> Paragraph
    removeParaLinks Paragraph
    paragraph = Paragraph
    paragraph{paraElems = map f (paraElems paragraph)}
      where f :: ParaElem -> ParaElem
    f (Run RunProps
    rProps Text
    s) = RunProps -> Text -> ParaElem
    Run RunProps
    rProps{rLink=Nothing} Text
    s
            f ParaElem
    pe             = ParaElem
    pe

    -- put an empty paragraph between paragraphs for more expected spacing.
    spaceParas :: [Paragraph] -> [Paragraph]
    spaceParas :: [Paragraph] -> [Paragraph]
    spaceParas = Paragraph -> [Paragraph] -> [Paragraph]
    forall a. a -> [a] -> [a]
    intersperse (ParaProps -> [ParaElem] -> Paragraph
    Paragraph ParaProps
    forall a. Default a => a
    def [])

    speakerNotesBody :: PandocMonad m => [Paragraph] -> P m Element
    speakerNotesBody :: forall (m :: * -> *). PandocMonad m => [Paragraph] -> P m Element
    speakerNotesBody [Paragraph]
    paras = do
      elements <- (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a.
    (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\WriterEnv
    env -> WriterEnv
    env{envInSpeakerNotes = True}) (ReaderT WriterEnv (StateT WriterState m) [Element]
     -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b. (a -> b) -> a -> b
    $
                  (Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [Paragraph]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Paragraph -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *). PandocMonad m => Paragraph -> P m Element
    paragraphToElement ([Paragraph] -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> [Paragraph]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b. (a -> b) -> a -> b
    $ [Paragraph] -> [Paragraph]
    spaceParas ([Paragraph] -> [Paragraph]) -> [Paragraph] -> [Paragraph]
    forall a b. (a -> b) -> a -> b
    $ (Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
    forall a b. (a -> b) -> [a] -> [b]
    map Paragraph -> Paragraph
    removeParaLinks [Paragraph]
    paras
      let txBody = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txBody" [] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
                   [Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:bodyPr" [] (), Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:lstStyle" [] ()] [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <> [Element]
    elements
      return $
        surroundWithMathAlternate $
        mknode "p:sp" []
        [ mknode "p:nvSpPr" []
          [ mknode "p:cNvPr" [ ("id", "3")
                             , ("name", "Notes Placeholder 2")
                             ] ()
          , mknode "p:cNvSpPr" []
            [ mknode "a:spLocks" [("noGrp", "1")] ()]
          , mknode "p:nvPr" []
            [ mknode "p:ph" [("type", "body"), ("idx", "1")] ()]
          ]
        , mknode "p:spPr" [] ()
        , txBody
        ]

    speakerNotesSlideNumber :: Int -> T.Text -> Element
    speakerNotesSlideNumber :: Int -> Text -> Element
    speakerNotesSlideNumber Int
    pgNum Text
    fieldId =
      Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sp" []
      [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvSpPr" []
        [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvPr" [ (Text
    "id", Text
    "4")
                           , (Text
    "name", Text
    "Slide Number Placeholder 3")
                           ] ()
        , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cNvSpPr" []
          [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:spLocks" [(Text
    "noGrp", Text
    "1")] ()]
        , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nvPr" []
          [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:ph" [ (Text
    "type", Text
    "sldNum")
                          , (Text
    "sz", Text
    "quarter")
                          , (Text
    "idx", Text
    "10")
                          ] ()
          ]
        ]
      , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:spPr" [] ()
      , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txBody" []
        [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:bodyPr" [] ()
        , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:lstStyle" [] ()
        , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:p" []
          [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:fld" [ (Text
    "id", Text
    fieldId)
                           , (Text
    "type", Text
    "slidenum")
                           ]
            [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:rPr" [(Text
    "lang", Text
    "en-US")] ()
            , Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:t" [] (Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    pgNum)
            ]
          , Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "a:endParaRPr" [(Text
    "lang", Text
    "en-US")] ()
          ]
        ]
      ]

    slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesElement (Slide SlideId
    _ Layout
    _ (SpeakerNotes []) Maybe FilePath
    _) = Maybe Element
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Element
    forall a. Maybe a
    Nothing
    slideToSpeakerNotesElement slide :: Slide
    slide@(Slide SlideId
    _ Layout
    _ (SpeakerNotes [Paragraph]
    paras) Maybe FilePath
    _) = do
      master <- P m Element
    forall (m :: * -> *). PandocMonad m => P m Element
    getNotesMaster
      fieldId  <- getSlideNumberFieldId master
      num <- slideNum slide
      let imgShape = Element
    speakerNotesSlideImage
          sldNumShape = Int -> Text -> Element
    speakerNotesSlideNumber Int
    num Text
    fieldId
      bodyShape <- speakerNotesBody paras
      return $ Just $
        mknode "p:notes"
        [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
        , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
        , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
        ] [ mknode "p:cSld" []
            [ mknode "p:spTree" []
              [ mknode "p:nvGrpSpPr" []
                [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
                , mknode "p:cNvGrpSpPr" [] ()
                , mknode "p:nvPr" [] ()
                ]
              , mknode "p:grpSpPr" []
                [ mknode "a:xfrm" []
                  [ mknode "a:off" [("x", "0"), ("y", "0")] ()
                  , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
                  , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
                  , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
                  ]
                ]
              , imgShape
              , bodyShape
              , sldNumShape
              ]
            ]
          ]

    -----------------------------------------------------------------------

    getSlideIdNum :: PandocMonad m => SlideId -> P m Int
    getSlideIdNum :: forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
    getSlideIdNum SlideId
    sldId = do
      slideIdMap <- (WriterEnv -> Map SlideId Int)
    -> ReaderT WriterEnv (StateT WriterState m) (Map SlideId Int)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Map SlideId Int
    envSlideIdMap
      case  M.lookup sldId slideIdMap of
        Just Int
    n -> Int -> ReaderT WriterEnv (StateT WriterState m) Int
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n
        Maybe Int
    Nothing -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Int
    forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> ReaderT WriterEnv (StateT WriterState m) Int)
    -> PandocError -> ReaderT WriterEnv (StateT WriterState m) Int
    forall a b. (a -> b) -> a -> b
    $
                   Text -> PandocError
    PandocShouldNeverHappenError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $
                   Text
    "Slide Id " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> SlideId -> Text
    forall a. Show a => a -> Text
    tshow SlideId
    sldId Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " not found."

    slideNum :: PandocMonad m => Slide -> P m Int
    slideNum :: forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide = SlideId -> P m Int
    forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
    getSlideIdNum (SlideId -> P m Int) -> SlideId -> P m Int
    forall a b. (a -> b) -> a -> b
    $ Slide -> SlideId
    slideId Slide
    slide

    idNumToFilePath :: Int -> FilePath
    idNumToFilePath :: Int -> FilePath
    idNumToFilePath Int
    idNum = FilePath
    "slide" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    idNum FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ".xml"

    slideToFilePath :: PandocMonad m => Slide -> P m FilePath
    slideToFilePath :: forall (m :: * -> *). PandocMonad m => Slide -> P m FilePath
    slideToFilePath Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      return $ "slide" <> show idNum <> ".xml"

    slideToRelId ::
      PandocMonad m =>
      MinimumRId ->
      Slide ->
      P m T.Text
    slideToRelId :: forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Text
    slideToRelId Int
    minSlideRId Slide
    slide = do
      n <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      return $ "rId" <> tshow (n + minSlideRId - 1)

    data Relationship = Relationship { Relationship -> Int
    relId :: Int
                                     , Relationship -> Text
    relType :: MimeType
                                     , Relationship -> FilePath
    relTarget :: FilePath
                                     } deriving (Int -> Relationship -> FilePath -> FilePath
    [Relationship] -> FilePath -> FilePath
    Relationship -> FilePath
    (Int -> Relationship -> FilePath -> FilePath)
    -> (Relationship -> FilePath)
    -> ([Relationship] -> FilePath -> FilePath)
    -> Show Relationship
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Relationship -> FilePath -> FilePath
    showsPrec :: Int -> Relationship -> FilePath -> FilePath
    $cshow :: Relationship -> FilePath
    show :: Relationship -> FilePath
    $cshowList :: [Relationship] -> FilePath -> FilePath
    showList :: [Relationship] -> FilePath -> FilePath
    Show, Relationship -> Relationship -> Bool
    (Relationship -> Relationship -> Bool)
    -> (Relationship -> Relationship -> Bool) -> Eq Relationship
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Relationship -> Relationship -> Bool
    == :: Relationship -> Relationship -> Bool
    $c/= :: Relationship -> Relationship -> Bool
    /= :: Relationship -> Relationship -> Bool
    Eq)

    elementToRel :: Element -> Maybe Relationship
    elementToRel :: Element -> Maybe Relationship
    elementToRel Element
    element
      | Element -> QName
    elName Element
    element QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Relationship" (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://schemas.openxmlformats.org/package/2006/relationships") Maybe Text
    forall a. Maybe a
    Nothing =
          do rId <- QName -> Element -> Maybe Text
    findAttr (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Id" Maybe Text
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing) Element
    element
             numStr <- T.stripPrefix "rId" rId
             num <- fromIntegral <$> readTextAsInteger numStr
             type' <- findAttr (QName "Type" Nothing Nothing) element
             target <- findAttr (QName "Target" Nothing Nothing) element
             return $ Relationship num type' (T.unpack target)
      | Bool
    otherwise = Maybe Relationship
    forall a. Maybe a
    Nothing

    slideToPresRel :: PandocMonad m => Int -> Slide -> P m Relationship
    slideToPresRel :: forall (m :: * -> *).
    PandocMonad m =>
    Int -> Slide -> P m Relationship
    slideToPresRel Int
    minimumSlideRId Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      let rId = Int
    idNum Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    minimumSlideRId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
          fp = FilePath
    "slides/" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    idNumToFilePath Int
    idNum
      return $ Relationship { relId = rId
                            , relType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide"
                            , relTarget = fp
                            }

    getPresentationRels :: PandocMonad m => P m [Relationship]
    getPresentationRels :: forall (m :: * -> *). PandocMonad m => P m [Relationship]
    getPresentationRels = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      relsElem <- parseXml refArchive distArchive "ppt/_rels/presentation.xml.rels"
      let globalNS = Text
    "http://schemas.openxmlformats.org/package/2006/relationships"
      let relElems = QName -> Element -> [Element]
    findChildren (Text -> Maybe Text -> Maybe Text -> QName
    QName Text
    "Relationship" (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    globalNS) Maybe Text
    forall a. Maybe a
    Nothing) Element
    relsElem
      return $ mapMaybe elementToRel relElems

    -- | Info required to update a presentation rId from the reference doc for the
    -- output.
    type PresentationRIdUpdateData = (ReferenceMinRIdAfterSlides, NewRIdBounds)

    -- | The minimum and maximum rIds for presentation relationships created from
    -- the presentation content (as opposed to from the reference doc).
    --
    -- Relationships taken from the reference doc should have their rId number
    -- adjusted to make sure it sits outside this range.
    type NewRIdBounds = (MinimumRId, MaximumRId)

    -- | The minimum presentation rId from the reference doc which comes after the
    -- first slide rId (in the reference doc).
    type ReferenceMinRIdAfterSlides = Int
    type MinimumRId = Int
    type MaximumRId = Int

    -- | Given a presentation rId from the reference doc, return the value it should
    -- have in the output.
    updatePresentationRId :: PresentationRIdUpdateData -> Int -> Int
    updatePresentationRId :: PresentationRIdUpdateData -> Int -> Int
    updatePresentationRId (Int
    minOverlappingRId, (Int
    minNewId, Int
    maxNewId)) Int
    n
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    minNewId = Int
    n
      | Bool
    otherwise = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    minOverlappingRId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    maxNewId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    presentationToRels ::
      PandocMonad m =>
      Presentation ->
      P m (PresentationRIdUpdateData, [Relationship])
    presentationToRels :: forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m (PresentationRIdUpdateData, [Relationship])
    presentationToRels pres :: Presentation
    pres@(Presentation DocProps
    _ [Slide]
    slides) = do
      rels <- P m [Relationship]
    forall (m :: * -> *). PandocMonad m => P m [Relationship]
    getPresentationRels

      -- We want to make room for the slides in the id space. We'll assume the slide
      -- masters come first (this seems to be what PowerPoint does by default, and
      -- is true of the reference doc), and we'll put the slides next. So we find
      -- the starting rId for the slides by finding the maximum rId for the masters
      -- and adding 1.
      --
      -- Then:
      -- 1. We look to see what the minimum rId which is greater than or equal to
      --    the minimum slide rId is, in the rels we're keeping from the reference
      --    doc (i.e. the minimum rId which might overlap with the slides).
      -- 2. We increase this minimum overlapping rId to 1 higher than the last slide
      --    rId (or the notesMaster rel, if we're including one), and increase all
      --    rIds higher than this minimum by the same amount.

      let masterRels = (Relationship -> Bool) -> [Relationship] -> [Relationship]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Text -> Text -> Bool
    T.isSuffixOf Text
    "slideMaster" (Text -> Bool) -> (Relationship -> Text) -> Relationship -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Relationship -> Text
    relType) [Relationship]
    rels
          slideStartId = Int
    -> (NonEmpty Relationship -> Int)
    -> Maybe (NonEmpty Relationship)
    -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    1 ((Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int -> Int)
    -> (NonEmpty Relationship -> Int) -> NonEmpty Relationship -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (NonEmpty Int -> Int)
    -> (NonEmpty Relationship -> NonEmpty Int)
    -> NonEmpty Relationship
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Relationship -> Int) -> NonEmpty Relationship -> NonEmpty Int
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Relationship -> Int
    relId) ([Relationship] -> Maybe (NonEmpty Relationship)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty [Relationship]
    masterRels)
          -- we remove the slide rels and the notesmaster (if it's
          -- there). We'll put these back in ourselves, if necessary.
          relsWeKeep = (Relationship -> Bool) -> [Relationship] -> [Relationship]
    forall a. (a -> Bool) -> [a] -> [a]
    filter
                       (\Relationship
    r -> Relationship -> Text
    relType Relationship
    r Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide" Bool -> Bool -> Bool
    &&
                              Relationship -> Text
    relType Relationship
    r Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
                       [Relationship]
    rels
          minOverlappingRel = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum
                                     ([Int] -> Maybe (NonEmpty Int)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ((Int -> Bool) -> [Int] -> [Int]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Int
    slideStartId Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <=)
                                                       (Relationship -> Int
    relId (Relationship -> Int) -> [Relationship] -> [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Relationship]
    relsWeKeep)))

      mySlideRels <- mapM (slideToPresRel slideStartId) slides

      let notesMasterRels =
            [Relationship { relId :: Int
    relId = Int
    slideStartId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Relationship] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Relationship]
    mySlideRels
                             , relType :: Text
    relType = Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster"
                             , relTarget :: FilePath
    relTarget = FilePath
    "notesMasters/notesMaster1.xml"
                             } | Presentation -> Bool
    presHasSpeakerNotes Presentation
    pres]
          insertedRels = [Relationship]
    mySlideRels [Relationship] -> [Relationship] -> [Relationship]
    forall a. Semigroup a => a -> a -> a
    <> [Relationship]
    notesMasterRels
          newRIdBounds = (Int
    slideStartId, Int
    slideStartId Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Relationship] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Relationship]
    insertedRels Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
          updateRId = PresentationRIdUpdateData -> Int -> Int
    updatePresentationRId (Int
    minOverlappingRel, (Int, Int)
    newRIdBounds)

          relsWeKeep' = (Relationship -> Relationship) -> [Relationship] -> [Relationship]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Relationship
    r -> Relationship
    r{relId = updateRId $ relId r}) [Relationship]
    relsWeKeep

      return ((minOverlappingRel, newRIdBounds), insertedRels <> relsWeKeep')

    -- We make this ourselves, in case there's a thumbnail in the one from
    -- the template.
    topLevelRels :: [Relationship]
    topLevelRels :: [Relationship]
    topLevelRels =
      [ Relationship { relId :: Int
    relId = Int
    1
                     , relType :: Text
    relType = Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"
                     , relTarget :: FilePath
    relTarget = FilePath
    "ppt/presentation.xml"
                     }
      , Relationship { relId :: Int
    relId = Int
    2
                     , relType :: Text
    relType = Text
    "http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"
                     , relTarget :: FilePath
    relTarget = FilePath
    "docProps/core.xml"
                     }
      , Relationship { relId :: Int
    relId = Int
    3
                     , relType :: Text
    relType = Text
    "http://schemas.openxmlformats.org/package/2006/relationships/metadata/extended-properties"
                     , relTarget :: FilePath
    relTarget = FilePath
    "docProps/app.xml"
                     }
      , Relationship { relId :: Int
    relId = Int
    4
                     , relType :: Text
    relType = Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/custom-properties"
                     , relTarget :: FilePath
    relTarget = FilePath
    "docProps/custom.xml"
                     }
      ]

    topLevelRelsEntry :: PandocMonad m => P m Entry
    topLevelRelsEntry :: forall (m :: * -> *). PandocMonad m => P m Entry
    topLevelRelsEntry = FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "_rels/.rels" (Element -> P m Entry) -> Element -> P m Entry
    forall a b. (a -> b) -> a -> b
    $ [Relationship] -> Element
    relsToElement [Relationship]
    topLevelRels

    relToElement :: Relationship -> Element
    relToElement :: Relationship -> Element
    relToElement Relationship
    rel = Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship" [ (Text
    "Id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow (Relationship -> Int
    relId Relationship
    rel))
                                             , (Text
    "Type", Relationship -> Text
    relType Relationship
    rel)
                                             , (Text
    "Target", FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ Relationship -> FilePath
    relTarget Relationship
    rel) ] ()

    relsToElement :: [Relationship] -> Element
    relsToElement :: [Relationship] -> Element
    relsToElement [Relationship]
    rels = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationships"
                         [(Text
    "xmlns", Text
    "http://schemas.openxmlformats.org/package/2006/relationships")]
                         ((Relationship -> Element) -> [Relationship] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map Relationship -> Element
    relToElement [Relationship]
    rels)

    presentationToRelsEntry ::
      PandocMonad m =>
      Presentation ->
      P m (PresentationRIdUpdateData, Entry)
    presentationToRelsEntry :: forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m (PresentationRIdUpdateData, Entry)
    presentationToRelsEntry Presentation
    pres = do
      (presentationRIdUpdateData, rels) <- Presentation -> P m (PresentationRIdUpdateData, [Relationship])
    forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m (PresentationRIdUpdateData, [Relationship])
    presentationToRels Presentation
    pres
      element <- elemToEntry "ppt/_rels/presentation.xml.rels" $ relsToElement rels
      pure (presentationRIdUpdateData, element)

    elemToEntry :: PandocMonad m => FilePath -> Element -> P m Entry
    elemToEntry :: forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    fp Element
    element = do
      epochtime <- POSIXTime -> Integer
    forall b. Integral b => POSIXTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (POSIXTime -> Integer)
    -> (UTCTime -> POSIXTime) -> UTCTime -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> POSIXTime
    utcTimeToPOSIXSeconds (UTCTime -> Integer)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    -> ReaderT WriterEnv (StateT WriterState m) Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterEnv -> UTCTime)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> UTCTime
    envUTCTime
      return $ toEntry fp epochtime $ renderXml element

    slideToEntry :: PandocMonad m => Slide -> P m Entry
    slideToEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
    slideToEntry Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      local (\WriterEnv
    env -> WriterEnv
    env{envCurSlideId = idNum}) $ do
        element <- slideToElement slide
        elemToEntry ("ppt/slides/" <> idNumToFilePath idNum) element

    slideToSpeakerNotesEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesEntry Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      local (\WriterEnv
    env -> WriterEnv
    env{envCurSlideId = idNum}) $ do
        mbElement <- slideToSpeakerNotesElement slide
        mbNotesIdNum <- do mp <- asks envSpeakerNotesIdMap
                           return $ M.lookup idNum mp
        case mbElement of
          Just Element
    element | Just Int
    notesIdNum <- Maybe Int
    mbNotesIdNum ->
                           Entry -> Maybe Entry
    forall a. a -> Maybe a
    Just (Entry -> Maybe Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                           FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry
                           (FilePath
    "ppt/notesSlides/notesSlide" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    notesIdNum FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <>
                            FilePath
    ".xml")
                           Element
    element
          Maybe Element
    _ -> Maybe Entry
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Entry
    forall a. Maybe a
    Nothing

    slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    slideToSpeakerNotesRelElement (Slide SlideId
    _ Layout
    _ (SpeakerNotes []) Maybe FilePath
    _) = Maybe Element
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Element
    forall a. Maybe a
    Nothing
    slideToSpeakerNotesRelElement slide :: Slide
    slide@Slide{} = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      return $ Just $
        mknode "Relationships"
        [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
        [ mknode "Relationship" [ ("Id", "rId2")
                                , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
                                , ("Target", "../slides/slide" <> tshow idNum <> ".xml")
                                ] ()
        , mknode "Relationship" [ ("Id", "rId1")
                                , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
                                , ("Target", "../notesMasters/notesMaster1.xml")
                                ] ()
        ]

    slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesRelEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Entry)
    slideToSpeakerNotesRelEntry Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      mbElement <- slideToSpeakerNotesRelElement slide
      mp <- asks envSpeakerNotesIdMap
      let mbNotesIdNum = Int -> Map Int Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    idNum Map Int Int
    mp
      case mbElement of
        Just Element
    element | Just Int
    notesIdNum <- Maybe Int
    mbNotesIdNum ->
          Entry -> Maybe Entry
    forall a. a -> Maybe a
    Just (Entry -> Maybe Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
          FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry
          (FilePath
    "ppt/notesSlides/_rels/notesSlide" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    notesIdNum FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ".xml.rels")
          Element
    element
        Maybe Element
    _ -> Maybe Entry
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Entry)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Entry
    forall a. Maybe a
    Nothing

    slideToSlideRelEntry :: PandocMonad m => Slide -> P m Entry
    slideToSlideRelEntry :: forall (m :: * -> *). PandocMonad m => Slide -> P m Entry
    slideToSlideRelEntry Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      element <- slideToSlideRelElement slide
      elemToEntry ("ppt/slides/_rels/" <> idNumToFilePath idNum <> ".rels") element

    linkRelElement :: PandocMonad m => (Int, LinkTarget) -> P m Element
    linkRelElement :: forall (m :: * -> *).
    PandocMonad m =>
    (Int, LinkTarget) -> P m Element
    linkRelElement (Int
    rIdNum, InternalTarget SlideId
    targetId) = do
      targetIdNum <- SlideId -> P m Int
    forall (m :: * -> *). PandocMonad m => SlideId -> P m Int
    getSlideIdNum SlideId
    targetId
      return $
        mknode "Relationship" [ ("Id", "rId" <> tshow rIdNum)
                              , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
                              , ("Target", "slide" <> tshow targetIdNum <> ".xml")
                              ] ()
    linkRelElement (Int
    rIdNum, ExternalTarget (Text
    url, Text
    _)) =
      Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a b. (a -> b) -> a -> b
    $
        Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship" [ (Text
    "Id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    rIdNum)
                              , (Text
    "Type", Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")
                              , (Text
    "Target", Text
    url)
                              , (Text
    "TargetMode", Text
    "External")
                              ] ()

    linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element]
    linkRelElements :: forall (m :: * -> *).
    PandocMonad m =>
    Map Int LinkTarget -> P m [Element]
    linkRelElements Map Int LinkTarget
    mp = ((Int, LinkTarget)
     -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [(Int, LinkTarget)]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Int, LinkTarget)
    -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *).
    PandocMonad m =>
    (Int, LinkTarget) -> P m Element
    linkRelElement (Map Int LinkTarget -> [(Int, LinkTarget)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Int LinkTarget
    mp)

    mediaRelElement :: MediaInfo -> Element
    mediaRelElement :: MediaInfo -> Element
    mediaRelElement MediaInfo
    mInfo =
      let ext :: Text
    ext = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (MediaInfo -> Maybe Text
    mInfoExt MediaInfo
    mInfo)
      in
        Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship" [ (Text
    "Id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
          Int -> Text
    forall a. Show a => a -> Text
    tshow (MediaInfo -> Int
    mInfoLocalId MediaInfo
    mInfo))
                              , (Text
    "Type", Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image")
                              , (Text
    "Target", Text
    "../media/image" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
          Int -> Text
    forall a. Show a => a -> Text
    tshow (MediaInfo -> Int
    mInfoGlobalId MediaInfo
    mInfo) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ext)
                              ] ()

    speakerNotesSlideRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
    speakerNotesSlideRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m (Maybe Element)
    speakerNotesSlideRelElement Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      mp <- asks envSpeakerNotesIdMap
      return $ case M.lookup idNum mp of
        Maybe Int
    Nothing -> Maybe Element
    forall a. Maybe a
    Nothing
        Just Int
    n ->
          let target :: Text
    target = Text
    "../notesSlides/notesSlide" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".xml"
          in Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $
             Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Relationship" [ (Text
    "Id", Text
    "rId2")
                                   , (Text
    "Type", Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesSlide")
                                   , (Text
    "Target", Text
    target)
                                   ] ()

    slideToSlideRelElement :: PandocMonad m => Slide -> P m Element
    slideToSlideRelElement :: forall (m :: * -> *). PandocMonad m => Slide -> P m Element
    slideToSlideRelElement Slide
    slide = do
      idNum <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      target <- flip fmap getSlideLayouts $
        T.pack . ("../slideLayouts/" <>) . takeFileName .
        slPath . case slide of
            (Slide SlideId
    _ MetadataSlide{} SpeakerNotes
    _ Maybe FilePath
    _)           -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    metadata
            (Slide SlideId
    _ TitleSlide{} SpeakerNotes
    _ Maybe FilePath
    _)              -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    title
            (Slide SlideId
    _ ContentSlide{} SpeakerNotes
    _ Maybe FilePath
    _)            -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    content
            (Slide SlideId
    _ TwoColumnSlide{} SpeakerNotes
    _ Maybe FilePath
    _)          -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    twoColumn
            (Slide SlideId
    _ ComparisonSlide{} SpeakerNotes
    _ Maybe FilePath
    _)         -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    comparison
            (Slide SlideId
    _ ContentWithCaptionSlide{} SpeakerNotes
    _ Maybe FilePath
    _) -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    contentWithCaption
            (Slide SlideId
    _ Layout
    BlankSlide SpeakerNotes
    _ Maybe FilePath
    _)                -> SlideLayouts -> SlideLayout
    forall a. SlideLayoutsOf a -> a
    blank

      speakerNotesRels <- maybeToList <$> speakerNotesSlideRelElement slide

      linkIds <- gets stLinkIds
      mediaIds <- gets stMediaIds

      linkRels <- case M.lookup idNum linkIds of
                    Just Map Int LinkTarget
    mp -> Map Int LinkTarget
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (m :: * -> *).
    PandocMonad m =>
    Map Int LinkTarget -> P m [Element]
    linkRelElements Map Int LinkTarget
    mp
                    Maybe (Map Int LinkTarget)
    Nothing -> [Element] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      let mediaRels = case Int -> Map Int [MediaInfo] -> Maybe [MediaInfo]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Int
    idNum Map Int [MediaInfo]
    mediaIds of
                       Just [MediaInfo]
    mInfos -> (MediaInfo -> Element) -> [MediaInfo] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map MediaInfo -> Element
    mediaRelElement [MediaInfo]
    mInfos
                       Maybe [MediaInfo]
    Nothing -> []

      return $
        mknode "Relationships"
        [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
        ([mknode "Relationship" [ ("Id", "rId1")
                               , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slideLayout")
                               , ("Target", target)] ()
        ] <> speakerNotesRels <> linkRels <> mediaRels)

    slideToSldIdElement ::
      PandocMonad m =>
      MinimumRId ->
      Slide ->
      P m Element
    slideToSldIdElement :: forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Element
    slideToSldIdElement Int
    minimumSlideRId Slide
    slide = do
      n <- Slide -> P m Int
    forall (m :: * -> *). PandocMonad m => Slide -> P m Int
    slideNum Slide
    slide
      let id' = Int -> Text
    forall a. Show a => a -> Text
    tshow (Int -> Text) -> Int -> Text
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    255
      rId <- slideToRelId minimumSlideRId slide
      return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()

    presentationToSldIdLst ::
      PandocMonad m =>
      MinimumRId ->
      Presentation ->
      P m Element
    presentationToSldIdLst :: forall (m :: * -> *).
    PandocMonad m =>
    Int -> Presentation -> P m Element
    presentationToSldIdLst Int
    minimumSlideRId (Presentation DocProps
    _ [Slide]
    slides) = do
      ids <- (Slide -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> [Slide] -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Int -> Slide -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *). PandocMonad m => Int -> Slide -> P m Element
    slideToSldIdElement Int
    minimumSlideRId) [Slide]
    slides
      return $ mkNodeSldIdLst ids

    mkNodeSldIdLst :: [Element] -> Element
    mkNodeSldIdLst :: [Element] -> Element
    mkNodeSldIdLst = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sldIdLst" []

    presentationToPresentationElement ::
      PandocMonad m =>
      PresentationRIdUpdateData ->
      Presentation ->
      P m Element
    presentationToPresentationElement :: forall (m :: * -> *).
    PandocMonad m =>
    PresentationRIdUpdateData -> Presentation -> P m Element
    presentationToPresentationElement PresentationRIdUpdateData
    presentationUpdateRIdData Presentation
    pres = do
      let (Int
    _, (Int
    minSlideRId, Int
    maxSlideRId)) = PresentationRIdUpdateData
    presentationUpdateRIdData
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      element <- parseXml refArchive distArchive "ppt/presentation.xml"
      sldIdLst <- presentationToSldIdLst minSlideRId pres

      let modifySldIdLst :: Content -> Content
          modifySldIdLst Content
    ct = if Content -> Bool
    isSldIdLst Content
    ct
                              then Element -> Content
    Elem Element
    sldIdLst
                              else Content
    ct

          notesMasterRId = Int
    maxSlideRId

          notesMasterElem =  Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:notesMasterIdLst" []
                             [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode
                               Text
    "p:notesMasterId"
                               [(Text
    "r:id", Text
    "rId" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    notesMasterRId)]
                               ()
                             ]

          -- if there's a notesMasterIdLst in the presentation.xml file,
          -- we want to remove it. We then want to put our own, if
          -- necessary, after the slideMasterIdLst element. We also remove
          -- handouts master, since we don't want it.

          removeUnwantedMaster' :: Content -> [Content]
          removeUnwantedMaster' (Elem Element
    e) = case Element -> QName
    elName Element
    e of
            (QName Text
    "notesMasterIdLst" Maybe Text
    _ Maybe Text
    _) -> []
            (QName Text
    "handoutMasterIdLst" Maybe Text
    _ Maybe Text
    _) -> []
            QName
    _                              -> [Element -> Content
    Elem Element
    e]
          removeUnwantedMaster' Content
    ct = [Content
    ct]

          removeUnwantedMaster :: [Content] -> [Content]
          removeUnwantedMaster = (Content -> [Content]) -> [Content] -> [Content]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Content -> [Content]
    removeUnwantedMaster'

          insertNotesMaster :: [Content] -> [Content]
          insertNotesMaster = if Presentation -> Bool
    presHasSpeakerNotes Presentation
    pres
                              then Element -> [Content] -> [Content]
    insertAfterSldMasterIdLst Element
    notesMasterElem
                              else [Content] -> [Content]
    forall a. a -> a
    id

          updateRIds :: Content -> Content
          updateRIds (Elem Element
    el) =
            Element -> Content
    Elem (Element
    el { elAttribs = fmap updateRIdAttribute (elAttribs el)
                     , elContent = fmap updateRIds (elContent el)
                     })
          updateRIds Content
    content = Content
    content

          updateRIdAttribute :: XML.Attr -> XML.Attr
          updateRIdAttribute Attr
    attr = Attr -> Maybe Attr -> Attr
    forall a. a -> Maybe a -> a
    fromMaybe Attr
    attr (Maybe Attr -> Attr) -> Maybe Attr -> Attr
    forall a b. (a -> b) -> a -> b
    $ do
            oldValue <- case Attr -> QName
    attrKey Attr
    attr of
              QName Text
    "id" Maybe Text
    _ (Just Text
    "r") ->
                Text -> Text -> Maybe Text
    T.stripPrefix Text
    "rId" (Attr -> Text
    attrVal Attr
    attr)
                Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Integer -> Int) -> Maybe Integer -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Maybe Integer -> Maybe Int)
    -> (Text -> Maybe Integer) -> Text -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Integer
    readTextAsInteger
              QName
    _ -> Maybe Int
    forall a. Maybe a
    Nothing
            let newValue = PresentationRIdUpdateData -> Int -> Int
    updatePresentationRId PresentationRIdUpdateData
    presentationUpdateRIdData Int
    oldValue
            pure attr {attrVal = "rId" <> T.pack (show newValue)}

          -- if there is no sldIdLst in the presentation.xml file, add an empty one
          -- after the sldMasterIdLst so modifySldIdLst can replace it.

          insertSldIdListIfMissing :: [Content] -> [Content]
          insertSldIdListIfMissing [Content]
    contentList = if (Content -> Bool) -> [Content] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Content -> Bool
    isSldIdLst [Content]
    contentList
                                                 then [Content]
    contentList
                                                 else Element -> [Content] -> [Content]
    insertAfterSldMasterIdLst ([Element] -> Element
    mkNodeSldIdLst []) [Content]
    contentList

          insertAfterSldMasterIdLst' :: Content -> Content -> [Content]
          insertAfterSldMasterIdLst' Content
    newElement Content
    ct = if Text -> Content -> Bool
    isElemName Text
    "sldMasterIdLst" Content
    ct
                                                     then [Content
    ct, Content
    newElement]
                                                     else [Content
    ct]

          insertAfterSldMasterIdLst :: Element -> [Content] -> [Content]
          insertAfterSldMasterIdLst Element
    newElement = (Content -> [Content]) -> [Content] -> [Content]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Content -> [Content]) -> [Content] -> [Content])
    -> (Content -> [Content]) -> [Content] -> [Content]
    forall a b. (a -> b) -> a -> b
    $ Content -> Content -> [Content]
    insertAfterSldMasterIdLst' (Content -> Content -> [Content])
    -> Content -> Content -> [Content]
    forall a b. (a -> b) -> a -> b
    $ Element -> Content
    Elem Element
    newElement

          isElemName :: T.Text -> Content -> Bool
          isElemName Text
    name (Elem Element
    e) = QName -> Text
    qName (Element -> QName
    elName Element
    e) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    name
          isElemName Text
    _ Content
    _ = Bool
    False

          isSldIdLst :: Content -> Bool
          isSldIdLst = Text -> Content -> Bool
    isElemName Text
    "sldIdLst"

          newContent = [Content] -> [Content]
    insertNotesMaster ([Content] -> [Content]) -> [Content] -> [Content]
    forall a b. (a -> b) -> a -> b
    $
                       [Content] -> [Content]
    removeUnwantedMaster ([Content] -> [Content]) -> [Content] -> [Content]
    forall a b. (a -> b) -> a -> b
    $
                       (Content -> Content
    modifySldIdLst (Content -> Content) -> (Content -> Content) -> Content -> Content
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Content -> Content
    updateRIds) (Content -> Content) -> [Content] -> [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                       [Content] -> [Content]
    insertSldIdListIfMissing (Element -> [Content]
    elContent Element
    element)

      return $ element{elContent = newContent}

    presentationToPresEntry :: PandocMonad m => PresentationRIdUpdateData -> Presentation -> P m Entry
    presentationToPresEntry :: forall (m :: * -> *).
    PandocMonad m =>
    PresentationRIdUpdateData -> Presentation -> P m Entry
    presentationToPresEntry PresentationRIdUpdateData
    presentationRIdUpdateData Presentation
    pres =
      PresentationRIdUpdateData -> Presentation -> P m Element
    forall (m :: * -> *).
    PandocMonad m =>
    PresentationRIdUpdateData -> Presentation -> P m Element
    presentationToPresentationElement PresentationRIdUpdateData
    presentationRIdUpdateData Presentation
    pres P m Element
    -> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) a
    -> (a -> ReaderT WriterEnv (StateT WriterState m) b)
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
        FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "ppt/presentation.xml"

    -- adapted from the Docx writer
    docPropsElement :: PandocMonad m => DocProps -> P m Element
    docPropsElement :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
    docPropsElement DocProps
    docProps = do
      utctime <- (WriterEnv -> UTCTime)
    -> ReaderT WriterEnv (StateT WriterState m) UTCTime
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> UTCTime
    envUTCTime
      let keywords = case DocProps -> Maybe [Text]
    dcKeywords DocProps
    docProps of
            Just [Text]
    xs -> Text -> [Text] -> Text
    T.intercalate Text
    ", " [Text]
    xs
            Maybe [Text]
    Nothing -> Text
    ""
      return $
        mknode "cp:coreProperties"
        [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
        ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
        ,("xmlns:dcterms","http://purl.org/dc/terms/")
        ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
        ,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
        $
          mknode "dc:title" [] (fromMaybe "" $ dcTitle docProps)
        :
          mknode "dc:creator" [] (fromMaybe "" $ dcCreator docProps)
        :
          mknode "cp:keywords" [] keywords
        : ( [mknode "dc:subject" [] $ fromMaybe "" $ dcSubject docProps | isJust (dcSubject docProps)])
        <> ( [mknode "dc:description" [] $ fromMaybe "" $ dcDescription docProps | isJust (dcDescription docProps)])
        <> ( [mknode "cp:category" [] $ fromMaybe "" $ cpCategory docProps | isJust (cpCategory docProps)])
        <> (\Text
    x -> [ Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "dcterms:created" [(Text
    "xsi:type",Text
    "dcterms:W3CDTF")] Text
    x
                  , Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "dcterms:modified" [(Text
    "xsi:type",Text
    "dcterms:W3CDTF")] Text
    x
                  ]) (T.pack $ formatTime defaultTimeLocale "%FT%XZ" utctime)

    docPropsToEntry :: PandocMonad m => DocProps -> P m Entry
    docPropsToEntry :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
    docPropsToEntry DocProps
    docProps = DocProps -> P m Element
    forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
    docPropsElement DocProps
    docProps P m Element
    -> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) a
    -> (a -> ReaderT WriterEnv (StateT WriterState m) b)
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                               FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "docProps/core.xml"

    -- adapted from the Docx writer
    docCustomPropsElement :: PandocMonad m => DocProps -> P m Element
    docCustomPropsElement :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
    docCustomPropsElement DocProps
    docProps = do
      let mkCustomProp :: (Text, t) -> a -> Element
    mkCustomProp (Text
    k, t
    v) a
    pid = Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "property"
             [(Text
    "fmtid",Text
    "{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
             ,(Text
    "pid", a -> Text
    forall a. Show a => a -> Text
    tshow a
    pid)
             ,(Text
    "name", Text
    k)] (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> t -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "vt:lpwstr" [] t
    v
      Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element -> ReaderT WriterEnv (StateT WriterState m) Element)
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Properties"
              [(Text
    "xmlns",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/custom-properties")
              ,(Text
    "xmlns:vt",Text
    "http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes")
              ] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ ((Text, Text) -> Int -> Element)
    -> [(Text, Text)] -> [Int] -> [Element]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Text, Text) -> Int -> Element
    forall {t} {a}. (Node t, Show a) => (Text, t) -> a -> Element
    mkCustomProp ([(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [(Text, Text)] -> [(Text, Text)])
    -> Maybe [(Text, Text)] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ DocProps -> Maybe [(Text, Text)]
    customProperties DocProps
    docProps) [(Int
    2 :: Int)..]

    docCustomPropsToEntry :: PandocMonad m => DocProps -> P m Entry
    docCustomPropsToEntry :: forall (m :: * -> *). PandocMonad m => DocProps -> P m Entry
    docCustomPropsToEntry DocProps
    docProps = DocProps -> P m Element
    forall (m :: * -> *). PandocMonad m => DocProps -> P m Element
    docCustomPropsElement DocProps
    docProps P m Element
    -> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) a
    -> (a -> ReaderT WriterEnv (StateT WriterState m) b)
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                               FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "docProps/custom.xml"

    -- We read from the template, but we remove the lastView, so it always
    -- opens on slide view. Templates will sometimes be open in master
    -- view for editing.
    viewPropsElement :: PandocMonad m => P m Element
    viewPropsElement :: forall (m :: * -> *). PandocMonad m => P m Element
    viewPropsElement = do
      refArchive <- (WriterEnv -> Archive)
    -> ReaderT WriterEnv (StateT WriterState m) Archive
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Archive
    envRefArchive
      distArchive <- asks envDistArchive
      viewPrElement <- parseXml refArchive distArchive "ppt/viewProps.xml"
      -- remove  "lastView" if it exists:
      let notLastView :: XML.Attr -> Bool
          notLastView Attr
    attr =
              QName -> Text
    qName (Attr -> QName
    attrKey Attr
    attr) Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    "lastView"
      return $
        viewPrElement {elAttribs = filter notLastView (elAttribs viewPrElement)}

    makeViewPropsEntry :: PandocMonad m => P m Entry
    makeViewPropsEntry :: forall (m :: * -> *). PandocMonad m => P m Entry
    makeViewPropsEntry = P m Element
    forall (m :: * -> *). PandocMonad m => P m Element
    viewPropsElement P m Element
    -> (Element -> ReaderT WriterEnv (StateT WriterState m) Entry)
    -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall a b.
    ReaderT WriterEnv (StateT WriterState m) a
    -> (a -> ReaderT WriterEnv (StateT WriterState m) b)
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FilePath
    -> Element -> ReaderT WriterEnv (StateT WriterState m) Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "ppt/viewProps.xml"

    defaultContentTypeToElem :: DefaultContentType -> Element
    defaultContentTypeToElem :: DefaultContentType -> Element
    defaultContentTypeToElem DefaultContentType
    dct =
      Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Default"
      [(Text
    "Extension", DefaultContentType -> Text
    defContentTypesExt DefaultContentType
    dct),
        (Text
    "ContentType", DefaultContentType -> Text
    defContentTypesType DefaultContentType
    dct)]
      ()

    overrideContentTypeToElem :: OverrideContentType -> Element
    overrideContentTypeToElem :: OverrideContentType -> Element
    overrideContentTypeToElem OverrideContentType
    oct =
      Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Override"
      [(Text
    "PartName", FilePath -> Text
    T.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ OverrideContentType -> FilePath
    overrideContentTypesPart OverrideContentType
    oct),
       (Text
    "ContentType", OverrideContentType -> Text
    overrideContentTypesType OverrideContentType
    oct)]
      ()

    contentTypesToElement :: ContentTypes -> Element
    contentTypesToElement :: ContentTypes -> Element
    contentTypesToElement ContentTypes
    ct =
      let ns :: Text
    ns = Text
    "http://schemas.openxmlformats.org/package/2006/content-types"
      in
        Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "Types" [(Text
    "xmlns", Text
    ns)] ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $

          (DefaultContentType -> Element)
    -> [DefaultContentType] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map DefaultContentType -> Element
    defaultContentTypeToElem (ContentTypes -> [DefaultContentType]
    contentTypesDefaults ContentTypes
    ct) [Element] -> [Element] -> [Element]
    forall a. Semigroup a => a -> a -> a
    <>
          (OverrideContentType -> Element)
    -> [OverrideContentType] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map OverrideContentType -> Element
    overrideContentTypeToElem (ContentTypes -> [OverrideContentType]
    contentTypesOverrides ContentTypes
    ct)

    data DefaultContentType = DefaultContentType
                               { DefaultContentType -> Text
    defContentTypesExt :: T.Text
                               , DefaultContentType -> Text
    defContentTypesType:: MimeType
                               }
                             deriving (Int -> DefaultContentType -> FilePath -> FilePath
    [DefaultContentType] -> FilePath -> FilePath
    DefaultContentType -> FilePath
    (Int -> DefaultContentType -> FilePath -> FilePath)
    -> (DefaultContentType -> FilePath)
    -> ([DefaultContentType] -> FilePath -> FilePath)
    -> Show DefaultContentType
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> DefaultContentType -> FilePath -> FilePath
    showsPrec :: Int -> DefaultContentType -> FilePath -> FilePath
    $cshow :: DefaultContentType -> FilePath
    show :: DefaultContentType -> FilePath
    $cshowList :: [DefaultContentType] -> FilePath -> FilePath
    showList :: [DefaultContentType] -> FilePath -> FilePath
    Show, DefaultContentType -> DefaultContentType -> Bool
    (DefaultContentType -> DefaultContentType -> Bool)
    -> (DefaultContentType -> DefaultContentType -> Bool)
    -> Eq DefaultContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DefaultContentType -> DefaultContentType -> Bool
    == :: DefaultContentType -> DefaultContentType -> Bool
    $c/= :: DefaultContentType -> DefaultContentType -> Bool
    /= :: DefaultContentType -> DefaultContentType -> Bool
    Eq)

    data OverrideContentType = OverrideContentType
                               { OverrideContentType -> FilePath
    overrideContentTypesPart :: FilePath
                               , OverrideContentType -> Text
    overrideContentTypesType :: MimeType
                               }
                              deriving (Int -> OverrideContentType -> FilePath -> FilePath
    [OverrideContentType] -> FilePath -> FilePath
    OverrideContentType -> FilePath
    (Int -> OverrideContentType -> FilePath -> FilePath)
    -> (OverrideContentType -> FilePath)
    -> ([OverrideContentType] -> FilePath -> FilePath)
    -> Show OverrideContentType
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> OverrideContentType -> FilePath -> FilePath
    showsPrec :: Int -> OverrideContentType -> FilePath -> FilePath
    $cshow :: OverrideContentType -> FilePath
    show :: OverrideContentType -> FilePath
    $cshowList :: [OverrideContentType] -> FilePath -> FilePath
    showList :: [OverrideContentType] -> FilePath -> FilePath
    Show, OverrideContentType -> OverrideContentType -> Bool
    (OverrideContentType -> OverrideContentType -> Bool)
    -> (OverrideContentType -> OverrideContentType -> Bool)
    -> Eq OverrideContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: OverrideContentType -> OverrideContentType -> Bool
    == :: OverrideContentType -> OverrideContentType -> Bool
    $c/= :: OverrideContentType -> OverrideContentType -> Bool
    /= :: OverrideContentType -> OverrideContentType -> Bool
    Eq)

    data ContentTypes = ContentTypes { ContentTypes -> [DefaultContentType]
    contentTypesDefaults :: [DefaultContentType]
                                     , ContentTypes -> [OverrideContentType]
    contentTypesOverrides :: [OverrideContentType]
                                     }
                        deriving (Int -> ContentTypes -> FilePath -> FilePath
    [ContentTypes] -> FilePath -> FilePath
    ContentTypes -> FilePath
    (Int -> ContentTypes -> FilePath -> FilePath)
    -> (ContentTypes -> FilePath)
    -> ([ContentTypes] -> FilePath -> FilePath)
    -> Show ContentTypes
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> ContentTypes -> FilePath -> FilePath
    showsPrec :: Int -> ContentTypes -> FilePath -> FilePath
    $cshow :: ContentTypes -> FilePath
    show :: ContentTypes -> FilePath
    $cshowList :: [ContentTypes] -> FilePath -> FilePath
    showList :: [ContentTypes] -> FilePath -> FilePath
    Show, ContentTypes -> ContentTypes -> Bool
    (ContentTypes -> ContentTypes -> Bool)
    -> (ContentTypes -> ContentTypes -> Bool) -> Eq ContentTypes
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContentTypes -> ContentTypes -> Bool
    == :: ContentTypes -> ContentTypes -> Bool
    $c/= :: ContentTypes -> ContentTypes -> Bool
    /= :: ContentTypes -> ContentTypes -> Bool
    Eq)

    contentTypesToEntry :: PandocMonad m => ContentTypes -> P m Entry
    contentTypesToEntry :: forall (m :: * -> *). PandocMonad m => ContentTypes -> P m Entry
    contentTypesToEntry ContentTypes
    ct = FilePath -> Element -> P m Entry
    forall (m :: * -> *).
    PandocMonad m =>
    FilePath -> Element -> P m Entry
    elemToEntry FilePath
    "[Content_Types].xml" (Element -> P m Entry) -> Element -> P m Entry
    forall a b. (a -> b) -> a -> b
    $ ContentTypes -> Element
    contentTypesToElement ContentTypes
    ct

    pathToOverride :: FilePath -> Maybe OverrideContentType
    pathToOverride :: FilePath -> Maybe OverrideContentType
    pathToOverride FilePath
    fp = FilePath -> Text -> OverrideContentType
    OverrideContentType (FilePath
    "/" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    fp) (Text -> OverrideContentType)
    -> Maybe Text -> Maybe OverrideContentType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> Maybe Text
    getContentType FilePath
    fp

    mediaFileContentType :: FilePath -> Maybe DefaultContentType
    mediaFileContentType :: FilePath -> Maybe DefaultContentType
    mediaFileContentType FilePath
    fp = case FilePath -> FilePath
    takeExtension FilePath
    fp of
      Char
    '.' : FilePath
    ext -> DefaultContentType -> Maybe DefaultContentType
    forall a. a -> Maybe a
    Just (DefaultContentType -> Maybe DefaultContentType)
    -> DefaultContentType -> Maybe DefaultContentType
    forall a b. (a -> b) -> a -> b
    $
                   DefaultContentType { defContentTypesExt :: Text
    defContentTypesExt = FilePath -> Text
    T.pack FilePath
    ext
                                      , defContentTypesType :: Text
    defContentTypesType =
                                          Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "application/octet-stream" (FilePath -> Maybe Text
    getMimeType FilePath
    fp)
                                      }
      FilePath
    _ -> Maybe DefaultContentType
    forall a. Maybe a
    Nothing

    mediaContentType :: MediaInfo -> Maybe DefaultContentType
    mediaContentType :: MediaInfo -> Maybe DefaultContentType
    mediaContentType MediaInfo
    mInfo
      | Just Text
    t <- MediaInfo -> Maybe Text
    mInfoExt MediaInfo
    mInfo
      , Just (Char
    '.', Text
    ext) <- Text -> Maybe (Char, Text)
    T.uncons Text
    t =
          DefaultContentType -> Maybe DefaultContentType
    forall a. a -> Maybe a
    Just (DefaultContentType -> Maybe DefaultContentType)
    -> DefaultContentType -> Maybe DefaultContentType
    forall a b. (a -> b) -> a -> b
    $ DefaultContentType { defContentTypesExt :: Text
    defContentTypesExt = Text
    ext
                                    , defContentTypesType :: Text
    defContentTypesType =
                                        Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "application/octet-stream" (MediaInfo -> Maybe Text
    mInfoMimeType MediaInfo
    mInfo)
                                    }
      | Bool
    otherwise = Maybe DefaultContentType
    forall a. Maybe a
    Nothing

    getSpeakerNotesFilePaths :: PandocMonad m => P m [FilePath]
    getSpeakerNotesFilePaths :: forall (m :: * -> *). PandocMonad m => P m [FilePath]
    getSpeakerNotesFilePaths = do
      mp <- (WriterEnv -> Map Int Int)
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int Int)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks WriterEnv -> Map Int Int
    envSpeakerNotesIdMap
      let notesIdNums = Map Int Int -> [Int]
    forall k a. Map k a -> [a]
    M.elems Map Int Int
    mp
      return $ map (\Int
    n -> FilePath
    "ppt/notesSlides/notesSlide" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    ".xml")
                   notesIdNums

    presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
    presentationToContentTypes :: forall (m :: * -> *).
    PandocMonad m =>
    Presentation -> P m ContentTypes
    presentationToContentTypes p :: Presentation
    p@(Presentation DocProps
    _ [Slide]
    slides) = do
      mediaInfos <- [[MediaInfo]] -> [MediaInfo]
    forall a. Monoid a => [a] -> a
    mconcat ([[MediaInfo]] -> [MediaInfo])
    -> (Map Int [MediaInfo] -> [[MediaInfo]])
    -> Map Int [MediaInfo]
    -> [MediaInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Int [MediaInfo] -> [[MediaInfo]]
    forall k a. Map k a -> [a]
    M.elems (Map Int [MediaInfo] -> [MediaInfo])
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
    -> ReaderT WriterEnv (StateT WriterState m) [MediaInfo]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterState -> Map Int [MediaInfo])
    -> ReaderT WriterEnv (StateT WriterState m) (Map Int [MediaInfo])
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Map Int [MediaInfo]
    stMediaIds
      filePaths <- patternsToFilePaths $ inheritedPatterns p
      let mediaFps = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Pattern -> FilePath -> Bool
    match (FilePath -> Pattern
    compile FilePath
    "ppt/media/image*")) [FilePath]
    filePaths
          fontFps = (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Pattern -> FilePath -> Bool
    match (FilePath -> Pattern
    compile FilePath
    "ppt/fonts/*")) [FilePath]
    filePaths
      let defaults = [ Text -> Text -> DefaultContentType
    DefaultContentType Text
    "xml" Text
    "application/xml"
                     , Text -> Text -> DefaultContentType
    DefaultContentType Text
    "rels" Text
    "application/vnd.openxmlformats-package.relationships+xml"
                     ]
          mediaDefaults = [DefaultContentType] -> [DefaultContentType]
    forall a. Eq a => [a] -> [a]
    nub ([DefaultContentType] -> [DefaultContentType])
    -> [DefaultContentType] -> [DefaultContentType]
    forall a b. (a -> b) -> a -> b
    $
                          (MediaInfo -> Maybe DefaultContentType)
    -> [MediaInfo] -> [DefaultContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe MediaInfo -> Maybe DefaultContentType
    mediaContentType [MediaInfo]
    mediaInfos [DefaultContentType]
    -> [DefaultContentType] -> [DefaultContentType]
    forall a. Semigroup a => a -> a -> a
    <>
                          (FilePath -> Maybe DefaultContentType)
    -> [FilePath] -> [DefaultContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe DefaultContentType
    mediaFileContentType [FilePath]
    mediaFps
          fontDefaults = [ Text -> Text -> DefaultContentType
    DefaultContentType Text
    "fntdata" Text
    "application/x-fontdata"
                         | (FilePath -> Bool) -> [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\FilePath
    fp -> FilePath -> FilePath
    takeExtension FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    ".fntdata") [FilePath]
    fontFps
                         ]

          inheritedOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe OverrideContentType
    pathToOverride [FilePath]
    filePaths
          createdOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe OverrideContentType
    pathToOverride [ FilePath
    "docProps/core.xml"
                                                     , FilePath
    "docProps/custom.xml"
                                                     , FilePath
    "ppt/presentation.xml"
                                                     , FilePath
    "ppt/viewProps.xml"
                                                     ]
      relativePaths <- mapM slideToFilePath slides
      let slideOverrides = (FilePath -> Maybe OverrideContentType)
    -> [FilePath] -> [OverrideContentType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
                           (\FilePath
    fp -> FilePath -> Maybe OverrideContentType
    pathToOverride (FilePath -> Maybe OverrideContentType)
    -> FilePath -> Maybe OverrideContentType
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "ppt/slides/" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    fp)
                           [FilePath]
    relativePaths
      speakerNotesOverrides <- mapMaybe pathToOverride <$> getSpeakerNotesFilePaths
      return $ ContentTypes
        (defaults <> mediaDefaults <> fontDefaults)
        (inheritedOverrides <> createdOverrides <> slideOverrides <> speakerNotesOverrides)

    presML :: T.Text
    presML :: Text
    presML = Text
    "application/vnd.openxmlformats-officedocument.presentationml"

    noPresML :: T.Text
    noPresML :: Text
    noPresML = Text
    "application/vnd.openxmlformats-officedocument"

    getContentType :: FilePath -> Maybe MimeType
    getContentType :: FilePath -> Maybe Text
    getContentType FilePath
    fp
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "ppt/presentation.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".presentation.main+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "ppt/presProps.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".presProps+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "ppt/viewProps.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".viewProps+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "ppt/tableStyles.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".tableStyles+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "docProps/core.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "application/vnd.openxmlformats-package.core-properties+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "docProps/custom.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "application/vnd.openxmlformats-officedocument.custom-properties+xml"
      | FilePath
    fp FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    "docProps/app.xml" = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    noPresML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".extended-properties+xml"
      | [FilePath
    "ppt", FilePath
    "slideMasters", FilePath
    f] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp
      , (FilePath
    _, FilePath
    ".xml") <- FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    f =
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".slideMaster+xml"
      | [FilePath
    "ppt", FilePath
    "slides", FilePath
    f] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp
      , (FilePath
    _, FilePath
    ".xml") <- FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    f =
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".slide+xml"
      | [FilePath
    "ppt", FilePath
    "notesMasters", FilePath
    f] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp
      , (FilePath
    _, FilePath
    ".xml") <- FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    f =
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".notesMaster+xml"
      | [FilePath
    "ppt", FilePath
    "notesSlides", FilePath
    f] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp
      , (FilePath
    _, FilePath
    ".xml") <- FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    f =
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".notesSlide+xml"
      | [FilePath
    "ppt", FilePath
    "theme", FilePath
    f] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp
      , (FilePath
    _, FilePath
    ".xml") <- FilePath -> (FilePath, FilePath)
    splitExtension FilePath
    f =
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    noPresML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".theme+xml"
      | [FilePath
    "ppt", FilePath
    "slideLayouts", FilePath
    _] <- FilePath -> [FilePath]
    splitDirectories FilePath
    fp=
          Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text
    presML Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".slideLayout+xml"
      | Bool
    otherwise = Maybe Text
    forall a. Maybe a
    Nothing

    -- Kept as String for XML.Light
    autoNumAttrs :: ListAttributes -> [(Text, Text)]
    autoNumAttrs :: ListAttributes -> [(Text, Text)]
    autoNumAttrs (Int
    startNum, ListNumberStyle
    numStyle, ListNumberDelim
    numDelim) =
      [(Text, Text)]
    numAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. Semigroup a => a -> a -> a
    <> [(Text, Text)]
    typeAttr
      where
        numAttr :: [(Text, Text)]
    numAttr = [(Text
    "startAt", Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    startNum) | Int
    startNum Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1]
        typeAttr :: [(Text, Text)]
    typeAttr = [(Text
    "type", Text
    typeString Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    delimString)]
        typeString :: Text
    typeString = case ListNumberStyle
    numStyle of
          ListNumberStyle
    Decimal -> Text
    "arabic"
          ListNumberStyle
    UpperAlpha -> Text
    "alphaUc"
          ListNumberStyle
    LowerAlpha -> Text
    "alphaLc"
          ListNumberStyle
    UpperRoman -> Text
    "romanUc"
          ListNumberStyle
    LowerRoman -> Text
    "romanLc"
          ListNumberStyle
    _          -> Text
    "arabic"
        delimString :: Text
    delimString = case ListNumberDelim
    numDelim of
          ListNumberDelim
    Period -> Text
    "Period"
          ListNumberDelim
    OneParen -> Text
    "ParenR"
          ListNumberDelim
    TwoParens -> Text
    "ParenBoth"
          ListNumberDelim
    _         -> Text
    "Period"

    -- | The XML required to insert an "appear" animation for each of the given
    -- groups of paragraphs, identified by index.
    incrementalAnimation ::
      -- | (ShapeId, [(startParagraphIndex, endParagraphIndex)])
      NonEmpty (ShapeId, NonEmpty (Integer, Integer)) ->
      Element
    incrementalAnimation :: NonEmpty (Integer, NonEmpty (Integer, Integer)) -> Element
    incrementalAnimation NonEmpty (Integer, NonEmpty (Integer, Integer))
    indices = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:timing" [] [Element
    tnLst, Element
    bldLst]
      where
        triples :: NonEmpty (ShapeId, Integer, Integer)
        triples :: NonEmpty (Integer, Integer, Integer)
    triples = do
          (shapeId, paragraphIds) <- NonEmpty (Integer, NonEmpty (Integer, Integer))
    indices
          (start, end) <- paragraphIds
          pure (shapeId, start, end)

        tnLst :: Element
    tnLst = Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:tnLst" []
          (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:par" []
          (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [ (Text
    "id", Text
    "1")
                           , (Text
    "dur", Text
    "indefinite")
                           , (Text
    "restart", Text
    "never")
                           , (Text
    "nodeType", Text
    "tmRoot")
                           ]
          (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:childTnLst" []
          (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:seq" [ (Text
    "concurrent", Text
    "1")
                           , (Text
    "nextAc", Text
    "seek")
                           ]
          [ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [ (Text
    "id", Text
    "2")
                           , (Text
    "dur", Text
    "indefinite")
                           , (Text
    "nodeType", Text
    "mainSeq")
                           ]
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:childTnLst" []
            ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $ (Integer -> (Integer, Integer, Integer) -> Element)
    -> [Integer] -> [(Integer, Integer, Integer)] -> [Element]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Integer -> (Integer, Integer, Integer) -> Element
    makePar [Integer
    3, Integer
    7 ..] (NonEmpty (Integer, Integer, Integer)
    -> [(Integer, Integer, Integer)]
    forall a. NonEmpty a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList NonEmpty (Integer, Integer, Integer)
    triples)
          , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:prevCondLst" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" ([(Text
    "evt", Text
    "onPrev"), (Text
    "delay", Text
    "0")])
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:tgtEl" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sldTgt" [] ()
          , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:nextCondLst" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" ([(Text
    "evt", Text
    "onNext"), (Text
    "delay", Text
    "0")])
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:tgtEl" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:sldTgt" [] ()
          ]
        bldLst :: Element
    bldLst = Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:bldLst" []
          [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:bldP" [ (Text
    "spid", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    shapeId))
                            , (Text
    "grpId", Text
    "0")
                            , (Text
    "uiExpand", Text
    "1")
                            , (Text
    "build", Text
    "p")
                            ]
            () | (Integer
    shapeId, NonEmpty (Integer, Integer)
    _) <- NonEmpty (Integer, NonEmpty (Integer, Integer))
    -> [(Integer, NonEmpty (Integer, Integer))]
    forall a. NonEmpty a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList NonEmpty (Integer, NonEmpty (Integer, Integer))
    indices
          ]

        makePar :: Integer -> (ShapeId, Integer, Integer) -> Element
        makePar :: Integer -> (Integer, Integer, Integer) -> Element
    makePar Integer
    nextId (Integer
    shapeId, Integer
    start, Integer
    end) =
          Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:par" []
            (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [(Text
    "id", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    nextId)), (Text
    "fill", Text
    "hold")]
            [ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:stCondLst" []
              (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" [(Text
    "delay", Text
    "indefinite")] ()
            , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:childTnLst" []
              (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:par" []
              (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [ (Text
    "id", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show (Integer
    nextId Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1)))
                               , (Text
    "fill", Text
    "hold")
                               ]
              [ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:stCondLst" []
                (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" [(Text
    "delay", Text
    "0")] ()
              , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:childTnLst" []
                (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:par" []
                (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [ (Text
    "id", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show (Integer
    nextId Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    2)))
                                 , (Text
    "presetID", Text
    "1")
                                 , (Text
    "presetClass", Text
    "entr")
                                 , (Text
    "presetSubtype", Text
    "0")
                                 , (Text
    "fill", Text
    "hold")
                                 , (Text
    "grpId", Text
    "0")
                                 , (Text
    "nodeType", Text
    "clickEffect")
                                 ]
                [ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:stCondLst" []
                  (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" [(Text
    "delay", Text
    "0")] ()
                , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:childTnLst" []
                  (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:set" []
                  [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cBhvr" []
                    [ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cTn" [ (Text
    "id", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show (Integer
    nextId Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    3)))
                                     , (Text
    "dur", Text
    "1")
                                     , (Text
    "fill", Text
    "hold")
                                     ]
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:stCondLst" []
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:cond" [(Text
    "delay", Text
    "0")] ()
                    , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:tgtEl" []
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:spTgt" [(Text
    "spid", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    shapeId))]
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:txEl" []
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:pRg" [ (Text
    "st", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    start))
                                       , (Text
    "end", FilePath -> Text
    T.pack (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    end))]
                        ()
                    , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:attrNameLst" []
                      (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Text -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:attrName" [] (Text
    "style.visibility" :: Text)
                    ]
                  , Text -> [(Text, Text)] -> Element -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:to" []
                    (Element -> Element) -> Element -> Element
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "p:strVal" [(Text
    "val", Text
    "visible")] ()
                  ]
                ]
              ]
            ]